summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs85
1 files changed, 41 insertions, 44 deletions
diff --git a/src/Main.hs b/src/Main.hs
index d820c20..f0af6c1 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,57 +1,54 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
{-# 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 Data.Maybe (fromMaybe)
+import WithCli
+
+import CheckMap (runLinter)
+import Data.Aeson (encode)
+import Data.Aeson.Encode.Pretty (encodePretty)
+import qualified Data.ByteString.Lazy as LB
+import qualified Data.ByteString.Lazy.Encoding as LB
+import Data.Text.Lazy as T
+import System.IO (utf8)
import Tiled2
-import Util (showText)
+-- | the options this cli tool can take
+data Options = Options
+ { inpath :: Maybe String
+ -- ^ path to input map files
+ , outpath :: Maybe String
+ -- ^ path to out directory (should be empty)
+ , allowScripts :: Bool
+ -- ^ pass --allowScripts to allow javascript in map
+ , scriptInject :: Maybe String
+ -- ^ optional filepath to javascript that should be injected
+ , json :: Bool
+ -- ^ emit json if --json was given
+ , pretty :: Bool
+ -- ^ pretty-print the json to make it human-readable
+ } deriving (Show, Generic, HasArguments)
-checkLayer :: Layer -> LintWriter ()
-checkLayer layer =
- mapM_ (checkProperty layer) (layerProperties layer)
+main :: IO ()
+main = withCli run
--- TODO: possibly expand this to something more detailed?
-showContext :: Text -> Text
-showContext ctxt = " (in layer " <> ctxt <> ")\n"
+run :: Options -> IO ()
+run options = do
+ -- TODO: what if parsing fails and we get Left err?
+ Right waMap <- loadTiledmap $ fromMaybe "example.json" (inpath options)
--- | 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
+ let lints = runLinter waMap
+ if json options
+ then printLB
+ $ if pretty options then encodePretty lints else encode lints
+ else print lints
-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
+-- | haskell's many string types are FUN …
+printLB :: LB.ByteString -> IO ()
+printLB = putStrLn . T.unpack . LB.decode utf8