summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-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