diff options
Diffstat (limited to 'lib/CheckMap.hs')
-rw-r--r-- | lib/CheckMap.hs | 47 |
1 files changed, 34 insertions, 13 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? |