Port lint to Haskell

4 files changed, 116 insertions, 109 deletions

diff --git a/Biz/Bild/Rules.nix b/Biz/Bild/Rules.nix
index 17461ef..c18c56e 100644
--- a/Biz/Bild/Rules.nix
+++ b/Biz/Bild/Rules.nix
@@ -152,6 +152,7 @@ in rec {
       nixpkgs.ormolu
       nixpkgs.python37Packages.black
       nixpkgs.python37Packages.pylint
+      nixpkgs.shellcheck
       nixpkgs.wemux
       (pkgs.writeScriptBin "ftags" (builtins.readFile ../Ide/ftags.sh))
     ];
diff --git a/Biz/Bild/ShellHook.sh b/Biz/Bild/ShellHook.sh
index f545e27..05707dc 100644
--- a/Biz/Bild/ShellHook.sh
+++ b/Biz/Bild/ShellHook.sh
@@ -33,7 +33,9 @@ function deps() {
 
 alias ghci="ghci -i$BIZ_ROOT -ghci-script $BIZ_ROOT/.ghci"
 
-alias lint=$BIZ_ROOT/Biz/Lint.py
+function lint {
+    runghc Biz.Lint $@
+}
 
 function pie() {
   runghc Biz.Pie $@
diff --git a/Biz/Lint.hs b/Biz/Lint.hs
new file mode 100644
index 0000000..acf59c8
--- /dev/null
+++ b/Biz/Lint.hs
@@ -0,0 +1,112 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- : out lint
+-- : dep async
+-- : dep regex-applicative
+module Biz.Lint (main) where
+
+import Alpha
+import Biz.Namespace (Ext (..), Namespace (..))
+import qualified Biz.Namespace as Namespace
+import qualified Control.Concurrent.Async as Async
+import qualified Data.String as String
+import qualified Data.Text as Text
+import qualified System.Console.Docopt as Docopt
+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 =
+  Environment.getArgs
+    >>= Docopt.parseArgsOrExit help
+    >>= (\args -> return <| Docopt.getAllArgs args (Docopt.argument "file"))
+    >>= \case
+      [] -> changedFiles >>= run >>= mapM printResult >>= exit
+      files -> run (filter notcab files) >>= mapM printResult >>= exit
+
+notcab :: FilePath -> Bool
+notcab ('_' : _) = False
+notcab _ = True
+
+help :: Docopt.Docopt
+help =
+  [Docopt.docopt|
+lint
+
+Usage:
+  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
+    bad (Error _) = False
+    bad Ok {status = Bad _} = True
+    bad _ = False
+
+printResult :: Result -> IO Result
+-- printResult r@(Error err) = (putText <| "lint: error: " <> err) >> pure r
+printResult r@(Error err) = pure r
+printResult r@(Ok path_ linter_ (Bad err)) =
+  (putText <| "lint: badd: " <> Text.pack linter_ <> ": " <> Text.pack path_)
+    >> if err == "" then pure r else putText (Text.pack err) >> pure r
+printResult r@(Ok _ _ Good) = 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}
+  | Error 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 <. Error <| "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 <. Error <| "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
diff --git a/Biz/Lint.py b/Biz/Lint.py
deleted file mode 100755
index c3e51df..0000000
--- a/Biz/Lint.py
+++ /dev/null
@@ -1,108 +0,0 @@
-#!/usr/bin/env python
-"""
-all your lint are belong to us
-"""
-import os
-import subprocess
-import sys
-
-
-# pylint: disable=missing-class-docstring,too-few-public-methods
-class Color:
-    HEAD = "\033[95m"
-    BLUE = "\033[94m"
-    GREEN = "\033[92m"
-    WARN = "\033[93m"
-    FAIL = "\033[91m"
-    BOLD = "\033[1m"
-    UNDER = "\033[4m"
-    END = "\033[0m"
-
-
-def run(cmd, file):
-    "Exec a linter for a file."
-    global ERRORS  # pylint: disable=global-statement
-    args = {
-        "ormolu": ["--mode", "check"],
-        "hlint": [],
-        "black": ["--quiet", "--check"],
-        "pylint": ["--disable=invalid-name"],
-    }
-    # pylint: disable=subprocess-run-check
-    ret = subprocess.run([cmd, *args[cmd], file], stdout=subprocess.PIPE)
-    if ret.returncode != 0:
-        ERRORS += 1  # pylint: disable=undefined-variable
-        msg = ret.stdout.decode("utf-8").strip()
-        print(Color.WARN + f"lint error: {cmd}: {file}" + Color.END)
-        if msg:
-            for line in msg.split("\n"):
-                print("  " + line)
-
-
-def changed_files():
-    "Return a list of changed files according to git."
-    merge_base = (
-        subprocess.check_output(["git", "merge-base", "HEAD", "origin/master"])
-        .decode("utf-8")
-        .strip()
-    )
-    return (
-        subprocess.check_output(["git", "diff", "--name-only", merge_base])
-        .decode("utf-8")
-        .strip()
-        .split()
-    )
-
-
-def group_files(files, extensions):
-    """Given a list of files and list of extensions, return a dict of:
-       {ext: [files]}
-
-    """
-    root = os.getenv("BIZ_ROOT")
-    ret = {k: [] for k in extensions}
-    for ext in extensions:
-        for file in files:
-            if file.endswith(ext):
-                ret[ext].append(os.path.join(root, file))
-    return ret
-
-
-def guard_todos(files):
-    "Fail if TODO found in text"
-    global ERRORS  # pylint: disable=global-statement
-    for fname in files:
-        with open(fname) as text:
-            if "TODO" in text.read():
-                ERRORS += 1
-                print("found todo:", fname)
-
-
-if __name__ == "__main__":
-    ERRORS = 0
-    if "-h" in sys.argv:
-        print(f"usage: {os.path.basename(__file__)} <files...>")
-        print("if no files given, lint changed files in this branch")
-        sys.exit(0)
-    elif len(sys.argv) == 1:
-        FILES = group_files(changed_files(), [".hs", ".py"])
-    else:
-        FILES = group_files(sys.argv[1:], [".hs", ".py"])
-    for hs in FILES[".hs"]:
-        if not os.path.exists(hs):
-            print("lint: does not exist:", hs)
-            continue
-        print(f"lint: {hs}")
-        run("ormolu", hs)
-        run("hlint", hs)
-    for py in FILES[".py"]:
-        if not os.path.exists(py):
-            print("lint: does not exist:", py)
-            continue
-        print(f"lint: {py}")
-        # Broken in our nixpkgs
-        # run("black", py)
-        run("pylint", py)
-    if ERRORS:
-        print("lint: errors:", ERRORS)
-    sys.exit(ERRORS)