diff options
| -rw-r--r-- | Biz/Bild.nix | 2 | ||||
| -rwxr-xr-x | Biz/Ide/repl | 6 | ||||
| -rw-r--r-- | Biz/Lint.hs | 104 | ||||
| -rw-r--r-- | Biz/Namespace.hs | 6 |
4 files changed, 67 insertions, 51 deletions
diff --git a/Biz/Bild.nix b/Biz/Bild.nix index 9017f17..b12b87a 100644 --- a/Biz/Bild.nix +++ b/Biz/Bild.nix @@ -123,12 +123,14 @@ in nixpkgs // { bild = rec { # this should just be dev tools buildInputs = with nixpkgs.pkgs; [ bild + black ctags figlet git gitlint lolcat nixpkgs.haskell.packages.${constants.ghcCompiler}.fast-tags + ormolu wemux ]; shellHook = '' diff --git a/Biz/Ide/repl b/Biz/Ide/repl index cf0378d..1d94e47 100755 --- a/Biz/Ide/repl +++ b/Biz/Ide/repl @@ -32,12 +32,12 @@ fi packageSet=$(jq --raw-output '.[].packageSet' <<< $json) BILD="(import ${BIZ_ROOT:?}/Biz/Bild.nix {})" for lib in ${sysdeps[@]}; do - flags+=(--packages "$BILD.private.nixpkgs.${lib}") - flags+=(--packages "$BILD.private.nixpkgs.pkg-config") + flags+=(--packages "$BILD.pkgs.${lib}") + flags+=(--packages "$BILD.pkgs.pkg-config") done case $exts in C) - flags+=(--packages "$BILD.private.nixpkgs.gcc") + flags+=(--packages "$BILD.pkgs.gcc") command="bash" ;; Hs) diff --git a/Biz/Lint.hs b/Biz/Lint.hs index 2742fae..1fb04b0 100644 --- a/Biz/Lint.hs +++ b/Biz/Lint.hs @@ -25,35 +25,48 @@ import Biz.Namespace (Ext (..), Namespace (..)) import qualified Biz.Namespace as Namespace import Biz.Test ((@=?)) import qualified Biz.Test as Test +import qualified Data.Map as Map 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 +move args = + Environment.getEnv "BIZ_ROOT" +> \root -> + case Cli.getAllArgs args (Cli.argument "file") of + [] -> + changedFiles + +> traverse Directory.makeAbsolute + /> map (Namespace.fromPath root) + /> catMaybes + /> Namespace.groupByExt + +> run mode + +> exit + files -> + files + |> filter (not <. Namespace.isCab) + |> traverse Directory.makeAbsolute + +> filterM Directory.doesFileExist + /> map (Namespace.fromPath root) + /> catMaybes + /> Namespace.groupByExt + +> run mode + +> exit where - mode = if Cli.has args (Cli.longOption "fix") then Fix else Check + mode = args `Cli.has` Cli.longOption "fix" ?: (Fix, Check) test :: Test.Tree test = Test.group "Biz.Lint" [ Test.unit "haskell files return two Results" <| do - results <- run Check ["Biz/Lint.hs"] + results <- run Check <| Map.singleton Hs <| [Namespace ["Biz", "Lint"] Hs] length results @=? 2 ] @@ -74,21 +87,21 @@ exit results = Exit.exitWith <| if n > 0 then Exit.ExitFailure n else Exit.ExitS n = length <| filter bad results bad = \case (Warn _) -> False - Ok {status = Bad _} -> True + Done {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_] +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@(Ok path_ Linter {..} Good) = - Log.good ["lint", exe, Text.pack path_] +printResult r@(Done Linter {..} Good) = + Log.good ["lint", exe] >> Log.br >> pure r -printResult r@(NoOp path_) = - Log.info ["lint", "noop", Text.pack path_] +printResult r@(NoOp ext) = + Log.info ["lint", "noop", show ext] >> pure r changedFiles :: IO [FilePath] @@ -169,46 +182,41 @@ data Status = Good | Bad String deriving (Show) data Result - = Ok {path :: FilePath, linter :: Linter, status :: Status} + = Done {linter :: Linter, status :: Status} | Warn Text - | NoOp FilePath + | NoOp Namespace.Ext 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 +run :: Mode -> Map Namespace.Ext [Namespace] -> IO [Result] +run mode nsmap = nsmap |> Map.assocs |> traverse (runOne mode) /> concat -runOne :: Mode -> FilePath -> FilePath -> FilePath -> IO [Result] -runOne mode root cwd path_ = results +> traverse_ printResult >> results +runOne :: Mode -> (Ext, [Namespace]) -> IO [Result] +runOne mode (ext, ns's) = 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_ + sequence <| case ext of + Namespace.Hs -> + [ lint mode ormolu ns's, + lint mode hlint ns's ] - Just (Namespace _ Py) -> - [ lint mode black path_, - lint mode ruff path_ + Namespace.Py -> + [ lint mode black ns's, + lint mode ruff ns's ] - 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_ = + Namespace.Sh -> [lint mode shellcheck ns's] + Namespace.Nix -> [lint mode deadnix ns's] + Namespace.C -> [lint mode indent ns's] + _ -> [pure <. Warn <| "no linter for " <> show ext] + +lint :: Mode -> Linter -> [Namespace] -> IO Result +lint mode linter@Linter {..} ns's = Process.readProcessWithExitCode (Text.unpack exe) args "" /> \case (Exit.ExitSuccess, _, _) -> - Ok path_ linter Good + Done linter Good (Exit.ExitFailure _, msg, _) -> - Ok path_ linter <| Bad msg + Done 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_] + (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 diff --git a/Biz/Namespace.hs b/Biz/Namespace.hs index 6d099fd..9621186 100644 --- a/Biz/Namespace.hs +++ b/Biz/Namespace.hs @@ -15,6 +15,7 @@ module Biz.Namespace toHaskellModule, toSchemeModule, isCab, + groupByExt, ) where @@ -24,6 +25,7 @@ import qualified Data.Aeson.Types as Aeson import qualified Data.Char as Char import qualified Data.List as List import qualified Data.List.Split as List +import qualified Data.Map as Map import qualified Data.Text as Text import qualified Text.Regex.Applicative as Regex @@ -134,3 +136,7 @@ reExt = isCab :: FilePath -> Bool isCab ('_' : _) = True isCab fp = "/_/" `List.isInfixOf` fp + +-- | Group a list of Namespaces keyed by their extensions +groupByExt :: [Namespace] -> Map Ext [Namespace] +groupByExt ns's = Map.fromListWith (++) [(ext ns, [ns]) | ns <- ns's] |