Select Git revision
CheckMap.hs
CheckMap.hs 4.11 KiB
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Module that contains the high-level checking functions
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)
-- | What this linter produces: lints for a single map
data MapResult a = MapResult
{ mapresultLayer :: Maybe (Map Text (LintResult a))
, mapresultGeneral :: [Lint]
, mapresultDepends :: [Dep]
} deriving (Generic, ToJSON)
-- | this module's raison d'être
loadAndLintMap :: FilePath -> IO (MapResult ())
loadAndLintMap path = loadTiledmap path >>= pure . \case
Left err -> MapResult
{ mapresultLayer = Nothing
, mapresultDepends = []
, 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 = Just layerMap
, mapresultGeneral = generalLints -- no general lints for now
, mapresultDepends = concatMap (lintResultToDeps . snd) layer
<> mapMaybe lintToDep generalLints
}
where
layerMap :: Map Text (LintResult ())
layerMap = fromList layer
layer = V.toList . V.map runCheck $ tiledmapLayers tiledmap
where runCheck l = (layerName l, LintResult $ runWriterT (checkLayer l))
-- lints collected from properties
generalLints = runLintWriter (checkMap tiledmap)