From e2767b3b80cab6cd95831cb7045a496f4916ae9b Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Wed, 22 Dec 2021 19:34:21 +0100
Subject: add zoom function for LintWriter

---
 lib/LintWriter.hs | 21 +++++++++++++++++++--
 1 file changed, 19 insertions(+), 2 deletions(-)

(limited to 'lib/LintWriter.hs')

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