summaryrefslogtreecommitdiff
path: root/server/HtmlOrphans.hs
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--server/HtmlOrphans.hs46
1 files changed, 20 insertions, 26 deletions
diff --git a/server/HtmlOrphans.hs b/server/HtmlOrphans.hs
index bb4932d..4d03234 100644
--- a/server/HtmlOrphans.hs
+++ b/server/HtmlOrphans.hs
@@ -12,29 +12,23 @@
-- linter results as html
module HtmlOrphans () where
-
-import CheckDir (DirResult (..), MissingAsset (MissingAsset),
- MissingDep (..), maximumLintLevel)
-import CheckMap (MapResult (..))
-import Control.Monad (forM_, unless)
-import Data.Functor ((<&>))
-import Data.List (intersperse)
-import Data.List.Extra (escapeJSON)
-import qualified Data.Map as M
-import Data.Text (Text)
-import qualified Data.Text as T
-import Lens.Micro.Extras (view)
-import Lucid (HtmlT, ToHtml)
-import Lucid.Base (ToHtml (toHtml))
-import Lucid.Html5 (a_, body_, class_, code_, div_, em_, h1_,
- h2_, h3_, h4_, h5_, head_, href_, html_,
- id_, li_, link_, main_, p_, rel_, script_,
- span_, src_, title_, type_, ul_)
-import Server (AdminOverview (..), JobStatus (..),
- RemoteRef (reporef, repourl), jobs,
- registry)
-import Text.Dot (showDot)
-import Types (Hint (Hint), Level (..))
+import Universum
+
+import CheckDir (DirResult (..), MissingAsset (MissingAsset),
+ MissingDep (..), maximumLintLevel)
+import CheckMap (MapResult (..))
+import Data.List.Extra (escapeJSON)
+import qualified Data.Map as M
+import Lucid (HtmlT, ToHtml)
+import Lucid.Base (ToHtml (toHtml))
+import Lucid.Html5 (a_, body_, class_, code_, div_, em_, h1_, h2_,
+ h3_, h4_, h5_, head_, href_, html_, id_, li_,
+ link_, main_, p_, rel_, script_, span_, src_,
+ title_, type_, ul_)
+import Server (AdminOverview (..), JobStatus (..),
+ RemoteRef (reporef, repourl), jobs, registry)
+import Text.Dot (showDot)
+import Types (Hint (Hint), Level (..))
mono :: Monad m => HtmlT m () -> HtmlT m ()
@@ -74,7 +68,7 @@ instance ToHtml AdminOverview where
Just (Linted res) -> toHtml $ maximumLintLevel res
Just (Failed _) -> badge Error "system error"
Nothing -> toHtml Fatal
- " "; a_ [href_ (T.pack $ "/status/"<>show uuid)] $ do
+ " "; a_ [href_ ("/status/"<>show uuid)] $ do
mono $ toHtml $ reporef ref; " on "; mono $ toHtml $ repourl ref
@@ -90,7 +84,7 @@ badge level = span_ [class_ badgetype]
-- | Lint Levels directly render into badges
instance ToHtml Level where
- toHtml level = badge level (toHtml $ show level)
+ toHtml level = badge level (toHtml (show level :: Text))
-- | Hints are just text with a level
instance ToHtml Hint where
@@ -142,7 +136,7 @@ instance ToHtml DirResult where
"\
\d3.select(\"#exitGraph\")\n\
\ .graphviz()\n\
- \ .dot(\"" <> T.pack (escapeJSON $ showDot dirresultGraph) <> "\")\n\
+ \ .dot(\"" <> toText (escapeJSON $ showDot dirresultGraph) <> "\")\n\
\ .render()\n\
\"