summaryrefslogtreecommitdiff
path: root/Biz
diff options
context:
space:
mode:
Diffstat (limited to 'Biz')
-rw-r--r--Biz/Bild.hs45
-rw-r--r--Biz/Bild/Deps/Haskell.nix1
-rw-r--r--Biz/Lint.hs44
3 files changed, 58 insertions, 32 deletions
diff --git a/Biz/Bild.hs b/Biz/Bild.hs
index 721da46..9c341b9 100644
--- a/Biz/Bild.hs
+++ b/Biz/Bild.hs
@@ -9,6 +9,9 @@
-- : out bild
-- : dep docopt
-- : dep regex-applicative
+-- : dep rainbow
+-- : dep tasty
+-- : dep tasty-hunit
--
-- == Design constraints
--
@@ -125,6 +128,7 @@ import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.String as String
import qualified Data.Text as Text
+import Rainbow (chunk, fore, green, putChunkLn, red)
import qualified System.Directory as Dir
import qualified System.Environment as Env
import System.FilePath ((</>))
@@ -289,10 +293,10 @@ build andTest target@Target {..} = do
root <- Env.getEnv "BIZ_ROOT"
case compiler of
GhcExe -> do
- putStrLn <| "bild: dev: ghc-exe: " <> Namespace.toPath namespace
+ putStrLn <| "bild: dev: ghc-exe: " <> Namespace.toPath namespace
let outDir = root </> "_/bild/dev/bin"
Dir.createDirectoryIfMissing True outDir
- putText <| "bild: dev: bilder: " <> Text.pack builder
+ putText <| "bild: dev: bilder: " <> Text.pack builder
Process.callProcess
"ghc"
[ "-Werror",
@@ -309,11 +313,12 @@ build andTest target@Target {..} = do
outDir </> out
]
when andTest <| do
- putStrLn <| "bild: dev: test: " <> Namespace.toPath namespace
+ putStrLn <| "bild: dev: test: " <> Namespace.toPath namespace
Process.callProcess (outDir </> out) ["test"]
+ putChunkLn <| fore green <| "bilt: " <> nschunk namespace
GhcLib -> do
- putStrLn <| "bild: dev: ghc-lib: " <> Namespace.toPath namespace
- putText <| "bild: dev: bilder: " <> Text.pack builder
+ putStrLn <| "bild: dev: ghc-lib: " <> Namespace.toPath namespace
+ putText <| "bild: dev: bilder: " <> Text.pack builder
Process.callProcess
"ghc"
[ "-Werror",
@@ -325,11 +330,12 @@ build andTest target@Target {..} = do
"--make",
path
]
+ putChunkLn <| fore green <| "bilt: " <> nschunk namespace
GhcjsExe -> do
- putStrLn <| "bild: dev: ghcjs-exe: " <> Namespace.toPath namespace
+ putStrLn <| "bild: dev: ghcjs-exe: " <> Namespace.toPath namespace
let outDir = root </> "_/bild/dev/static"
Dir.createDirectoryIfMissing True outDir
- putText <| "bild: dev: local: " <> Text.pack builder
+ putText <| "bild: dev: local: " <> Text.pack builder
Process.callProcess
"ghcjs"
[ "-Werror",
@@ -345,9 +351,10 @@ build andTest target@Target {..} = do
"-o",
outDir </> out
]
+ putChunkLn <| fore green <| "bilt: " <> nschunk namespace
GhcjsLib -> do
- putStrLn <| "bild: dev: ghcjs-lib: " <> Namespace.toPath namespace
- putText <| "bild: dev: local: " <> Text.pack builder
+ putStrLn <| "bild: dev: ghcjs-lib: " <> Namespace.toPath namespace
+ putText <| "bild: dev: local: " <> Text.pack builder
Process.callProcess
"ghcjs"
[ "-Werror",
@@ -359,18 +366,19 @@ build andTest target@Target {..} = do
"--make",
path
]
+ putChunkLn <| fore green <| "bilt: " <> nschunk namespace
Guile -> do
- putStrLn <| "bild: dev: guile: " <> Namespace.toPath namespace
- putText <| "bild: dev: local: " <> Text.pack builder
- putText "bild: guile TODO"
+ putStrLn <| "bild: dev: guile: " <> Namespace.toPath namespace
+ putText <| "bild: dev: local: " <> Text.pack builder
+ putText "bild: guile: TODO"
putText <| show target
NixBuild -> do
- putStrLn <| "bild: nix: " <> Namespace.toPath namespace
+ putStrLn <| "bild: nix: " <> Namespace.toPath namespace
let outDir = root </> "_/bild/nix"
Dir.createDirectoryIfMissing True outDir
if null builder
- then putText <| "bild: nix: local"
- else putText <| "bild: nix: remote: " <> Text.pack builder
+ then putText <| "bild: nix: local"
+ else putText <| "bild: nix: remote: " <> Text.pack builder
Process.callProcess
"nix-build"
[ path,
@@ -391,11 +399,14 @@ build andTest target@Target {..} = do
"--builders",
builder
]
+ putChunkLn <| fore green <| "bilt: " <> nschunk namespace
Copy -> do
- putStrLn <| "bild: copy: " <> Namespace.toPath namespace
- putText "bild: copy TODO"
+ putStrLn <| "bild: copy: " <> Namespace.toPath namespace
+ putText "bild: copy: TODO"
putText <| show target
+nschunk = chunk <. Text.pack <. Namespace.toPath
+
metaDep :: Regex.RE Char Dep
metaDep = Regex.string "-- : dep " *> Regex.many (Regex.psym Char.isAlpha)
diff --git a/Biz/Bild/Deps/Haskell.nix b/Biz/Bild/Deps/Haskell.nix
index 13d952d..c08e353 100644
--- a/Biz/Bild/Deps/Haskell.nix
+++ b/Biz/Bild/Deps/Haskell.nix
@@ -35,6 +35,7 @@ with hpkgs;
process
protolude
quickcheck-instances
+ rainbow
random
regex-applicative
req
diff --git a/Biz/Lint.hs b/Biz/Lint.hs
index bf7fa09..ccbb393 100644
--- a/Biz/Lint.hs
+++ b/Biz/Lint.hs
@@ -5,6 +5,7 @@
-- : out lint
-- : dep async
+-- : dep rainbow
-- : dep regex-applicative
module Biz.Lint (main) where
@@ -17,6 +18,7 @@ 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
@@ -27,14 +29,12 @@ main :: IO ()
main = Cli.main <| Cli.Plan help move test
move :: Cli.Arguments -> IO ()
-move args =
- (return <| Cli.getAllArgs args (Cli.argument "file"))
- >>= \case
- [] -> changedFiles >>= run >>= mapM printResult >>= exit
- files -> run (filter notcab files) >>= mapM printResult >>= exit
+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.Bild" [Test.unit "id" <| 1 @=? 1]
+test = Test.group "Biz.Lint" [Test.unit "id" <| 1 @=? 1]
notcab :: FilePath -> Bool
notcab ('_' : _) = False
@@ -46,6 +46,7 @@ help =
lint
Usage:
+ lint test
lint [<file>...]
|]
@@ -53,19 +54,32 @@ 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
+ -- 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@(Error err) = (putText <| "lint: error: " <> err) >> pure r
-printResult r@(Error _) = pure r
+printResult r@(Warn err) =
+ (putChunkLn <| fore yellow <| "lint: warn: " <> chunk err) >> pure r
printResult r@(Ok path_ linter_ (Bad err)) =
- (putText <| "lint: badd: " <> Text.pack linter_ <> ": " <> Text.pack path_)
+ ( putChunkLn <| fore red <| "lint: baad: "
+ <> schunk linter_
+ <> ": "
+ <> schunk path_
+ )
>> if err == "" then pure r else putText (Text.pack err) >> pure r
-printResult r@(Ok _ _ Good) = 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_)
+ (putText <| "lint: noop: " <> Text.pack path_)
>> pure r
changedFiles :: IO [FilePath]
@@ -84,7 +98,7 @@ data Status = Good | Bad String
data Result
= Ok {path :: FilePath, linter :: Linter, status :: Status}
- | Error Text
+ | Warn Text
| NoOp FilePath
deriving (Show)
@@ -97,7 +111,7 @@ run paths = do
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_]
+ Nothing -> [pure <. Warn <| "could not get namespace for " <> Text.pack path_]
Just (Namespace _ Hs) ->
[ lint "ormolu" ["--mode", "check"] path_,
lint "hlint" [] path_
@@ -108,7 +122,7 @@ runOne root cwd 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_]
+ Just _ -> [pure <. Warn <| "no linter for " <> Text.pack path_]
lint :: Linter -> [String] -> FilePath -> IO Result
lint bin args path_ =
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-28 01:25:14 +0000