Parse and format deadnix json output

Deadnix was printing a bunch of unicode characters so it could draw lines to the
source location of an error, and it would mess up my output. Anyway I didn't
find that feature useful. Now I just get the json output and print the line
number and error message for the lint failure.

Also did some refactoring where I saw fit: added a log message so you know what
linter is currently running, and cleaned up some syntax.

1 files changed, 102 insertions, 35 deletions

diff --git a/Biz/Lint.hs b/Biz/Lint.hs
index 1fb04b0..5c3bef3 100644
--- a/Biz/Lint.hs
+++ b/Biz/Lint.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
@@ -25,6 +26,8 @@ import Biz.Namespace (Ext (..), Namespace (..))
 import qualified Biz.Namespace as Namespace
 import Biz.Test ((@=?))
 import qualified Biz.Test as Test
+import qualified Data.Aeson as Aeson
+import qualified Data.ByteString.Char8 as Char8
 import qualified Data.Map as Map
 import qualified Data.String as String
 import qualified Data.Text as Text
@@ -82,7 +85,7 @@ Usage:
 |]
 
 exit :: [Result] -> IO ()
-exit results = Exit.exitWith <| if n > 0 then Exit.ExitFailure n else Exit.ExitSuccess
+exit results = Exit.exitWith <| (n > 0) ?: (Exit.ExitFailure n, Exit.ExitSuccess)
   where
     n = length <| filter bad results
     bad = \case
@@ -91,18 +94,24 @@ exit results = Exit.exitWith <| if n > 0 then Exit.ExitFailure n else Exit.ExitS
       _ -> False
 
 printResult :: Result -> IO Result
-printResult r@(Warn err) = Log.warn ["lint", err] >> Log.br >> pure r
-printResult r@(Done Linter {..} (Bad err)) =
-  Log.fail ["lint", exe]
-    >> Log.br
-    >> if err == "" then pure r else putText (Text.pack err) >> pure r
-printResult r@(Done Linter {..} Good) =
-  Log.good ["lint", exe]
-    >> Log.br
-    >> pure r
-printResult r@(NoOp ext) =
-  Log.info ["lint", "noop", show ext]
-    >> pure r
+printResult r = case r of
+  Warn err ->
+    Log.warn ["lint", err]
+      >> Log.br
+      >> pure r
+  Done (Linter {..}) (Bad err) ->
+    Log.fail ["lint", exe]
+      >> Log.br
+      >> (err /= "")
+      ?| (putText <| Text.pack err)
+      >> pure r
+  Done (Linter {..}) Good ->
+    Log.good ["lint", exe]
+      >> Log.br
+      >> pure r
+  NoOp ext ->
+    Log.info ["lint", "noop", show ext]
+      >> pure r
 
 changedFiles :: IO [FilePath]
 changedFiles =
@@ -121,19 +130,24 @@ data Mode
 
 data Linter = Linter
   { exe :: Text,
-    -- | Arguments added when in the "check" mode.
+    -- | Arguments added when in the "check" mode
     checkArgs :: [Text],
-    -- | Arguments added when in the "fix" mode.
-    fixArgs :: Maybe [Text]
+    -- | Arguments added when in the "fix" mode
+    fixArgs :: Maybe [Text],
+    -- | An optional function to format the output of the linter as you want
+    -- it, perhaps decoding json or something
+    formatter :: Maybe (String -> String)
   }
-  deriving (Show)
+
+-- deriving (Show)
 
 ormolu :: Linter
 ormolu =
   Linter
     { exe = "ormolu",
       checkArgs = ["--mode", "check", "--no-cabal"],
-      fixArgs = Just ["--mode", "inplace", "--no-cabal"]
+      fixArgs = Just ["--mode", "inplace", "--no-cabal"],
+      formatter = Nothing
     }
 
 hlint :: Linter
@@ -143,7 +157,8 @@ hlint =
       checkArgs = [],
       -- needs apply-refact >0.9.1.0, which needs ghc >9
       -- fixArgs = Just ["--refactor", "--refactor-options=-i"]
-      fixArgs = Nothing
+      fixArgs = Nothing,
+      formatter = Nothing
     }
 
 black :: Linter
@@ -151,7 +166,8 @@ black =
   Linter
     { exe = "black",
       checkArgs = ["--check"],
-      fixArgs = Just []
+      fixArgs = Just [],
+      formatter = Nothing
     }
 
 ruff :: Linter
@@ -159,24 +175,69 @@ ruff =
   Linter
     { exe = "ruff",
       checkArgs = ["check"],
-      fixArgs = Just ["check", "--fix"]
+      fixArgs = Just ["check", "--fix"],
+      formatter = Nothing
     }
 
+data DeadnixOutput = DeadnixOutput
+  { file :: FilePath,
+    results :: [DeadnixResult]
+  }
+  deriving (Generic, Aeson.FromJSON)
+
+data DeadnixResult = DeadnixResult
+  { column :: Int,
+    endColumn :: Int,
+    line :: Int,
+    message :: String
+  }
+  deriving (Generic, Aeson.FromJSON)
+
 deadnix :: Linter
 deadnix =
   Linter
     { exe = "deadnix",
       checkArgs = "--fail" : commonArgs,
-      fixArgs = Just <| "--edit" : commonArgs
+      fixArgs = Just <| "--edit" : commonArgs,
+      formatter = Just decodeDeadnixOutput
     }
   where
-    commonArgs = ["--no-underscore", "--no-lambda-pattern-names"]
+    commonArgs =
+      [ -- "--no-underscore",
+        -- "--no-lambda-pattern-names",
+        "--output-format",
+        "json"
+      ]
+
+decodeDeadnixOutput :: String -> String
+decodeDeadnixOutput deadnixJson =
+  deadnixJson |> Char8.pack |> Aeson.decodeStrict |> \case
+    Nothing -> panic "could not decode deadnix output"
+    Just o -> formatDeadnixOutput o
+  where
+    formatDeadnixOutput DeadnixOutput {..} =
+      joinWith "\n" <| map formatDeadnixResult results
+      where
+        formatDeadnixResult DeadnixResult {..} =
+          file <> ":" <> show line <> ":" <> show column <> ": " <> message
 
 shellcheck :: Linter
-shellcheck = Linter {exe = "shellcheck", checkArgs = [], fixArgs = Nothing}
+shellcheck =
+  Linter
+    { exe = "shellcheck",
+      checkArgs = [],
+      fixArgs = Nothing,
+      formatter = Nothing
+    }
 
 indent :: Linter
-indent = Linter {exe = "indent", checkArgs = [], fixArgs = Nothing}
+indent =
+  Linter
+    { exe = "indent",
+      checkArgs = [],
+      fixArgs = Nothing,
+      formatter = Nothing
+    }
 
 data Status = Good | Bad String
   deriving (Show)
@@ -185,15 +246,16 @@ data Result
   = Done {linter :: Linter, status :: Status}
   | Warn Text
   | NoOp Namespace.Ext
-  deriving (Show)
 
 run :: Mode -> Map Namespace.Ext [Namespace] -> IO [Result]
 run mode nsmap = nsmap |> Map.assocs |> traverse (runOne mode) /> concat
 
 runOne :: Mode -> (Ext, [Namespace]) -> IO [Result]
-runOne mode (ext, ns's) = results +> traverse_ printResult >> results
+runOne mode (ext, ns's) = results +> traverse printResult
   where
     results =
+      -- i would run these with mapConcurrently, but the output gets mangled. to
+      -- do it right i need a queue for the results. someday.
       sequence <| case ext of
         Namespace.Hs ->
           [ lint mode ormolu ns's,
@@ -210,13 +272,18 @@ runOne mode (ext, ns's) = results +> traverse_ printResult >> results
 
 lint :: Mode -> Linter -> [Namespace] -> IO Result
 lint mode linter@Linter {..} ns's =
-  Process.readProcessWithExitCode (Text.unpack exe) args "" /> \case
-    (Exit.ExitSuccess, _, _) ->
-      Done linter Good
-    (Exit.ExitFailure _, msg, _) ->
-      Done linter <| Bad msg
+  Log.info ["lint", exe, (tshow <| length ns's) <> " files"]
+    >> Process.readProcessWithExitCode (str exe) args "" /> \case
+      (Exit.ExitSuccess, _, _) ->
+        Done linter Good
+      (Exit.ExitFailure _, msg, _) -> case formatter of
+        Nothing -> Done linter <| Bad msg
+        Just fmt -> Done linter <| Bad <| fmt msg
   where
     args = case (mode, fixArgs) of
-      (Fix, Just args_) -> map Text.unpack args_ ++ map Namespace.toPath ns's
-      (Fix, Nothing) -> map Namespace.toPath ns's
-      (Check, _) -> map Text.unpack checkArgs ++ map Namespace.toPath ns's
+      (Fix, Just args_) ->
+        map str args_ ++ map Namespace.toPath ns's
+      (Fix, Nothing) ->
+        map Namespace.toPath ns's
+      (Check, _) ->
+        map str checkArgs ++ map Namespace.toPath ns's