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

-- : out lint
-- : dep async
-- : dep rainbow
-- : dep regex-applicative
module Biz.Lint (main) where

import Alpha
import qualified Biz.Cli as Cli
import Biz.Namespace (Ext (..), Namespace (..))
import qualified Biz.Namespace as Namespace
import Biz.Test ((@=?))
import qualified Biz.Test as Test
import qualified Control.Concurrent.Async as Async
import qualified Data.String as String
import qualified Data.Text as Text
import Rainbow (chunk, fore, green, putChunkLn, red, yellow)
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

move :: Cli.Arguments -> IO ()
move args = case Cli.getAllArgs args (Cli.argument "file") of
  [] -> changedFiles >>= run >>= mapM printResult >>= exit
  files -> run (filter notcab files) >>= mapM printResult >>= exit

test :: Test.Tree
test = Test.group "Biz.Lint" [Test.unit "id" <| 1 @=? 1]

notcab :: FilePath -> Bool
notcab ('_' : _) = False
notcab _ = True

help :: Cli.Docopt
help =
  [Cli.docopt|
lint

Usage:
  lint test
  lint [<file>...]
|]

exit :: [Result] -> IO ()
exit results = Exit.exitWith <| if n > 0 then Exit.ExitFailure n else Exit.ExitSuccess
  where
    n = length <| filter bad results
    -- we print errors in red, but don't count them as "bad"
    bad (Warn _) = False
    bad Ok {status = Bad _} = True
    bad _ = False

schunk = chunk <. Text.pack

printResult :: Result -> IO Result
printResult r@(Warn err) =
  (putChunkLn <| fore yellow <| "lint:  warn:  " <> chunk err) >> pure r
printResult r@(Ok path_ linter_ (Bad err)) =
  ( putChunkLn <| fore red <| "lint:  baad:  "
      <> schunk linter_
      <> ": "
      <> schunk path_
  )
    >> if err == "" then pure r else putText (Text.pack err) >> pure r
printResult r@(Ok path_ linter_ Good) =
  ( putChunkLn <| fore green <| "lint:  good:  "
      <> schunk linter_
      <> ":  "
      <> schunk path_
  )
    >> pure r
printResult r@(NoOp path_) =
  (putText <| "lint:  noop:  " <> Text.pack path_)
    >> pure r

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

type Linter = String

data Status = Good | Bad String
  deriving (Show)

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

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

runOne :: FilePath -> FilePath -> FilePath -> IO [Result]
runOne root cwd path_ =
  sequence <| case Namespace.fromPath root (cwd </> path_) of
    Nothing -> [pure <. Warn <| "could not get namespace for " <> Text.pack path_]
    Just (Namespace _ Hs) ->
      [ lint "ormolu" ["--mode", "check"] path_,
        lint "hlint" [] path_
      ]
    Just (Namespace _ Py) ->
      [ lint "pylint" ["--disable=invalid-name"] path_
      ]
    Just (Namespace _ Sh) -> [pure <| NoOp path_] -- [lint "shellcheck" [] path_]
    Just (Namespace _ Nix) -> [pure <| NoOp path_]
    Just (Namespace _ Scm) -> [pure <| NoOp path_]
    Just _ -> [pure <. Warn <| "no linter for " <> Text.pack path_]

lint :: Linter -> [String] -> FilePath -> IO Result
lint bin args path_ =
  Process.readProcessWithExitCode bin (args ++ [path_]) "" >>= \case
    (Exit.ExitSuccess, _, _) -> pure <| Ok path_ bin Good
    (Exit.ExitFailure _, msg, _) ->
      pure <| Ok path_ bin <| Bad msg