From 677d11091bf7913e469827d84d485ef1f321959a Mon Sep 17 00:00:00 2001
From: Zachary Snow <zach@zachjs.com>
Date: Mon, 9 Sep 2019 18:44:04 +0200
Subject: [PATCH] added monadic file traversal helper

---
 src/Convert/Traverse.hs | 25 +++++++++++++++++--------
 1 file changed, 17 insertions(+), 8 deletions(-)

diff --git a/src/Convert/Traverse.hs b/src/Convert/Traverse.hs
index f3142c0..3c7d7c3 100644
--- a/src/Convert/Traverse.hs
+++ b/src/Convert/Traverse.hs
@@ -79,6 +79,7 @@ module Convert.Traverse
 , traverseScopesM
 , scopedConversion
 , stately
+, traverseFilesM
 , traverseFiles
 ) where
 
@@ -1068,17 +1069,25 @@ stately mapper thing = do
 -- packages, or typenames in other files. Global resolution of modules and
 -- interfaces is more commonly expected than global resolution of typenames and
 -- packages.
+traverseFilesM
+    :: (Monoid w, Monad m)
+    => CollectorM (Writer w) AST
+    -> (w -> MapperM m AST)
+    -> MapperM m [AST]
+traverseFilesM fileCollectorM fileMapperM files =
+    mapM traverseFileM files
+    where
+        globalNotes = execWriter $ mapM fileCollectorM files
+        traverseFileM file =
+            fileMapperM notes file
+            where
+                localNotes = execWriter $ fileCollectorM file
+                notes = localNotes <> globalNotes
 traverseFiles
     :: Monoid w
     => CollectorM (Writer w) AST
     -> (w -> Mapper AST)
     -> Mapper [AST]
 traverseFiles fileCollectorM fileMapper files =
-    map traverseFile files
-    where
-        globalNotes = execWriter $ mapM fileCollectorM files
-        traverseFile file =
-            fileMapper notes file
-            where
-                localNotes = execWriter $ fileCollectorM file
-                notes = localNotes <> globalNotes
+    evalState (traverseFilesM fileCollectorM fileMapperM  files) ()
+    where fileMapperM = (\w -> return . fileMapper w)