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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Module that contains the high-level checking functions
module CheckMap (loadAndLintMap, MapResult(..)) where
import Data.Aeson (ToJSON)
import Data.Map (Map, fromList, toList)
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector as V
import GHC.Generics (Generic)
import LintWriter (LintResult (..), LintWriter, askContext,
lintToDep, resultToDeps, resultToLints,
runLintWriter)
import Properties (checkLayerProperty, checkMap)
import Tiled2 (Layer (layerName, layerProperties),
Tiledmap (tiledmapLayers), loadTiledmap)
import Types (Dep, Level (..), Lint (..), hint)
import Util (PrettyPrint (prettyprint), prettyprint)
-- | What this linter produces: lints for a single map
data MapResult = MapResult
{ mapresultLayer :: Maybe (Map Text (LintResult Layer))
, mapresultGeneral :: [Lint]
, mapresultDepends :: [Dep]
} deriving (Generic, ToJSON)
-- | this module's raison d'être
loadAndLintMap :: FilePath -> IO MapResult
loadAndLintMap path = loadTiledmap path >>= pure . \case
Left err -> MapResult
{ mapresultLayer = Nothing
, mapresultDepends = []
, mapresultGeneral =
[ hint Fatal . T.pack $
path <> ": Fatal: " <> err
]
}
Right waMap ->
runLinter waMap
-- | lint a loaded map
runLinter :: Tiledmap -> MapResult
runLinter tiledmap = MapResult
{ mapresultLayer = Just layerMap
, mapresultGeneral = generalLints -- no general lints for now
, mapresultDepends = concatMap (resultToDeps . snd) layer
<> mapMaybe lintToDep generalLints
}
where
layerMap :: Map Text (LintResult Layer)
layerMap = fromList layer
layer = V.toList . V.map runCheck $ tiledmapLayers tiledmap
where runCheck l = (layerName l, runLintWriter l 0 checkLayer)
-- lints collected from properties
generalLints =
resultToLints $ runLintWriter tiledmap 0 checkMap
-- | collect lints on a single map layer
checkLayer :: LintWriter Layer
checkLayer = do
layer <- askContext
mapM_ checkLayerProperty (layerProperties layer)
-- human-readable lint output, e.g. for consoles
instance PrettyPrint MapResult where
prettyprint mapResult = T.concat $ prettyGeneral <> prettyLayer
where
-- TODO: this can be simplified further
prettyLayer :: [Text]
prettyLayer = map
(prettyprint . snd)
(maybe [] toList . mapresultLayer $ mapResult)
prettyGeneral :: [Text]
prettyGeneral = flip (<>) "\n" . prettyprint <$> mapresultGeneral mapResult
|
