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
70
71
72
73
74
|
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Module that contains the high-level checking functions
module CheckMap where
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector as V
import Control.Monad.Trans.Writer
import Data.Aeson (ToJSON)
import Data.Map (Map, fromList, toList)
import GHC.Generics (Generic)
import LintWriter (Hint (..), Level (..),
LintResult (..), LintWriter)
import Properties (checkProperty)
import Tiled2
import Util (showText)
-- | What this linter produces
data MapResult a = MapResult
{ mapresultLayer :: Map Text (LintResult a)
, mapresultGeneral :: [Hint]
} deriving (Generic, ToJSON)
-- | the main thing. runs the linter and everything
runLinter :: Tiledmap -> MapResult ()
runLinter tiledmap = MapResult
{ mapresultLayer = layer
, mapresultGeneral = [] -- no general lints for now
}
where
layer :: Map Text (LintResult ())
layer = fromList . V.toList . V.map runCheck $ tiledmapLayers tiledmap
where runCheck l = (layerName l, LintResult $ runWriterT (checkLayer l))
-- | collect lints on a single map layer
checkLayer :: Layer -> LintWriter ()
checkLayer layer =
mapM_ (checkProperty layer) (layerProperties layer)
-- this instance of show produces a reasonably human-readable
-- list of lints that can be shown e.g. on a console
instance Show a => Show (MapResult a) where
show mapResult = concat prettyLayer
where
prettyLayer :: [String]
prettyLayer = mapMaybe
(\(name, lints) -> T.unpack <$> showResult name lints)
(toList . mapresultLayer $ mapResult)
-- TODO: possibly expand this to something more detailed?
showContext :: Text -> Text
showContext ctxt = " (in layer " <> ctxt <> ")\n"
-- | pretty-printer for a LintResult. Isn't an instance of Show since
-- it needs to know about the result's context (yes, there could be
-- a wrapper type for that – but I wasn't really in the mood)
showResult :: Show a => Text -> LintResult a -> Maybe Text
showResult ctxt (LintResult (Left hint)) = Just $ "ERROR: " <> hintMsg hint <> showContext ctxt
showResult _ (LintResult (Right (_, []))) = Nothing
showResult ctxt (LintResult (Right (_, hints))) = Just $ T.concat (mapMaybe showHint hints)
where
-- TODO: make the "log level" configurable
showHint Hint { hintMsg, hintLevel } = case hintLevel of
Info -> Nothing
_ -> Just $ showText hintLevel <> ": " <> hintMsg <> ctxtHint
ctxtHint = showContext ctxt
|
