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
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Module that contains the high-level checking functions
module CheckMap (loadAndLintMap, MapResult(..)) where
import Data.Aeson (ToJSON)
import qualified Data.Aeson as A
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 Data.Aeson.Types ((.=))
import LintWriter (LintResult (..), LintWriter, askContext,
filterLintLevel, lintToDep, resultToDeps,
resultToLints, resultToOffers, runLintWriter)
import Properties (checkLayerProperty, checkMap)
import Tiled2 (Layer (layerName, layerProperties),
LoadResult (..), 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 :: Map Text (LintResult Layer)
, mapresultGeneral :: [Lint]
, mapresultDepends :: [Dep]
, mapresultProvides :: [Text]
} deriving (Generic)
instance ToJSON MapResult where
toJSON res = A.object
[ "layer" .= mapresultLayer res
, "general" .= mapresultGeneral res
-- TODO: not sure if these are necessary of even useful
, "depends" .= mapresultDepends res
, "provides" .= mapresultProvides res
]
-- | this module's raison d'être
-- Lints the map at `path`, and limits local links to at most `depth`
-- layers upwards in the file hierarchy
loadAndLintMap :: FilePath -> Int -> IO (Maybe MapResult)
loadAndLintMap path depth = loadTiledmap path >>= pure . \case
DecodeErr err -> Just $ MapResult
{ mapresultLayer = mempty
, mapresultDepends = []
, mapresultProvides = []
, mapresultGeneral =
[ hint Fatal . T.pack $
path <> ": Fatal: " <> err
]
}
IOErr err -> Nothing
Loaded waMap ->
Just (runLinter waMap depth)
-- | lint a loaded map
runLinter :: Tiledmap -> Int -> MapResult
runLinter tiledmap depth = MapResult
{ mapresultLayer = layerMap
, mapresultGeneral = generalLints -- no general lints for now
, mapresultDepends = concatMap (resultToDeps . snd) layer
<> mapMaybe lintToDep generalLints
, mapresultProvides = concatMap (resultToOffers . snd) layer
}
where
layerMap :: Map Text (LintResult Layer)
layerMap = fromList layer
layer = V.toList . V.map runCheck $ tiledmapLayers tiledmap
where runCheck l = (layerName l, runLintWriter l depth checkLayer)
-- lints collected from properties
generalLints =
resultToLints $ runLintWriter tiledmap depth 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 (Level, MapResult) where
prettyprint (level, mapResult) = if prettyLints == ""
then " all good!\n" else prettyLints
where
prettyLints = T.concat $ prettyGeneral <> prettyLayer
-- TODO: this can be simplified further
prettyLayer :: [Text]
prettyLayer = mapMaybe
(\(_,l) -> Just $ prettyprint (level, l))
(toList . mapresultLayer $ mapResult)
prettyGeneral :: [Text]
prettyGeneral = map
((<> "\n") . prettyprint)
. filterLintLevel level
$ mapresultGeneral mapResult
|
