diff options
| -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)) = |