diff options
Diffstat (limited to '')
-rw-r--r-- | lib/CheckMap.hs | 59 |
1 files changed, 28 insertions, 31 deletions
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs index 0de9094..b32bad6 100644 --- a/lib/CheckMap.hs +++ b/lib/CheckMap.hs @@ -5,33 +5,31 @@ {-# LANGUAGE OverloadedStrings #-} -- | Module that contains the high-level checking functions +{-# OPTIONS_GHC -Wno-deferred-out-of-scope-variables #-} 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 GHC.Generics (Generic) - -import LintWriter (LintResult (..), LintWriter, - lintResultToDeps, lintToDep, - runLintWriter) -import Properties (checkLayerProperty, checkMap) -import Tiled2 (Layer (layerName, layerProperties), - Tiledmap (tiledmapLayers), - loadTiledmap) -import Types (Dep, Level (..), Lint (..), hint, - lintLevel) -import Util (PrettyPrint (prettyprint), - prettyprint) +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 GHC.Generics (Generic) + +import LintWriter (LayerContext (..), LintResult (..), LintWriter, + lintToDep, resultToDeps, resultToLints, + runLintWriter) +import Properties (checkLayerProperty, checkMap) +import Tiled2 (Layer (layerName, layerProperties), + Tiledmap (tiledmapLayers), loadTiledmap) +import Types (Dep, Level (..), Lint (..), hint, lintLevel) +import Util (PrettyPrint (prettyprint), prettyprint) + -- | What this linter produces: lints for a single map data MapResult a = MapResult - { mapresultLayer :: Maybe (Map Text (LintResult a)) + { mapresultLayer :: Maybe (Map Text (LintResult LayerContext)) , mapresultGeneral :: [Lint] , mapresultDepends :: [Dep] } deriving (Generic, ToJSON) @@ -57,21 +55,22 @@ runLinter :: Tiledmap -> MapResult () runLinter tiledmap = MapResult { mapresultLayer = Just layerMap , mapresultGeneral = generalLints -- no general lints for now - , mapresultDepends = concatMap (lintResultToDeps . snd) layer + , mapresultDepends = concatMap (resultToDeps . snd) layer <> mapMaybe lintToDep generalLints } where - layerMap :: Map Text (LintResult ()) + layerMap :: Map Text (LintResult LayerContext) layerMap = fromList layer layer = V.toList . V.map runCheck $ tiledmapLayers tiledmap - where runCheck l = (layerName l, LintResult $ runWriterT (checkLayer l)) + where runCheck l = (layerName l, runLintWriter (LayerContext ()) (checkLayer l)) -- lints collected from properties - generalLints = runLintWriter (checkMap tiledmap) + generalLints = + resultToLints $ runLintWriter () (checkMap tiledmap) -- | collect lints on a single map layer -checkLayer :: Layer -> LintWriter () +checkLayer :: Layer -> LintWriter LayerContext checkLayer layer = mapM_ (checkLayerProperty layer) (layerProperties layer) @@ -95,11 +94,9 @@ showContext ctxt = " (in layer " <> ctxt <> ")\n" -- | pretty-printer for a LintResult. Isn't an instance of PrettyPrint since -- it needs to know about the result's context (yes, there could be -- a wrapper type for that – but I wasn't really in the mood) -showResult :: Text -> LintResult a -> Maybe Text -showResult ctxt (LintResult res) = case res of - Left hint -> Just $ "Fatal: " <> prettyprint hint - Right (_, []) -> Nothing - Right (_, hints) -> Just $ T.concat (mapMaybe showHint hints) +showResult :: Text -> LintResult c -> Maybe Text +showResult ctxt (LintResult (_, lints)) = + Just $ T.concat (mapMaybe showHint lints) where -- TODO: make the "log level" configurable showHint hint = case lintLevel hint of |