summaryrefslogtreecommitdiff
path: root/server/Orphans.hs
blob: b46f72858aa68e8fb6f34f8964f0954980adf87d (plain)
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
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}


module Orphans where


import           Control.Monad (forM_, unless)
import qualified Data.Map      as M
import           Data.Text     (Text)
import           Lucid         (ToHtml)
import           Lucid.Base    (ToHtml (toHtml))
import           Lucid.Html5

import           CheckDir
import           CheckMap
import           Types
import           Util          (prettyprint)

instance ToHtml Hint where
  toHtml (Hint l m) = do
    span_ [class_ "level"] $ toHtml (show l)
    toHtml m


instance ToHtml DirResult where
  toHtml res@DirResult { .. } = do
    h3_ $ toHtml (show $ maximumLintLevel res)
    unless (null dirresultMissingAssets && null dirresultDeps) $ do
      h2_ "Dependencies"
      ul_ $ do
        forM_ dirresultMissingAssets $ \(MissingAsset missing) -> do
          li_ $ toHtml (prettyprint missing)
        forM_ dirresultDeps $ \missing -> do
          li_ $ toHtml (prettyprint missing)
    unless (null dirresultMaps) $ do
      h2_ "Maps"
      flip M.foldMapWithKey dirresultMaps $ \name MapResult { .. } -> do
        h3_ (toHtml name)
        ul_ $ do
          forM_ mapresultGeneral $ \lint ->
            li_ (toHtml lint)
          flip M.foldMapWithKey mapresultLayer $ \lint layers ->
            li_ $ do
              toHtml lint
              toHtml ("(in layer" :: Text)
              forM_ layers $ \layer ->
                span_ [class_ "layer"] (toHtml layer)
              toHtml (")" :: Text)
          flip M.foldMapWithKey mapresultTileset $ \lint tilesets ->
            li_ $ do
              toHtml lint
              toHtml ("( in layer" :: Text)
              forM_ tilesets $ \tileset ->
                span_ [class_ "tileset"] (toHtml tileset)
              toHtml (")" :: Text)