From bdd2fa156d7158bca9f7da47915f55f06333484c Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Wed, 9 Dec 2020 10:52:08 -0500 Subject: Reorganizing for reabability --- Biz/Devalloc.hs | 49 ++++++++++++++++++++++++++----------------------- 1 file changed, 26 insertions(+), 23 deletions(-) diff --git a/Biz/Devalloc.hs b/Biz/Devalloc.hs index f03d2d4..7cf906a 100644 --- a/Biz/Devalloc.hs +++ b/Biz/Devalloc.hs @@ -167,7 +167,29 @@ paths Config {assets} oAuthArgs = Biz.Look.fuckingStyle "body" Clay.? Biz.Look.fontStack -data Response = Response +-- | Create an href attribute to a path in 'AllPaths'. +linkTo :: + (HasLink path, IsElem path AllPaths) => + -- | Proxy to the path + Proxy path -> + -- | Return value @x@ is to be used like @Lucid.a_ [ x ] ...@ + MkLink path Lucid.Attribute +linkTo = Lucid.safeHref_ "/" allPaths + +data Page + = Home OAuthArgs + | GitHubRepos (Vector GitHub.Repo) + +instance Lucid.ToHtml Page where + toHtmlRaw = Lucid.toHtml + toHtml page = + Lucid.toHtml <| case page of + Home authArgs -> pitch authArgs + GitHubRepos repos -> do + Lucid.h1_ "Select a repo to analyze" + selectRepo repos + +data OAuthResponse = OAuthResponse { access_token :: Text, scope :: Text, token_type :: Text @@ -181,8 +203,8 @@ auth OAuthArgs {..} (Just code) = >>= getRepos >>= \case Left err -> panic <| show err - Right response -> - GitHubRepos response |> HtmlApp |> pure + Right repos -> + pure <| HtmlApp <| GitHubRepos repos where getRepos oAuthToken = GitHub.github @@ -205,26 +227,7 @@ auth OAuthArgs {..} (Just code) = <> "code" =: code <> "state" =: githubState -linkTo :: - (HasLink path, IsElem path AllPaths) => - Proxy path -> - MkLink path Lucid.Attribute -linkTo = Lucid.safeHref_ "/" allPaths - -data Page - = Home OAuthArgs - | GitHubRepos (Vector GitHub.Repo) - -instance Lucid.ToHtml Page where - toHtmlRaw = Lucid.toHtml - toHtml page = - Lucid.toHtml <| case page of - Home authArgs -> pitch authArgs - GitHubRepos repos -> do - Lucid.h1_ "Select a repo to analyze" - selectRepo repos - -newtype Analysis = Analysis +data Analysis = Analysis { targetRepo :: GitHub.Id GitHub.Repo } -- cgit v1.2.3