diff options
author | stuebinm | 2021-09-17 23:50:45 +0200 |
---|---|---|
committer | stuebinm | 2021-09-17 23:50:45 +0200 |
commit | bfe45dc4996537b72436f4041d0ca819aa3444e1 (patch) | |
tree | 70e4966273b5447159bf39b4556e02affe911801 /lib | |
parent | 7a9226d84cf9dde33d0fc3e7852a22c36ab1c39b (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 'lib')
-rw-r--r-- | lib/CheckMap.hs | 47 | ||||
-rw-r--r-- | lib/LintWriter.hs | 11 |
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 |