diff options
| -rw-r--r-- | Alpha.hs | 2 | ||||
| -rw-r--r-- | Biz/Lint.hs | 44 |
2 files changed, 25 insertions, 21 deletions
@@ -133,7 +133,7 @@ infixr 0 <| (|>) :: a -> (a -> b) -> b f |> g = g f -infixl 0 |> +infixl 1 |> -- | Alias for <&>. Can be read as "and then". Basically does into a -- functor, does some computation, then returns the same kind of diff --git a/Biz/Lint.hs b/Biz/Lint.hs index 26d4e6d..8689308 100644 --- a/Biz/Lint.hs +++ b/Biz/Lint.hs @@ -4,7 +4,6 @@ {-# LANGUAGE NoImplicitPrelude #-} -- : out lint --- : dep async -- : dep rainbow -- : dep regex-applicative module Biz.Lint (main) where @@ -16,7 +15,6 @@ 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 qualified System.Directory as Directory @@ -30,8 +28,13 @@ 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 + [] -> changedFiles >>= run >>= exit + files -> + files + |> filter notcab + /> filterM Directory.doesFileExist + >>= run + >>= exit test :: Test.Tree test = @@ -60,7 +63,6 @@ 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 @@ -104,23 +106,25 @@ run :: [FilePath] -> IO [Result] run paths = do cwd <- Directory.getCurrentDirectory root <- Environment.getEnv "BIZ_ROOT" - concat </ Async.mapConcurrently (runOne root cwd) paths + concat </ mapM (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_] +runOne root cwd path_ = results >>= mapM_ 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 "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_ = |