diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/CheckMap.hs | 24 | ||||
| -rw-r--r-- | lib/LintWriter.hs | 12 | ||||
| -rw-r--r-- | lib/Properties.hs | 7 | ||||
| -rw-r--r-- | lib/Util.hs | 6 |
4 files changed, 20 insertions, 29 deletions
diff --git a/lib/CheckMap.hs b/lib/CheckMap.hs index 3966988..c03197c 100644 --- a/lib/CheckMap.hs +++ b/lib/CheckMap.hs @@ -5,7 +5,6 @@ {-# LANGUAGE OverloadedStrings #-} -- | Module that contains the high-level checking functions -{-# OPTIONS_GHC -Wno-deferred-out-of-scope-variables #-} module CheckMap (loadAndLintMap) where import Data.Aeson (ToJSON) @@ -22,7 +21,7 @@ import LintWriter (LintResult (..), LintWriter, askContext, import Properties (checkLayerProperty, checkMap) import Tiled2 (Layer (layerName, layerProperties), Tiledmap (tiledmapLayers), loadTiledmap) -import Types (Dep, Level (..), Lint (..), hint, lintLevel) +import Types (Dep, Level (..), Lint (..), hint) import Util (PrettyPrint (prettyprint), prettyprint) @@ -81,26 +80,9 @@ instance PrettyPrint a => PrettyPrint (MapResult a) where where -- TODO: this can be simplified further prettyLayer :: [Text] - prettyLayer = mapMaybe - (uncurry showResult) + prettyLayer = map + (prettyprint . snd) (maybe [] toList . mapresultLayer $ mapResult) prettyGeneral :: [Text] prettyGeneral = flip (<>) "\n" . prettyprint <$> mapresultGeneral mapResult - --- TODO: possibly expand this to something more detailed? -showContext :: Text -> Text -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 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 - Info -> Nothing - _ -> Just $ prettyprint hint <> ctxtHint - ctxtHint = showContext ctxt diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs index de7d314..5ff56bd 100644 --- a/lib/LintWriter.hs +++ b/lib/LintWriter.hs @@ -14,12 +14,12 @@ import Control.Monad.Writer (MonadWriter (tell), WriterT, import Data.Aeson (ToJSON (toJSON)) import Data.Text (Text) -import Control.Monad.Reader (local) import Control.Monad.Trans.Reader (Reader, asks, runReader) import Control.Monad.Writer.Lazy (lift) import Data.Maybe (mapMaybe) -import GHC.Generics (Generic) +import qualified Data.Text as T import Types +import Util (PrettyPrint (..)) -- | for now, all context we have is how "deep" in the directory tree @@ -38,9 +38,15 @@ newtype LintResult ctxt = LintResult (LintResult' ctxt) -- better, less confusing serialisation of an Either Hint (a, [Hint]). -- Note that Left hint is also serialised as a list to make the resulting -- json schema more regular. -instance ToJSON a => ToJSON (LintResult a) where +instance ToJSON (LintResult a) where toJSON (LintResult res) = toJSON $ snd res +instance PrettyPrint ctxt => PrettyPrint (LintResult ctxt) where + prettyprint (LintResult (ctxt, res)) = + T.concat (map showHint res) + where showHint hint = prettyprint hint <> context + context = " (" <> prettyprint ctxt <> ")\n" + lintToDep :: Lint -> Maybe Dep lintToDep = \case Depends dep -> Just dep diff --git a/lib/Properties.hs b/lib/Properties.hs index 818378a..011b5ca 100644 --- a/lib/Properties.hs +++ b/lib/Properties.hs @@ -13,8 +13,8 @@ import Tiled2 (Layer (..), Property (..), PropertyValue (..), import Util (layerIsEmpty, prettyprint) import LintWriter (LintWriter, askContext, askFileDepth, complain, - dependsOn, forbid, info, suggest, warn) -import Paths + dependsOn, forbid, suggest, warn) +import Paths (RelPath (..), parsePath) import Types (Dep (Link, Local, LocalMap, MapLink)) @@ -88,8 +88,7 @@ checkLayerProperty :: Property -> LintWriter Layer checkLayerProperty p@(Property name _value) = case name of "jitsiRoom" -> do uselessEmptyLayer - unwrapString p $ \val -> do - info $ "found jitsi room: " <> prettyprint val + unwrapString p $ \_val -> do suggestProperty $ Property "jitsiTrigger" (StrProp "onaction") "jitsiTrigger" -> do isString p diff --git a/lib/Util.hs b/lib/Util.hs index 5cf27e3..47ee7f2 100644 --- a/lib/Util.hs +++ b/lib/Util.hs @@ -9,7 +9,8 @@ module Util where import Data.Aeson as Aeson import Data.Text (Text) import qualified Data.Text as T -import Tiled2 (Layer (layerData), PropertyValue (..), mkTiledId) +import Tiled2 (Layer (layerData), PropertyValue (..), layerName, + mkTiledId) -- | haskell's many string types are FUN … showText :: Show a => a -> Text @@ -39,6 +40,9 @@ instance PrettyPrint PropertyValue where instance PrettyPrint () where prettyprint _ = error "shouldn't pretty-print Unit" +instance PrettyPrint Layer where + prettyprint = (<>) "layer " . layerName + printPretty :: PrettyPrint a => a -> IO () printPretty = putStr . T.unpack . prettyprint |