From 7a9226d84cf9dde33d0fc3e7852a22c36ab1c39b Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Thu, 16 Sep 2021 23:18:14 +0200
Subject: input options, output json

input options are mostly dummies for now, but some work (e.g. --inpath
and --json). Lints can now be optionally printed as json to be
reasonably machine-readable (and the json can be pretty-printed to make
it human-readable again …).
---
 src/Main.hs | 85 +++++++++++++++++++++++++++++--------------------------------
 1 file changed, 41 insertions(+), 44 deletions(-)

(limited to 'src/Main.hs')

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
-- 
cgit v1.2.3