diff options
author | stuebinm | 2021-12-23 02:55:52 +0000 |
---|---|---|
committer | stuebinm | 2021-12-23 02:55:52 +0000 |
commit | 9fd195314d30658052d2bdfd3bcd7a1da4485bed (patch) | |
tree | 66802980fc0faf9ab2b15f2bc58120f307303aac /lib/LintWriter.hs | |
parent | ebfc8be95e83852081d8dc93d2bf4717df18583e (diff) | |
parent | c82e15aebf3c9d88116be75082d938be8c4d635e (diff) |
Merge branch 'extended-scripts' into 'main'
Extended scripts support
See merge request hub/walint!1
Diffstat (limited to '')
-rw-r--r-- | lib/LintWriter.hs | 21 |
1 files changed, 19 insertions, 2 deletions
diff --git a/lib/LintWriter.hs b/lib/LintWriter.hs index 74df70a..bc2decf 100644 --- a/lib/LintWriter.hs +++ b/lib/LintWriter.hs @@ -16,6 +16,7 @@ module LintWriter , LintWriter' , LintResult , invertLintResult + , zoom -- * working with lint results , resultToDeps , resultToOffers @@ -43,9 +44,9 @@ module LintWriter import Data.Text (Text) import Badges (Badge) -import Control.Monad.State (StateT, modify) +import Control.Monad.State (StateT, modify, MonadState (put)) import Control.Monad.Trans.Reader (Reader, asks, runReader) -import Control.Monad.Trans.State (runStateT) +import Control.Monad.Trans.State (runStateT, get) import Control.Monad.Writer.Lazy (lift) import Data.Bifunctor (Bifunctor (second)) import Data.Map (Map, fromListWith) @@ -86,6 +87,22 @@ runLintWriter config context depth linter = LinterState $ (depth, context, config) where runstate = runStateT linter (LinterState ([], context)) + +zoom :: (a -> b) -> (b -> a) -> LintWriter a -> LintWriter' b a +zoom embed extract operation = do + config <- lintConfig id + depth <- askFileDepth + let result ctxt = runLintWriter config ctxt depth operation + LinterState (lints,a) <- get + let res = result . extract $ a + put $ LinterState + . (resultToLints res <> lints,) + . embed + . resultToAdjusted + $ res + pure $ resultToAdjusted res + + -- | "invert" a linter's result, grouping lints by their messages invertLintResult :: HasName ctxt => LintResult ctxt -> Map Hint [ctxt] invertLintResult (LinterState (lints, ctxt)) = |