diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Main.hs | 85 |
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 |