{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- : out lint
--
-- these are actually runtime deps, but bild doesn't (yet) distinguish between
-- rundeps and sysdeps:
--
-- : sys ormolu
-- : sys hlint
-- : sys black
-- : sys ruff
-- : sys deadnix
-- : sys shellcheck
-- : sys indent
module Biz.Lint (main) where

import Alpha
import qualified Biz.Cli as Cli
import qualified Biz.Log as Log
import Biz.Namespace (Ext (..), Namespace (..))
import qualified Biz.Namespace as Namespace
import Biz.Test ((@=?))
import qualified Biz.Test as Test
import qualified Data.String as String
import qualified Data.Text as Text
import qualified System.Directory as Directory
import qualified System.Environment as Environment
import qualified System.Exit as Exit
import System.FilePath ((</>))
import qualified System.Process as Process

main :: IO ()
main = Cli.main <| Cli.Plan help move test pure

move :: Cli.Arguments -> IO ()
move args = case Cli.getAllArgs args (Cli.argument "file") of
  [] -> changedFiles +> run mode +> exit
  files ->
    files
      |> filter (not <. Namespace.isCab)
      |> filterM Directory.doesFileExist
      +> run mode
      +> exit
  where
    mode = if Cli.has args (Cli.longOption "fix") then Fix else Check

test :: Test.Tree
test =
  Test.group
    "Biz.Lint"
    [ Test.unit "haskell files return two Results" <| do
        results <- run Check ["Biz/Lint.hs"]
        length results @=? 2
    ]

help :: Cli.Docopt
help =
  [Cli.docopt|
all your lint are belong to us

Usage:
  lint test
  lint [--fix] [<file>...]
  lint -h, --help
|]

exit :: [Result] -> IO ()
exit results = Exit.exitWith <| if n > 0 then Exit.ExitFailure n else Exit.ExitSuccess
  where
    n = length <| filter bad results
    bad = \case
      (Warn _) -> False
      Ok {status = Bad _} -> True
      _ -> False

printResult :: Result -> IO Result
printResult r@(Warn err) = Log.warn ["lint", err] >> Log.br >> pure r
printResult r@(Ok path_ Linter {..} (Bad err)) =
  Log.fail ["lint", exe, Text.pack path_]
    >> Log.br
    >> if err == "" then pure r else putText (Text.pack err) >> pure r
printResult r@(Ok path_ Linter {..} Good) =
  Log.good ["lint", exe, Text.pack path_]
    >> Log.br
    >> pure r
printResult r@(NoOp path_) =
  Log.info ["lint", "noop", Text.pack path_]
    >> pure r

changedFiles :: IO [FilePath]
changedFiles =
  git ["merge-base", "HEAD", "origin/master"]
    /> filter (/= '\n')
    +> (\mb -> git ["diff", "--name-only", "--diff-filter=d", mb])
    /> String.lines
  where
    git args = Process.readProcess "git" args ""

data Mode
  = -- | Just check the files and return an exit code.
    Check
  | -- | Fix the files in place, return 0 if successful, otherwise return 1.
    Fix

data Linter = Linter
  { exe :: Text,
    -- | Arguments added when in the "check" mode.
    checkArgs :: [Text],
    -- | Arguments added when in the "fix" mode.
    fixArgs :: Maybe [Text]
  }
  deriving (Show)

ormolu :: Linter
ormolu =
  Linter
    { exe = "ormolu",
      checkArgs = ["--mode", "check", "--no-cabal"],
      fixArgs = Just ["--mode", "inplace", "--no-cabal"]
    }

hlint :: Linter
hlint =
  Linter
    { exe = "hlint",
      checkArgs = [],
      -- needs apply-refact >0.9.1.0, which needs ghc >9
      -- fixArgs = Just ["--refactor", "--refactor-options=-i"]
      fixArgs = Nothing
    }

black :: Linter
black =
  Linter
    { exe = "black",
      checkArgs = ["--check"],
      fixArgs = Just []
    }

ruff :: Linter
ruff =
  Linter
    { exe = "ruff",
      checkArgs = ["check"],
      fixArgs = Just ["check", "--fix"]
    }

deadnix :: Linter
deadnix =
  Linter
    { exe = "deadnix",
      checkArgs = "--fail" : commonArgs,
      fixArgs = Just <| "--edit" : commonArgs
    }
  where
    commonArgs = ["--no-underscore", "--no-lambda-pattern-names"]

shellcheck :: Linter
shellcheck = Linter {exe = "shellcheck", checkArgs = [], fixArgs = Nothing}

indent :: Linter
indent = Linter {exe = "indent", checkArgs = [], fixArgs = Nothing}

data Status = Good | Bad String
  deriving (Show)

data Result
  = Ok {path :: FilePath, linter :: Linter, status :: Status}
  | Warn Text
  | NoOp FilePath
  deriving (Show)

run :: Mode -> [FilePath] -> IO [Result]
run mode paths = do
  cwd <- Directory.getCurrentDirectory
  root <- Environment.getEnv "BIZ_ROOT"
  concat </ traverse (runOne mode root cwd) paths

runOne :: Mode -> FilePath -> FilePath -> FilePath -> IO [Result]
runOne mode root cwd path_ = results +> traverse_ printResult >> results
  where
    results =
      sequence <| case Namespace.fromPath root (cwd </> path_) of
        Nothing -> [pure <. Warn <| "could not get namespace for " <> Text.pack path_]
        Just (Namespace _ Hs) ->
          [ lint mode ormolu path_,
            lint mode hlint path_
          ]
        Just (Namespace _ Py) ->
          [ lint mode black path_,
            lint mode ruff path_
          ]
        Just (Namespace _ Sh) -> [lint mode shellcheck path_]
        Just (Namespace _ Nix) -> [lint mode deadnix path_]
        Just (Namespace _ Scm) -> [pure <| NoOp path_]
        Just (Namespace _ C) -> [lint mode indent path_]
        Just _ -> [pure <. Warn <| "no linter for " <> Text.pack path_]

lint :: Mode -> Linter -> FilePath -> IO Result
lint mode linter@Linter {..} path_ =
  Process.readProcessWithExitCode (Text.unpack exe) args "" /> \case
    (Exit.ExitSuccess, _, _) ->
      Ok path_ linter Good
    (Exit.ExitFailure _, msg, _) ->
      Ok path_ linter <| Bad msg
  where
    args = case (mode, fixArgs) of
      (Fix, Just args_) -> map Text.unpack args_ ++ [path_]
      (Fix, Nothing) -> [path_]
      (Check, _) -> map Text.unpack checkArgs ++ [path_]