diff options
author | stuebinm | 2021-09-20 21:41:50 +0200 |
---|---|---|
committer | stuebinm | 2021-09-20 21:41:50 +0200 |
commit | 9a8d793f8f08fd5674bc6a917278ee7251bac56f (patch) | |
tree | 7fce0b5da0739a23af4c2f16794a3240d6c4080f /lib/CheckMap.hs | |
parent | 727f2cbc5feb3cdd30df3c78f39ba4a58e6c4832 (diff) |
rebuilding the core LintWriter monad
it is no longer an Either since that wasn't used anyways, but is now
also a Reader.
Diffstat (limited to 'lib/CheckMap.hs')
-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 |