summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorstuebinm2021-09-17 23:50:45 +0200
committerstuebinm2021-09-17 23:50:45 +0200
commitbfe45dc4996537b72436f4041d0ca819aa3444e1 (patch)
tree70e4966273b5447159bf39b4556e02affe911801 /lib
parent7a9226d84cf9dde33d0fc3e7852a22c36ab1c39b (diff)
(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?
Diffstat (limited to '')
-rw-r--r--lib/CheckMap.hs47
-rw-r--r--lib/LintWriter.hs11
2 files changed, 41 insertions, 17 deletions
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?
diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs
index ca7ff08..8e45812 100644
--- a/lib/LintWriter.hs
+++ b/lib/LintWriter.hs
@@ -10,20 +10,23 @@ import Control.Monad.Trans.Maybe ()
import Control.Monad.Writer (MonadTrans (lift),
MonadWriter (tell), WriterT)
import Data.Aeson (ToJSON (toJSON))
-import Data.Text (Text)
+import Data.Text (Text, unpack)
import GHC.Generics (Generic)
-
-- | Levels of errors and warnings, collectively called
-- "Hints" until I can think of some better name
-data Level = Warning | Suggestion | Info | Forbidden | Error
+data Level = Warning | Suggestion | Info | Forbidden | Error | Fatal
deriving (Show, Generic, ToJSON)
-- | a hint comes with an explanation (and a level)
data Hint = Hint
{ hintLevel :: Level
, hintMsg :: Text }
- deriving (Show, Generic, ToJSON)
+ deriving (Generic, ToJSON)
+
+instance Show Hint where
+ show Hint { hintMsg, hintLevel } =
+ show hintLevel <> ": " <> unpack hintMsg
-- shorter constructor
hint :: Level -> Text -> Hint