From 2d8b280ed2c73d65fb905a580e9499bb7f69ff01 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Mon, 14 Aug 2023 20:48:10 -0400 Subject: Run lint Idk why these missed the linter. Probably packages updated in the nixpkgs version bump. --- Biz/Auth.hs | 12 ++++--- Biz/Bild.hs | 71 +++++++++++++++++++++-------------------- Biz/Bild/Bessel.c | 8 ++--- Biz/Bild/Deps.hs | 24 +++++++------- Biz/Bild/Example.c | 4 +-- Biz/Dragons.hs | 20 +++++++----- Biz/Dragons/Analysis.hs | 3 +- Biz/Que/Host.hs | 2 +- Network/Wai/Middleware/Braid.hs | 27 ++++++++-------- System/Random/Shuffle.hs | 4 +-- 10 files changed, 93 insertions(+), 82 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 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 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 diff --git a/Network/Wai/Middleware/Braid.hs b/Network/Wai/Middleware/Braid.hs index f9832ac..5dbc7f4 100644 --- a/Network/Wai/Middleware/Braid.hs +++ b/Network/Wai/Middleware/Braid.hs @@ -65,19 +65,20 @@ import Network.Wai.Middleware.AddHeaders (addHeaders) type Topic = [Text] -data Update = -- | Updates are streamed from the server to subcribing client. - -- On a PUT request, the headers and request body are put into an Update and streamed to subscribing clients. - Update - { -- | The updateTopic is formed, from the request path - updateTopic :: [Text], - -- | The updateClient is an id generated by the client to prevent echo updates - -- https://github.com/braid-work/braid-spec/issues/72 - updateClient :: Maybe B.ByteString, - -- | The updateHeader are taken straight from the request headers - updateHeaders :: RequestHeaders, - -- | The updatePatches correspond to the request body - updatePatches :: L.ByteString - } +data Update + = -- | Updates are streamed from the server to subcribing client. + -- On a PUT request, the headers and request body are put into an Update and streamed to subscribing clients. + Update + { -- | The updateTopic is formed, from the request path + updateTopic :: [Text], + -- | The updateClient is an id generated by the client to prevent echo updates + -- https://github.com/braid-work/braid-spec/issues/72 + updateClient :: Maybe B.ByteString, + -- | The updateHeader are taken straight from the request headers + updateHeaders :: RequestHeaders, + -- | The updatePatches correspond to the request body + updatePatches :: L.ByteString + } isGetRequest, isPutRequest, isPatchRequest :: Wai.Request -> Bool isGetRequest req = Wai.requestMethod req == methodGet diff --git a/System/Random/Shuffle.hs b/System/Random/Shuffle.hs index 38d0a27..1df376f 100644 --- a/System/Random/Shuffle.hs +++ b/System/Random/Shuffle.hs @@ -86,9 +86,9 @@ shuffle elements = shuffleTree (buildTree elements) extractTree n (Node n' l (Leaf e)) | n + 1 == n' = (e, l) extractTree n (Node c l@(Node cl _ _) r) | n < cl = - let (e, l') = extractTree n l in (e, Node (c - 1) l' r) + let (e, l') = extractTree n l in (e, Node (c - 1) l' r) | otherwise = - let (e, r') = extractTree (n - cl) r in (e, Node (c - 1) l r') + let (e, r') = extractTree (n - cl) r in (e, Node (c - 1) l r') extractTree _ _ = panic "[extractTree] impossible" -- | Given a sequence (e1,...en) to shuffle, its length, and a random -- cgit v1.2.3