summaryrefslogtreecommitdiff
path: root/lib/LintWriter.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/LintWriter.hs')
-rw-r--r--lib/LintWriter.hs20
1 files changed, 13 insertions, 7 deletions
diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs
index 54a5954..c8ab6d5 100644
--- a/lib/LintWriter.hs
+++ b/lib/LintWriter.hs
@@ -24,6 +24,7 @@ import Data.Maybe (mapMaybe)
import qualified Data.Text as T
import Util (PrettyPrint (..))
+import LintConfig (LintConfig')
import Tiled2 (HasName)
import Types
@@ -31,12 +32,14 @@ import Types
-- we currently are
type Context = Int
-newtype LinterState ctxt = LinterState { fromLinterState :: ([Lint], ctxt)}
+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 = StateT (LinterState ctxt) (Reader (Context, ctxt)) res
+type LintWriter' ctxt res =
+ StateT (LinterState ctxt) (Reader (Context, ctxt, LintConfig')) res
-- wrapped to allow for manual writing of Aeson instances
type LintResult' ctxt = (ctxt, [Lint]) -- Either Lint (a, [Lint])
@@ -88,9 +91,9 @@ resultToAdjusted :: LintResult a -> a
resultToAdjusted (LintResult res) = fst res
-- | run a linter. Returns the adjusted context, and a list of lints
-runLintWriter :: ctxt -> Context -> LintWriter ctxt -> LintResult ctxt
-runLintWriter c c' linter = LintResult (snd $ fromLinterState lints,fst $ fromLinterState lints)
- where lints = snd $ runReader ranstate (c',c)
+runLintWriter :: LintConfig' -> ctxt -> Context -> LintWriter ctxt -> LintResult ctxt
+runLintWriter config c c' linter = LintResult (snd $ fromLinterState lints,fst $ fromLinterState lints)
+ where lints = snd $ runReader ranstate (c',c, config)
ranstate = runStateT linter (LinterState ([], c))
tell' :: Lint -> LintWriter ctxt
@@ -122,7 +125,10 @@ complain = lint Error
-- | get the context as it was originally, without any modifications
askContext :: LintWriter' a a
-askContext = lift $ asks snd
+askContext = lift $ asks (\(_,a,_) -> a)
askFileDepth :: LintWriter' a Int
-askFileDepth = lift $ asks fst
+askFileDepth = lift $ asks (\(a,_,_) -> a)
+
+lintConfig :: (LintConfig' -> a) -> LintWriter' ctxt a
+lintConfig get = lift $ asks (\(_,_,config) -> get config)