From bfe45dc4996537b72436f4041d0ca819aa3444e1 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Fri, 17 Sep 2021 23:50:45 +0200
Subject: (somewhat) reasonable representation of parse errors

This makes map loading (and parsing) part of the linter, and also makes
it return "general lints" and nothing else in case that failed.

Possibly a sum type would be nicer here, but I guess it's not really
important since everything ends up as json anyways?
---
 lib/CheckMap.hs | 47 ++++++++++++++++++++++++++++++++++-------------
 1 file changed, 34 insertions(+), 13 deletions(-)

(limited to 'lib/CheckMap.hs')

diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs
index af80295..97e6a8c 100644
--- a/lib/CheckMap.hs
+++ b/lib/CheckMap.hs
@@ -1,36 +1,54 @@
 {-# LANGUAGE DeriveAnyClass    #-}
 {-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE NamedFieldPuns    #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 -- | Module that contains the high-level checking functions
-module CheckMap where
+module CheckMap (loadAndLintMap) where
 
+import           Control.Monad.Trans.Writer (WriterT (runWriterT))
+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           Control.Monad.Trans.Writer
-import           Data.Aeson                 (ToJSON)
-import           Data.Map                   (Map, fromList, toList)
 import           GHC.Generics               (Generic)
+
 import           LintWriter                 (Hint (..), Level (..),
-                                             LintResult (..), LintWriter)
+                                             LintResult (..), LintWriter, hint)
 import           Properties                 (checkProperty)
-import           Tiled2
+import           Tiled2                     (Layer (layerName, layerProperties),
+                                             Tiledmap (tiledmapLayers),
+                                             loadTiledmap)
 import           Util                       (showText)
 
--- | What this linter produces
+-- | What this linter produces: lints for a single map
 data MapResult a = MapResult
-  { mapresultLayer   :: Map Text (LintResult a)
+  { mapresultLayer   :: Maybe (Map Text (LintResult a))
   , mapresultGeneral :: [Hint]
   } deriving (Generic, ToJSON)
 
--- | the main thing. runs the linter and everything
+
+
+-- | this module's raison d'être
+loadAndLintMap :: FilePath -> IO (MapResult ())
+loadAndLintMap path = loadTiledmap path >>= pure . \case
+    Left err -> MapResult
+      { mapresultLayer = Nothing
+      , mapresultGeneral =
+        [ hint Fatal . T.pack $
+          path <> ": parse error (probably invalid json/not a tiled map): " <> err
+        ]
+      }
+    Right waMap ->
+      runLinter waMap
+
+-- | lint a loaded map
 runLinter :: Tiledmap -> MapResult ()
 runLinter tiledmap = MapResult
-  { mapresultLayer = layer
+  { mapresultLayer = Just layer
   , mapresultGeneral = [] -- no general lints for now
   }
   where
@@ -47,12 +65,15 @@ checkLayer layer =
 -- this instance of show produces a reasonably human-readable
 -- list of lints that can be shown e.g. on a console
 instance Show a => Show (MapResult a) where
-  show mapResult = concat prettyLayer
+  show mapResult = concat $ prettyGeneral <> prettyLayer
     where
+      -- TODO: this can be simplified further
       prettyLayer :: [String]
       prettyLayer = mapMaybe
         (\(name, lints) -> T.unpack <$> showResult name lints)
-        (toList . mapresultLayer $ mapResult)
+        (maybe [] toList . mapresultLayer $ mapResult)
+      prettyGeneral :: [String]
+      prettyGeneral = show <$> mapresultGeneral mapResult
 
 
 -- TODO: possibly expand this to something more detailed?
-- 
cgit v1.2.3