summaryrefslogtreecommitdiff
path: root/lib/CheckMap.hs
diff options
context:
space:
mode:
authorstuebinm2021-11-09 20:24:17 +0100
committerstuebinm2021-11-09 20:42:10 +0100
commit652c2030c5ef39bf1dd34d26064e1059431898f0 (patch)
tree7100fbdfabbfa0f237e05ae1d0d2e2debb380125 /lib/CheckMap.hs
parentd0dc669c495f5f9e3dae20481e0aae183f606519 (diff)
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.
Diffstat (limited to '')
-rw-r--r--lib/CheckMap.hs37
1 files changed, 23 insertions, 14 deletions
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