diff options
Diffstat (limited to 'Biz')
-rw-r--r-- | Biz/Auth.hs | 12 | ||||
-rw-r--r-- | Biz/Bild.hs | 71 | ||||
-rw-r--r-- | Biz/Bild/Bessel.c | 8 | ||||
-rw-r--r-- | Biz/Bild/Deps.hs | 24 | ||||
-rw-r--r-- | Biz/Bild/Example.c | 4 | ||||
-rw-r--r-- | Biz/Dragons.hs | 20 | ||||
-rw-r--r-- | Biz/Dragons/Analysis.hs | 3 | ||||
-rw-r--r-- | Biz/Que/Host.hs | 2 |
8 files changed, 77 insertions, 67 deletions
diff --git a/Biz/Auth.hs b/Biz/Auth.hs index 14f67ec..9eb81a8 100644 --- a/Biz/Auth.hs +++ b/Biz/Auth.hs @@ -131,7 +131,11 @@ githubOauth (GitHub OAuthArgs {..}) code = (Req.https "github.com" /: "login" /: "oauth" /: "access_token") Req.NoReqBody Req.jsonResponse - <| "client_id" =: clientId - <> "client_secret" =: clientSecret - <> "code" =: code - <> "state" =: clientState + <| "client_id" + =: clientId + <> "client_secret" + =: clientSecret + <> "code" + =: code + <> "state" + =: clientState diff --git a/Biz/Bild.hs b/Biz/Bild.hs index 19c8827..2dc1e64 100644 --- a/Biz/Bild.hs +++ b/Biz/Bild.hs @@ -193,24 +193,24 @@ move args = do root <- Env.getEnv "BIZ_ROOT" IO.hSetBuffering stdout IO.NoBuffering >> pure (Cli.getAllArgs args (Cli.argument "target")) - /> filter (not <. Namespace.isCab) - +> filterM Dir.doesFileExist - +> traverse Dir.makeAbsolute - /> map (Namespace.fromPath root) - /> catMaybes - +> foldM analyze mempty - /> Map.filter (namespace .> isBuildableNs) - +> printOrBuild - +> exitSummary + /> filter (not <. Namespace.isCab) + +> filterM Dir.doesFileExist + +> traverse Dir.makeAbsolute + /> map (Namespace.fromPath root) + /> catMaybes + +> foldM analyze mempty + /> Map.filter (namespace .> isBuildableNs) + +> printOrBuild + +> exitSummary where printOrBuild :: Analysis -> IO [ExitCode] printOrBuild targets | args `Cli.has` Cli.longOption "json" = - Log.wipe >> putJSON targets >> pure [Exit.ExitSuccess] + Log.wipe >> putJSON targets >> pure [Exit.ExitSuccess] | otherwise = do - root <- Env.getEnv "BIZ_ROOT" - createHier root - build isTest isLoud targets + root <- Env.getEnv "BIZ_ROOT" + createHier root + build isTest isLoud targets isTest = args `Cli.has` Cli.longOption "test" isLoud = args `Cli.has` Cli.longOption "loud" putJSON = Aeson.encode .> ByteString.toStrict .> Char8.putStrLn @@ -427,7 +427,7 @@ analyze hmap ns = case Map.lookup ns hmap of withFile absPath ReadMode <| \h -> IO.hSetEncoding h IO.utf8_bom >> Text.IO.hGetContents h - /> Text.lines + /> Text.lines case ext of -- basically we don't support building these Namespace.Css -> pure Nothing @@ -613,11 +613,12 @@ analyze hmap ns = case Map.lookup ns hmap of ?: ( Nothing, [ "#!/usr/bin/env bash", "guile -C \"" - <> root </> intdir - <> "\" -e main " - <> "-s " - <> Namespace.toPath namespace - <> " \"$@\"" + <> root + </> intdir + <> "\" -e main " + <> "-s " + <> Namespace.toPath namespace + <> " \"$@\"" ] |> joinWith "\n" |> Text.pack @@ -806,15 +807,15 @@ run Proc {..} = do Async.Concurrently (loud ?: (puts stdout_, logs ns stdout_)) *> Async.Concurrently (loud ?: (puts stderr_, logs ns stderr_)) *> Async.Concurrently (Conduit.waitForStreamingProcess hdl) - |> Async.runConcurrently - +> \case - Exit.ExitFailure n -> - puts stderr_ - >> onFailure - >> pure (Exit.ExitFailure n, output) - Exit.ExitSuccess -> - onSuccess - >> pure (Exit.ExitSuccess, output) + |> Async.runConcurrently + +> \case + Exit.ExitFailure n -> + puts stderr_ + >> onFailure + >> pure (Exit.ExitFailure n, output) + Exit.ExitSuccess -> + onSuccess + >> pure (Exit.ExitSuccess, output) -- | Helper for running a standard bild subprocess. proc :: Bool -> Namespace -> String -> [Text] -> IO (Exit.ExitCode, ByteString) @@ -842,13 +843,13 @@ logs :: Namespace -> Conduit.ConduitT () ByteString (Conduit.ResourceT IO) () -> logs ns src = Conduit.runConduitRes <| src - .| Conduit.mapM_ - ( BS.filter (/= BSI.c2w '\n') - .> (\t -> Log.fmt ["info", "bild", nschunk ns, decodeUtf8 t]) - .> Text.take 77 - .> (<> "...\r") - .> putStr - ) + .| Conduit.mapM_ + ( BS.filter (/= BSI.c2w '\n') + .> (\t -> Log.fmt ["info", "bild", nschunk ns, decodeUtf8 t]) + .> Text.take 77 + .> (<> "...\r") + .> putStr + ) nschunk :: Namespace -> Text nschunk = Namespace.toPath .> Text.pack diff --git a/Biz/Bild/Bessel.c b/Biz/Bild/Bessel.c index 524956c..52b4dee 100644 --- a/Biz/Bild/Bessel.c +++ b/Biz/Bild/Bessel.c @@ -7,13 +7,13 @@ #include <libguile.h> SCM -j0_wrapper(SCM x) +j0_wrapper (SCM x) { - return scm_from_double(j0(scm_to_double(x))); + return scm_from_double (j0 (scm_to_double (x))); } void -init_bessel() +init_bessel () { - scm_c_define_gsubr("j0", 1, 0, 0, j0_wrapper); + scm_c_define_gsubr ("j0", 1, 0, 0, j0_wrapper); } diff --git a/Biz/Bild/Deps.hs b/Biz/Bild/Deps.hs index 515d04c..17aae0d 100644 --- a/Biz/Bild/Deps.hs +++ b/Biz/Bild/Deps.hs @@ -45,7 +45,7 @@ instance MonadUnliftIO NIO where withRunInIO = wrappedWithRunInIO NIO runNIO getFindSourcesJson :: NIO FindSourcesJson ---getFindSourcesJson = ask +-- getFindSourcesJson = ask getFindSourcesJson = do root <- li <| getEnv "BIZ_ROOT" pure <| AtPath <| root </> "Biz/Bild/Sources.json" @@ -161,12 +161,12 @@ parseNixpkgs = parseNixpkgsFast <|> parseNixpkgsLatest <|> parseNixpkgsCustom <| <> Opts.help "Use a custom nixpkgs repository from GitHub." <> Opts.metavar "OWNER/REPO" ) - <*> Opts.strOption - ( Opts.long "nixpkgs-branch" - <> Opts.short 'b' - <> Opts.help "The nixpkgs branch when using --nixpkgs ...." - <> Opts.showDefault - ) + <*> Opts.strOption + ( Opts.long "nixpkgs-branch" + <> Opts.short 'b' + <> Opts.help "The nixpkgs branch when using --nixpkgs ...." + <> Opts.showDefault + ) parseNoNixpkgs = Opts.flag' NoNixpkgs @@ -684,8 +684,8 @@ abortUpdateFailed errs = abort <| T.unlines <| ["One or more packages failed to update:"] - <> map - ( \(PackageName pname, e) -> - pname <> ": " <> tshow e - ) - errs + <> map + ( \(PackageName pname, e) -> + pname <> ": " <> tshow e + ) + errs diff --git a/Biz/Bild/Example.c b/Biz/Bild/Example.c index 06e6ed8..9966dba 100644 --- a/Biz/Bild/Example.c +++ b/Biz/Bild/Example.c @@ -1,6 +1,6 @@ // : out helloworld.exe void -main() +main () { - printf("Biz/Bild/Example.c: Hello world!\n"); + printf ("Biz/Bild/Example.c: Hello world!\n"); } diff --git a/Biz/Dragons.hs b/Biz/Dragons.hs index d71ca3c..8d33130 100644 --- a/Biz/Dragons.hs +++ b/Biz/Dragons.hs @@ -482,9 +482,10 @@ instance Lucid.ToHtml AnalysisAction where simpleBar :: (Show i, Monad m, Num i) => i -> Integer -> Lucid.HtmlT m () simpleBar n total = do Lucid.table_ [Lucid.class_ "charts-css bar stacked multiple"] <| do - Lucid.tr_ <| do - Lucid.td_ [Lucid.style_ <| size n total] "" - <> Lucid.td_ [Lucid.style_ <| size total total] "" + Lucid.tr_ + <| do + Lucid.td_ [Lucid.style_ <| size n total] "" + <> Lucid.td_ [Lucid.style_ <| size total total] "" len = toInteger <. length slen = tshow <. length @@ -989,7 +990,7 @@ htmlApp jwtCfg cooks kp cfg oAuthArgs = warn msg = Log.warn [msg] >> Log.br - |> liftIO + |> liftIO >> throwError err502 {errBody = str msg} user <- GitHub.userInfoCurrentR @@ -1351,8 +1352,9 @@ instance Lucid.ToHtml Analyses where forM_ analyses <| \AnalysisAction {..} -> Lucid.a_ [ href analysisId, - css <| Biz.Look.marginAll (em 1) - <> Clay.textDecoration Clay.none + css + <| Biz.Look.marginAll (em 1) + <> Clay.textDecoration Clay.none ] <| do Lucid.div_ <| Lucid.toHtml source @@ -1473,7 +1475,8 @@ instance Lucid.ToHtml SelectRepo where Lucid.input_ [ Lucid.type_ "submit", Lucid.class_ "link", - Lucid.value_ <| GitHub.untagName + Lucid.value_ + <| GitHub.untagName <| GitHub.repoName repo ] Lucid.input_ @@ -1673,7 +1676,8 @@ analyzeGitHub keep user@User {userId} ghAuth depo o r = do getPeople :: IO (Vector GitHub.SimpleUser) getPeople = - Async.runConcurrently <| (Vector.++) + Async.runConcurrently + <| (Vector.++) </ Concurrently getCollaborators <*> Concurrently getTopContributors diff --git a/Biz/Dragons/Analysis.hs b/Biz/Dragons/Analysis.hs index cfdbf2c..8641a6d 100644 --- a/Biz/Dragons/Analysis.hs +++ b/Biz/Dragons/Analysis.hs @@ -238,7 +238,8 @@ calculateScore 0 _ _ = 0 calculateScore a 0 0 | a > 0 = 100 calculateScore a b c | a < 0 || b < 0 || c < 0 = 0 calculateScore numTotal numBlackholes numLiabilities = - max 0 <. round + max 0 + <. round <| maxScore * (weightedBlackholes + weightedLiabilities + numGood) / numTotal diff --git a/Biz/Que/Host.hs b/Biz/Que/Host.hs index b26f9c7..79254ad 100644 --- a/Biz/Que/Host.hs +++ b/Biz/Que/Host.hs @@ -183,7 +183,7 @@ paths _ = |> str |> Go.write q >> Go.read q -- flush the que, otherwise msgs never clear - |> liftIO + |> liftIO -- TODO: detect number of readers, respond with "sent to N readers" or -- "no readers, msg lost" >> pure NoContent |