From 652c2030c5ef39bf1dd34d26064e1059431898f0 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Tue, 9 Nov 2021 20:24:17 +0100
Subject: first example of a map adjustment

this also includes some more monad plumbing, and an option for the
linter to actually write things out again. Some of the previous commit
was reverted a bit since it turned out to be stupid, but overall it was
suprisingly easy once I got around to it, so yay! i guess

Also includes a fairly silly example of how to use it.
---
 lib/CheckMap.hs | 37 +++++++++++++++++++++++--------------
 1 file changed, 23 insertions(+), 14 deletions(-)

(limited to 'lib/CheckMap.hs')

diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index 845513d..73909b9 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -20,10 +20,12 @@ import qualified Data.Vector      as V
 import           GHC.Generics     (Generic)
 
 
-import           LintWriter       (LintWriter, askContext, filterLintLevel,
-                                   invertLintResult, lintToDep, resultToDeps,
+import           Data.Bifunctor   (Bifunctor (second))
+import           Data.Functor     ((<&>))
+import           LintWriter       (filterLintLevel, invertLintResult, lintToDep,
+                                   resultToAdjusted, resultToDeps,
                                    resultToLints, resultToOffers, runLintWriter)
-import           Properties       (checkLayerProperty, checkMap, checkTileset)
+import           Properties       (checkLayer, checkMap, checkTileset)
 import           Tiled2           (HasName (getName),
                                    HasProperties (getProperties), Layer,
                                    LoadResult (..),
@@ -38,10 +40,17 @@ import           Util             (PrettyPrint (prettyprint), prettyprint)
 -- | What this linter produces: lints for a single map
 data MapResult = MapResult
   { mapresultLayer    :: Map Hint [Layer]
-  , mapresultTileset  :: Map Hint [Tileset] --Map Text (LintResult Tileset)
+  -- ^ lints that occurred in one or more layers
+  , mapresultTileset  :: Map Hint [Tileset]
+  -- ^ lints that occurred in one or more tilesets
   , mapresultDepends  :: [Dep]
+  -- ^ (external and local) dependencies of this map
   , mapresultProvides :: [Text]
+  -- ^ entrypoints provided by this map (needed for dependency checking)
+  , mapresultAdjusted :: Maybe Tiledmap
+  -- ^ the loaded map, with adjustments by the linter
   , mapresultGeneral  :: [Lint]
+  -- ^ general-purpose lints that didn't fit anywhere else
   } deriving (Generic)
 
 instance ToJSON MapResult where
@@ -66,14 +75,14 @@ instance ToJSON CollectedLints where
 -- 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 mempty mempty mempty mempty
+loadAndLintMap path depth = loadTiledmap path <&> (\case
+    DecodeErr err -> Just (MapResult mempty mempty mempty mempty Nothing
         [ hint Fatal . T.pack $
           path <> ": Fatal: " <> err
-        ]
+        ])
     IOErr _ -> Nothing
     Loaded waMap ->
-      Just (runLinter waMap depth)
+      Just (runLinter waMap depth))
 
 -- | lint a loaded map
 runLinter :: Tiledmap -> Int -> MapResult
@@ -85,6 +94,7 @@ runLinter tiledmap depth = MapResult
     <> concatMap resultToDeps layer
     <> concatMap resultToDeps tileset
   , mapresultProvides = concatMap resultToOffers layer
+  , mapresultAdjusted = Just adjustedMap
   }
   where
     layer = checkThing tiledmapLayers checkLayer
@@ -98,14 +108,13 @@ runLinter tiledmap depth = MapResult
     invertThing thing = M.unionsWith (<>) $ fmap invertLintResult thing
     -- lints collected from properties
     generalLints =
-      resultToLints $ runLintWriter tiledmap depth checkMap
+      resultToLints generalResult
 
+    generalResult = runLintWriter tiledmap depth checkMap
 
--- | collect lints on a single map layer
-checkLayer :: LintWriter Layer
-checkLayer = do
-  layer <- askContext
-  mapM_ checkLayerProperty (getProperties layer)
+    adjustedMap = (resultToAdjusted generalResult)
+      { tiledmapLayers = V.fromList . fmap resultToAdjusted $ layer }
+      -- TODO: this appears to have reordered map layers???
 
 -- human-readable lint output, e.g. for consoles
 instance PrettyPrint (Level, MapResult) where
-- 
cgit v1.2.3