blob: d820c2041053def5fb25ecb6d9b69e9152197943 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Monad.Trans.Maybe
import Control.Monad.Writer
import qualified Data.Aeson as Aeson
import Data.Map (Map, (!?))
import Data.Maybe (isJust, mapMaybe)
import Data.Set (Set, fromList)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Vector (Vector)
import qualified Data.Vector as V
import LintWriter (LintWriter, LintResult, Hint(..), Level(..))
import Properties (checkProperty)
import Tiled2
import Util (showText)
checkLayer :: Layer -> LintWriter ()
checkLayer layer =
mapM_ (checkProperty layer) (layerProperties layer)
-- TODO: possibly expand this to something more detailed?
showContext :: Text -> Text
showContext ctxt = " (in layer " <> ctxt <> ")\n"
-- | pretty-printer for a result of WriterMaybe (currently only for errors/hints)
showResult :: Show a => Text -> LintResult a -> Maybe Text
showResult ctxt (Left hint) = Just $ "ERROR: " <> hintMsg hint <> showContext ctxt
showResult _ (Right (a, [])) = Nothing
showResult ctxt (Right (a, hints)) = Just $ showHints hints
where
showHints hints = T.concat (mapMaybe showHint hints)
-- TODO: make the "log level" configurable
showHint Hint { hintMsg, hintLevel } = case hintLevel of
Info -> Nothing
_ -> Just $ showText hintLevel <> ": " <> hintMsg <> ctxtHint
ctxtHint = showContext ctxt
main :: IO ()
main = do
Right map <- loadTiledmap "example.json"
-- LintWriter is a Writer transformer, so run it with runWriterT
let lints = fmap (runWriterT . checkLayer) (tiledmapLayers map)
-- well this is a bit awkward (but how to get layer names otherwise?)
let lines = V.mapMaybe thing (tiledmapLayers map)
where thing layer = (showResult (T.pack $ layerName layer)
. runWriterT . checkLayer) layer
mapM_ T.putStr lines
|
