blob: 49b87b23dc1ac0b32965468f5a79847398ccea2b (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
{-# LANGUAGE QuasiQuotes #-}
module Html where
import Data.Aeson qualified as Json
import Data.Aeson.KeyMap qualified as KeyMap
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map.Strict qualified as Map
import IHP.HSX.QQ (hsx)
import PossehlAnalyticsPrelude
import Text.Blaze.Html (Html)
import Text.Blaze.Html5 qualified as Html
import Prelude hiding (span)
-- | Render an arbitrary json value to HTML in a more-or-less reasonable fashion.
mkVal :: Json.Value -> Html
mkVal = \case
Json.Number n -> Html.toHtml @Text $ showToText n
Json.String s -> Html.toHtml @Text s
Json.Bool True -> [hsx|<em>true</em>|]
Json.Bool False -> [hsx|<em>false</em>|]
Json.Null -> [hsx|<em>null</em>|]
Json.Array arr -> toOrderedList mkVal arr
Json.Object obj ->
obj
& KeyMap.toMapText
& toDefinitionList (Html.toHtml @Text) mkVal
toOrderedList :: (Foldable t1) => (t2 -> Html) -> t1 t2 -> Html
toOrderedList mkValFn arr =
arr
& foldMap (\el -> Html.li $ mkValFn el)
& Html.ol
toUnorderedList :: (Foldable t1) => (t2 -> Html) -> t1 t2 -> Html
toUnorderedList mkValFn arr =
arr
& foldMap (\el -> Html.li $ mkValFn el)
& Html.ul
-- | Render a definition list from a Map
toDefinitionList :: (Text -> Html) -> (t -> Html) -> Map Text t -> Html
toDefinitionList mkKeyFn mkValFn obj =
obj
& Map.toList
& foldMap (\(k, v) -> Html.dt (mkKeyFn k) <> Html.dd (mkValFn v))
& Html.dl
-- | Render a table-like structure of json values as an HTML table.
toTable :: [[(Text, Json.Value)]] -> Html
toTable xs =
case xs & nonEmpty of
Nothing ->
[hsx|<p>No results.</p>|]
Just xs' -> do
let headers = xs' & NonEmpty.head <&> fst <&> (\h -> [hsx|<th>{h}</th>|]) & mconcat
let vals = xs' & foldMap (Html.tr . foldMap (Html.td . mkVal . snd))
[hsx|
<table class="table">
<thead>
<tr>
{headers}
</tr>
</thead>
<tbody>
{vals}
</tbody>
</table>
|]
|
