diff options
Diffstat (limited to 'Biz/Devalloc.hs')
-rw-r--r-- | Biz/Devalloc.hs | 31 |
1 files changed, 15 insertions, 16 deletions
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 () |