From 7e77e6335bab772c4be1b3f0594113d09cd4a366 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Thu, 23 Sep 2021 03:01:09 +0200
Subject: handle all maps in entire repositories

(+ checking that paths don't run outside of respositories)
---
 lib/CheckMap.hs | 48 ++++++++++++++++++++++++++----------------------
 1 file changed, 26 insertions(+), 22 deletions(-)

(limited to 'lib/CheckMap.hs')

diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index 8d670d5..016ec0b 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -7,22 +7,24 @@
 -- | 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           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           System.FilePath.Posix (splitPath)
 
-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)
+
+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)
 
 
 
@@ -36,8 +38,10 @@ data MapResult = MapResult
 
 
 -- | this module's raison d'être
-loadAndLintMap :: FilePath -> IO MapResult
-loadAndLintMap path = loadTiledmap path >>= pure . \case
+-- Lints the map at `path`, and limits local links to at most `depth`
+-- layers upwards in the file hierarchy
+loadAndLintMap :: FilePath -> Int -> IO MapResult
+loadAndLintMap path depth = loadTiledmap path >>= pure . \case
     Left err -> MapResult
       { mapresultLayer = Nothing
       , mapresultDepends = []
@@ -47,11 +51,11 @@ loadAndLintMap path = loadTiledmap path >>= pure . \case
         ]
       }
     Right waMap ->
-      runLinter waMap
+      runLinter waMap depth
 
 -- | lint a loaded map
-runLinter :: Tiledmap -> MapResult
-runLinter tiledmap = MapResult
+runLinter :: Tiledmap -> Int -> MapResult
+runLinter tiledmap depth = MapResult
   { mapresultLayer = Just layerMap
   , mapresultGeneral = generalLints  -- no general lints for now
   , mapresultDepends = concatMap (resultToDeps . snd) layer
@@ -61,11 +65,11 @@ runLinter tiledmap = MapResult
     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)
+      where runCheck l = (layerName l, runLintWriter l depth checkLayer)
 
     -- lints collected from properties
     generalLints =
-      resultToLints $ runLintWriter tiledmap 0 checkMap
+      resultToLints $ runLintWriter tiledmap depth checkMap
 
 
 -- | collect lints on a single map layer
-- 
cgit v1.2.3