1 files changed, 78 insertions, 0 deletions
diff --git a/src/Language/Fiddle/Ast/Internal/Instances/Walk.hs b/src/Language/Fiddle/Ast/Internal/Instances/Walk.hs
new file mode 100644
index 0000000..6feaff3
--- /dev/null
+++ b/src/Language/Fiddle/Ast/Internal/Instances/Walk.hs
@@ -0,0 +1,78 @@
+module Language.Fiddle.Ast.Internal.Instances.Walk (Walk (..), GWalk (..)) where
+
+import Data.Foldable (foldlM)
+import Data.Typeable
+import GHC.Generics
+
+class (Typeable t) => Walk t where
+  walk ::
+    (Monad m, Traversable f, Typeable f, Typeable a) =>
+    (forall t'. (Walk t', Typeable t', Typeable f, Typeable a) => t' f a -> s -> m s) ->
+    t f a ->
+    s ->
+    m ()
+  default walk ::
+    (GWalk (Rep (t f a)) f a, Generic (t f a), Monad m, Traversable f, Typeable f, Typeable a) =>
+    (forall t'. (Walk t', Typeable t', Typeable f, Typeable a) => t' f a -> s -> m s) ->
+    t f a ->
+    s ->
+    m ()
+  walk fn = gwalk fn . from
+
+class GWalk r f a where
+  gwalk ::
+    (Monad m, Typeable f, Typeable a, Traversable f) =>
+    (forall t'. (Walk t', Typeable t') => t' f a -> s -> m s) ->
+    r x ->
+    s ->
+    m ()
+
+instance (Traversable f, GWalk t f a) => (GWalk (M1 i c t) f a) where
+  gwalk fn (M1 a) = gwalk fn a
+
+instance
+  ( Traversable f,
+    GWalk l f a,
+    GWalk r f a
+  ) =>
+  (GWalk (l :+: r) f a)
+  where
+  gwalk fn (L1 l) = gwalk fn l
+  gwalk fn (R1 l) = gwalk fn l
+
+instance
+  ( Traversable f,
+    GWalk l f a,
+    GWalk r f a
+  ) =>
+  (GWalk (l :*: r) f a)
+  where
+  gwalk fn (l :*: r) s = gwalk fn l s >> gwalk fn r s
+
+instance
+  ( Traversable f,
+    Walk t
+  ) =>
+  GWalk (Rec0 (t f a)) f a
+  where
+  gwalk fn (K1 k) s = do
+    s' <- fn k s
+    walk fn k s'
+
+instance
+  ( Traversable f,
+    Traversable func,
+    Walk t
+  ) =>
+  GWalk (Rec0 (func (t f a))) f a
+  where
+  gwalk fn (K1 fk) s = do
+    mapM_
+      ( \tfa -> do
+          s' <- fn tfa s
+          walk fn tfa s'
+      )
+      fk
+
+instance GWalk (Rec0 q) f a where
+  gwalk _ _ _ = return ()