summaryrefslogtreecommitdiff
path: root/lib/CheckMap.hs
diff options
context:
space:
mode:
authorstuebinm2021-09-18 23:21:15 +0200
committerstuebinm2021-09-18 23:21:15 +0200
commitccb57f9a16b47aab55f786b976b0b8e89ff49f36 (patch)
treece757ccdf2eb0bfde8bcfc3cf28dab602cc5643b /lib/CheckMap.hs
parent0bd2e836d96fe864b00d2085f29e932130722cc3 (diff)
collecting map dependencies
Diffstat (limited to '')
-rw-r--r--lib/CheckMap.hs15
1 files changed, 10 insertions, 5 deletions
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index 9402170..9908fdd 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -16,12 +16,13 @@ import qualified Data.Text as T
import qualified Data.Vector as V
import GHC.Generics (Generic)
-import LintWriter (LintResult (..), LintWriter)
+import LintWriter (LintResult (..), LintWriter,
+ lintsToDeps)
import Properties (checkProperty)
import Tiled2 (Layer (layerName, layerProperties),
Tiledmap (tiledmapLayers),
loadTiledmap)
-import Types (Level (..), Lint (..), hint,
+import Types (Dep, Level (..), Lint (..), hint,
lintLevel)
import Util (PrettyPrint (prettyprint),
prettyprint)
@@ -31,6 +32,7 @@ import Util (PrettyPrint (prettyprint),
data MapResult a = MapResult
{ mapresultLayer :: Maybe (Map Text (LintResult a))
, mapresultGeneral :: [Lint]
+ , mapresultDepends :: [Dep]
} deriving (Generic, ToJSON)
@@ -40,6 +42,7 @@ loadAndLintMap :: FilePath -> IO (MapResult ())
loadAndLintMap path = loadTiledmap path >>= pure . \case
Left err -> MapResult
{ mapresultLayer = Nothing
+ , mapresultDepends = []
, mapresultGeneral =
[ hint Fatal . T.pack $
path <> ": parse error (probably invalid json/not a tiled map): " <> err
@@ -51,12 +54,14 @@ loadAndLintMap path = loadTiledmap path >>= pure . \case
-- | lint a loaded map
runLinter :: Tiledmap -> MapResult ()
runLinter tiledmap = MapResult
- { mapresultLayer = Just layer
+ { mapresultLayer = Just layerMap
, mapresultGeneral = [] -- no general lints for now
+ , mapresultDepends = concatMap (lintsToDeps . snd) layer
}
where
- layer :: Map Text (LintResult ())
- layer = fromList . V.toList . V.map runCheck $ tiledmapLayers tiledmap
+ layerMap :: Map Text (LintResult ())
+ layerMap = fromList layer
+ layer = V.toList . V.map runCheck $ tiledmapLayers tiledmap
where runCheck l = (layerName l, LintResult $ runWriterT (checkLayer l))
-- | collect lints on a single map layer