feat: Add AdvanceStage typeclass and refactor code to use it

Introduced the `AdvanceStage` typeclass, which provides a mechanism to
transition AST elements between different compilation stages. This
abstraction facilitates easier traversal and modification of the syntax
tree as it progresses through various compilation phases.

1 files changed, 32 insertions, 7 deletions

diff --git a/src/Language/Fiddle/GenericTree.hs b/src/Language/Fiddle/GenericTree.hs
index 59db6aa..031f6ab 100644
--- a/src/Language/Fiddle/GenericTree.hs
+++ b/src/Language/Fiddle/GenericTree.hs
@@ -40,17 +40,38 @@ type Context stage =
 data GenericSyntaxTree f a where
   {- GenericSyntaxtTree with a name and children. -}
   SyntaxTreeObject ::
-    forall a f tree.
-    (Typeable tree) =>
+    forall t f a.
+    (Typeable t, Typeable f, Typeable a) =>
     String ->
     [GenericSyntaxTree f a] ->
     a ->
-    tree ->
+    t f a ->
     GenericSyntaxTree f a
   SyntaxTreeList :: [GenericSyntaxTree f a] -> GenericSyntaxTree f a
   SyntaxTreeDeferred :: f (GenericSyntaxTree f a) -> GenericSyntaxTree f a
   SyntaxTreeValue :: String -> GenericSyntaxTree f a
 
+alterGenericSyntaxTree ::
+  (Functor f) =>
+  (GenericSyntaxTree f a -> Maybe (GenericSyntaxTree f a)) ->
+  GenericSyntaxTree f a ->
+  GenericSyntaxTree f a
+alterGenericSyntaxTree fn genericTree
+  | (Just newGenericTree) <- fn genericTree = newGenericTree
+  | otherwise =
+      case genericTree of
+        SyntaxTreeObject str members annot tree ->
+          SyntaxTreeObject
+            str
+            (map (alterGenericSyntaxTree fn) members)
+            annot
+            tree
+        SyntaxTreeList members ->
+          SyntaxTreeList $ map (alterGenericSyntaxTree fn) members
+        SyntaxTreeDeferred sub ->
+          SyntaxTreeDeferred $ fmap (alterGenericSyntaxTree fn) sub
+        v -> v
+
 instance ToJSON Comment where
   toJSON (NormalComment str) = object ["normal" .= str]
   toJSON (DocComment str) = object ["doc" .= str]
@@ -71,9 +92,11 @@ instance ToJSON SourcePos where
         "col" .= sourceColumn sourcePos
       ]
 
-instance (Foldable f, ToJSON a) => ToJSON (GenericSyntaxTree f a) where
+instance (Foldable f) => ToJSON (GenericSyntaxTree f (Maybe Value)) where
   toJSON = \case
-    (SyntaxTreeObject typ membs a _) ->
+    (SyntaxTreeObject typ membs Nothing _) ->
+      object ["_con" .= typ, "_members" .= membs]
+    (SyntaxTreeObject typ membs (Just a) _) ->
       object ["_con" .= typ, "_members" .= membs, "_annot" .= a]
     (SyntaxTreeList l) ->
       Array $ Data.Vector.fromList $ map toJSON l
@@ -82,8 +105,10 @@ instance (Foldable f, ToJSON a) => ToJSON (GenericSyntaxTree f a) where
     (SyntaxTreeValue s) -> String (Data.Text.pack s)
 
   toEncoding = \case
-    (SyntaxTreeObject typ membs a t) ->
+    (SyntaxTreeObject typ membs (Just a) t) ->
       pairs $ "_type" .= show (typeOf t) <> "_con" .= typ <> "_members" .= membs <> "_annot" .= a
+    (SyntaxTreeObject typ membs Nothing t) ->
+      pairs $ "_type" .= show (typeOf t) <> "_con" .= typ <> "_members" .= membs
     (SyntaxTreeList l) ->
       foldable $ map toJSON l
     (SyntaxTreeDeferred fdef) ->
@@ -118,7 +143,7 @@ class ToGenericSyntaxTree (t :: SynTree) where
   toGenericSyntaxTree t = gToGenericSyntaxTree t (from t)
 
 class GToGenericSyntaxTree r f a where
-  gToGenericSyntaxTree :: (Typeable t) => t -> r x -> GenericSyntaxTree f a
+  gToGenericSyntaxTree :: (Typeable t, Typeable f, Typeable a) => t f a -> r x -> GenericSyntaxTree f a
 
 class GToMemberList r f a where
   gToMemberList :: Int -> r x -> [GenericSyntaxTree f a]