diff options
| -rw-r--r-- | lib/LintWriter.hs | 36 | ||||
| -rw-r--r-- | lib/Properties.hs | 2 |
2 files changed, 24 insertions, 14 deletions
diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs index d71d037..8d91948 100644 --- a/lib/LintWriter.hs +++ b/lib/LintWriter.hs @@ -6,34 +6,37 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TupleSections #-} -- | a monad that collects warnings, outputs, etc, -{-# LANGUAGE TupleSections #-} module LintWriter where -import Control.Monad.Trans.Maybe () -import Control.Monad.Writer (MonadWriter (tell), WriterT, - runWriterT) import Data.Aeson (ToJSON (toJSON)) import Data.Text (Text) +import Control.Monad.State (StateT, modify) import Control.Monad.Trans.Reader (Reader, asks, runReader) +import Control.Monad.Trans.State (runStateT) import Control.Monad.Writer.Lazy (lift) +import Data.Bifunctor (Bifunctor (second)) import Data.Map (Map, fromListWith) import Data.Maybe (mapMaybe) import qualified Data.Text as T -import Tiled2 (HasName (getName)) -import Types import Util (PrettyPrint (..)) +import Tiled2 (HasName) +import Types -- | for now, all context we have is how "deep" in the directory tree -- we currently are type Context = Int +newtype LinterState ctxt = LinterState { fromLinterState :: ([Lint], ctxt)} + + -- | a monad to collect hints, with some context (usually the containing layer/etc.) type LintWriter ctxt = LintWriter' ctxt () -type LintWriter' ctxt res = WriterT [Lint] (Reader (Context, ctxt)) res +type LintWriter' ctxt res = StateT (LinterState ctxt) (Reader (Context, ctxt)) res -- wrapped to allow for manual writing of Aeson instances type LintResult' ctxt = (ctxt, [Lint]) -- Either Lint (a, [Lint]) @@ -42,7 +45,7 @@ newtype LintResult ctxt = LintResult (LintResult' ctxt) invertLintResult :: HasName ctxt => LintResult ctxt -> Map Hint [ctxt] invertLintResult (LintResult (ctxt, lints)) = - fromListWith (<>) $ fmap (, [ctxt]) $ lintsToHints lints + fromListWith (<>) $ (, [ctxt]) <$> lintsToHints lints -- better, less confusing serialisation of an Either Hint (a, [Hint]). -- Note that Left hint is also serialised as a list to make the resulting @@ -83,19 +86,26 @@ resultToLints (LintResult res) = snd res -- | run a linter runLintWriter :: ctxt -> Context -> LintWriter ctxt -> LintResult ctxt -runLintWriter c c' linter = LintResult (c, lints) - where lints = snd $ flip runReader (c',c) $ runWriterT linter +runLintWriter c c' linter = LintResult (c, fst $ fromLinterState lints) + where lints = snd $ runReader ranstate (c',c) + ranstate = runStateT linter (LinterState ([], c)) + +tell' :: Lint -> LintWriter ctxt +tell' l = modify $ \(LinterState (lints, ctxt)) -> LinterState (l:lints, ctxt) + -- | write a hint into the LintWriter monad lint :: Level -> Text -> LintWriter a -lint level = tell . (: []) . hint level +lint level text = tell' $ hint level text dependsOn :: Dep -> LintWriter a -dependsOn dep = tell . (: []) $ Depends dep +dependsOn dep = tell' $ Depends dep offersEntrypoint :: Text -> LintWriter a -offersEntrypoint = tell . (: []) . Offers +offersEntrypoint text = tell' $ Offers text +adjust :: (a -> a) -> LintWriter a +adjust f = modify $ LinterState . second f . fromLinterState info = lint Info diff --git a/lib/Properties.hs b/lib/Properties.hs index 65782c8..403df8e 100644 --- a/lib/Properties.hs +++ b/lib/Properties.hs @@ -88,7 +88,7 @@ checkTileset = do mapM_ checkTilesetProperty (fromMaybe [] $ tilesetProperties tileset) checkTilesetProperty :: Property -> LintWriter Tileset -checkTilesetProperty p@(Property name value) = case name of +checkTilesetProperty (Property name _value) = case name of "copyright" -> pure () -- only allow some licenses? _ -> pure () -- are there any other properties? |