summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Biz/Devalloc.hs28
1 files changed, 16 insertions, 12 deletions
diff --git a/Biz/Devalloc.hs b/Biz/Devalloc.hs
index ce70f07..9d0b2ce 100644
--- a/Biz/Devalloc.hs
+++ b/Biz/Devalloc.hs
@@ -726,7 +726,7 @@ guardAuth ::
guardAuth = \case
Auth.NoSuchUser -> throwError err401 {errBody = "No such user"}
Auth.BadPassword -> throwError err401 {errBody = "Bad password"}
- Auth.Indefinite -> throwError err401 {errBody = "Incorrect authentication method"}
+ Auth.Indefinite -> throwError err401 {errBody = "No authentication found"}
Auth.Authenticated user -> pure user
requiredScopes :: Set Text
@@ -950,7 +950,7 @@ black = "#121212"
data Home = Home OAuthArgs (Maybe Analysis)
instance App.HasCss Home where
- cssFor (Home _ _) = do
+ cssFor (Home _ mAnalysis) = do
"p" ? Clay.textAlign Clay.center
"h1" ? do
Clay.fontSize (Clay.rem 3)
@@ -963,6 +963,7 @@ instance App.HasCss Home where
Biz.Look.borderRadiusAll (px 10)
Biz.Look.paddingX (em 2)
Biz.Look.paddingY (em 1)
+ maybe mempty App.cssFor mAnalysis
"section" ? do
Clay.padding (rem 3) 0 (rem 3) 0
"a#try-button" <> "a#try-button:visited" ? do
@@ -1265,7 +1266,19 @@ footer =
data AnalysisDisplay = AnalysisDisplay User Analysis
instance App.HasCss AnalysisDisplay where
- cssFor (AnalysisDisplay _ _) = do
+ cssFor (AnalysisDisplay _ analysis) = App.cssFor analysis
+
+instance Lucid.ToHtml AnalysisDisplay where
+ toHtmlRaw = Lucid.toHtml
+ toHtml (AnalysisDisplay user anal) = do
+ header <| Just user
+ Lucid.main_ <| do
+ Lucid.h1_ "Analysis Results"
+ Lucid.toHtml anal
+ footer
+
+instance App.HasCss Analysis where
+ cssFor _ = do
Clay.display Clay.grid
Clay.justifyContent Clay.spaceAround
Biz.Look.rowGap (rem 2)
@@ -1299,15 +1312,6 @@ instance App.HasCss AnalysisDisplay where
"details[open]" ? do
Biz.Look.gridArea "details"
-instance Lucid.ToHtml AnalysisDisplay where
- toHtmlRaw = Lucid.toHtml
- toHtml (AnalysisDisplay user anal) = do
- header <| Just user
- Lucid.main_ <| do
- Lucid.h1_ "Analysis Results"
- Lucid.toHtml anal
- footer
-
instance Lucid.ToHtml Analysis where
toHtmlRaw = Lucid.toHtml
toHtml Analysis {..} =