summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Biz/Auth.hs12
-rw-r--r--Biz/Bild.hs71
-rw-r--r--Biz/Bild/Bessel.c8
-rw-r--r--Biz/Bild/Deps.hs24
-rw-r--r--Biz/Bild/Example.c4
-rw-r--r--Biz/Dragons.hs20
-rw-r--r--Biz/Dragons/Analysis.hs3
-rw-r--r--Biz/Que/Host.hs2
-rw-r--r--Network/Wai/Middleware/Braid.hs27
-rw-r--r--System/Random/Shuffle.hs4
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 <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
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-24 03:29:24 +0000