diff options
| -rw-r--r-- | .hlint.yaml | 8 | ||||
| -rw-r--r-- | Alpha.hs | 12 | ||||
| -rw-r--r-- | Biz/Devalloc.hs | 31 |
3 files changed, 25 insertions, 26 deletions
diff --git a/.hlint.yaml b/.hlint.yaml index 3706180..a595d0f 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -71,7 +71,7 @@ note: 'Use `<.`' rhs: 'f <. g' -- hint: - lhs: 'f <. g' - note: 'Use `.>` for natural reading direction' - rhs: 'g .> f' +#- hint: +# lhs: 'f <. g' +# note: 'Use `.>` for natural reading direction' +# rhs: 'g .> f' @@ -94,7 +94,7 @@ f </ g = fmap f g -- (i.e. it goes "two levels deep"), applies the function to the inner -- values, then returns the result wrapped in the two functors. (<//) :: (Functor f0, Functor f1) => (a -> b) -> f0 (f1 a) -> f0 (f1 b) -(<//) = fmap . fmap +(<//) = fmap .> fmap -- | Normal function application. Do the right side, then pass the -- return value to the function on the left side. @@ -138,7 +138,7 @@ class CanSnakeCase str where snake :: str -> str instance CanSnakeCase Text where - snake = Text.replace " " "-" . Text.toLower + snake = Text.toLower .> Text.replace " " "-" capitalize :: String -> String capitalize [] = [] @@ -153,13 +153,13 @@ require s Nothing = panic <| s <> " not found" -- | Wrap text at the given limit. wrap :: Int -> Text -> Text -wrap lim = Text.unwords . wrap_ 0 . Text.words +wrap lim = Text.words .> wrap_ 0 .> Text.unwords where wrap_ :: Int -> [Text] -> [Text] wrap_ _ [] = [] - wrap_ pos (w:ws) - | pos == 0 = w : (wrap_ (pos + lw) ws) + wrap_ pos (w : ws) + | pos == 0 = w : wrap_ (pos + lw) ws | pos + lw + 1 > lim = wrap_ 0 (Text.cons '\n' w : ws) - | otherwise = [w] ++ wrap_ (pos + lw + 1) ws + | otherwise = w : wrap_ (pos + lw + 1) ws where lw = Text.length w diff --git a/Biz/Devalloc.hs b/Biz/Devalloc.hs index 783c9cd..af83535 100644 --- a/Biz/Devalloc.hs +++ b/Biz/Devalloc.hs @@ -6,7 +6,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -173,13 +172,14 @@ htmlApp cfg oAuthArgs = Paths { home = page (Home oAuthArgs), githubAuth = auth oAuthArgs, - githubAnalysis = (\user repo -> liftIO <| analyzeGitHub cfg user repo >>= pure . HtmlApp), + githubAnalysis = \user repo -> + liftIO <| analyzeGitHub cfg user repo >>= HtmlApp .> pure, css = look } where - page = pure . HtmlApp + page = HtmlApp .> pure look = - return . toStrict . Clay.render <| do + return <. toStrict <. Clay.render <| do Biz.Look.fuckingStyle "body" Clay.? Biz.Look.fontStack @@ -204,7 +204,7 @@ auth OAuthArgs {..} (Just code) = >>= getRepos >>= \case Left err -> panic <| show err - Right repos -> pure . HtmlApp <| SelectRepo repos + Right repos -> pure <. HtmlApp <| SelectRepo repos where getRepos oAuthToken = GitHub.github @@ -243,7 +243,7 @@ data Analysis = Analysis instance Lucid.ToHtml Analysis where toHtmlRaw = Lucid.toHtml - toHtml = Lucid.toHtml . render + toHtml = render .> Lucid.toHtml where render :: Analysis -> Lucid.Html () render Analysis {..} = @@ -251,7 +251,7 @@ instance Lucid.ToHtml Analysis where Lucid.h1_ "Analysis Results" Lucid.h3_ "blackholes:" Lucid.ul_ <| do - mapM_ (Lucid.li_ . Lucid.toHtml) blackholes + mapM_ (Lucid.toHtml .> Lucid.li_) blackholes -- | Takes a list of active authors and a path to a bare git repo and runs a -- regular analysis @@ -285,7 +285,7 @@ analyze activeAuthors bareRepo = do { blackholes = [ Text.pack path | (path, authors_) <- authorMap, - length (List.intersect (map third authors_) activeAuthors) < 1 + null (map third authors_ `List.intersect` activeAuthors) ], liabilities = [], stale = [], -- actually a map of path->staleness @@ -361,7 +361,7 @@ analyzeGitHub cfg o r = do -- assume the only active author is the owner, for now let activeAuthors = [require "user email" <| GitHub.userName user] Right repo <- GitHub.github () (GitHub.repositoryR ghOwner ghRepo) - bareRepo <- gitBareClone cfg . GitHub.getUrl <| GitHub.repoHtmlUrl repo + bareRepo <- gitBareClone cfg <. GitHub.getUrl <| GitHub.repoHtmlUrl repo analyze activeAuthors bareRepo where ghOwner = GitHub.mkName (Proxy :: Proxy GitHub.Owner) o @@ -391,8 +391,8 @@ gitBareClone Config {depo} url = do encodeParams :: [(Text, Text)] -> Text encodeParams = Encoding.decodeUtf8 - . LBS.toStrict - . Web.FormUrlEncoded.urlEncodeParams + <. LBS.toStrict + <. Web.FormUrlEncoded.urlEncodeParams newtype SelectRepo = SelectRepo (Vector GitHub.Repo) @@ -403,22 +403,21 @@ instance Lucid.ToHtml SelectRepo where Lucid.h1_ "Select a repo to analyze" selectRepo repos - selectRepo :: Vector GitHub.Repo -> Lucid.Html () -selectRepo = Lucid.ul_ . mapM_ render . Vector.toList +selectRepo = Lucid.ul_ <. mapM_ render <. Vector.toList where render :: GitHub.Repo -> Lucid.Html () render repo = Lucid.li_ - . Lucid.a_ + <. Lucid.a_ [ Lucid.linkHref_ "/" <| fieldLink githubAnalysis (GitHub.untagName <| GitHub.simpleOwnerLogin <| GitHub.repoOwner repo) (GitHub.untagName <| GitHub.repoName repo) ] - . Lucid.toHtml - . GitHub.untagName + <. Lucid.toHtml + <. GitHub.untagName <| GitHub.repoName repo loginButton :: OAuthArgs -> Lucid.Html () |