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, 112 insertions, 128 deletions

diff --git a/src/Language/Fiddle/Parser.hs b/src/Language/Fiddle/Parser.hs
index 85ae65e..980925f 100644
--- a/src/Language/Fiddle/Parser.hs
+++ b/src/Language/Fiddle/Parser.hs
@@ -33,8 +33,8 @@ type Pa (a :: Stage -> (Type -> Type) -> Type -> Type) = P (a 'Stage1 F (Comment
 
 type PaS (a :: (Type -> Type) -> Type -> Type) = P (a F (Commented SourceSpan))
 
-comment :: P Comment
-comment =
+commentP :: P Comment
+commentP =
   token $ \case
     (TokComment c) -> Just (NormalComment c)
     (TokDocComment c) -> Just (DocComment c)
@@ -52,46 +52,46 @@ isComment (Token t _) =
 stripTrailingComments :: [Token s] -> [Token s]
 stripTrailingComments = reverse . dropWhile isComment . reverse
 
-directed :: Pa t -> PaS (Directed t 'Stage1)
-directed subparser = withMeta $ do
-  Directed <$> many directive <*> subparser
+directedP :: Pa t -> PaS (Directed t 'Stage1)
+directedP subparser = withMeta $ do
+  Directed <$> many directiveP <*> subparser
 
-directive :: PaS Directive
-directive =
+directiveP :: PaS Directive
+directiveP =
   withMeta $
-    Directive <$> defer directiveBodyTokens directiveBody
+    Directive <$> defer directiveBodyTokens directiveBodyP 
 
-directiveBody :: PaS DirectiveBody
-directiveBody = withMeta $ do
-  DirectiveBody <$> many (directiveElement <* (void (tok TokComma) <|> eof))
+directiveBodyP :: PaS DirectiveBody
+directiveBodyP = withMeta $ do
+  DirectiveBody <$> many (directiveElementP <* (void (tok TokComma) <|> eof))
 
-directiveElement :: PaS DirectiveElement
-directiveElement = withMeta $ do
-  identifier1 <- nextText
+directiveElementP :: PaS DirectiveElement
+directiveElementP = withMeta $ do
+  identifier1 <- nextTextP
   choice
     [ do
         tok TokColon
         let backend = identifier1
-        key <- nextText
+        key <- nextTextP
         choice
           [ do
               tok TokEq
-              DirectiveElementKeyValue (Just backend) key <$> directiveExpression,
+              DirectiveElementKeyValue (Just backend) key <$> directiveExpressionP,
             do
               return (DirectiveElementKey (Just backend) key)
           ],
       do
         tok TokEq
         let key = identifier1
-        DirectiveElementKeyValue Nothing key <$> directiveExpression,
+        DirectiveElementKeyValue Nothing key <$> directiveExpressionP,
       return $ DirectiveElementKey Nothing identifier1
     ]
 
-nextText :: PaS Identifier
-nextText = withMeta $ Identifier <$> token textOf
+nextTextP :: PaS Identifier
+nextTextP = withMeta $ Identifier <$> token textOf
 
-directiveExpression :: PaS DirectiveExpression
-directiveExpression = withMeta $ do
+directiveExpressionP :: PaS DirectiveExpression
+directiveExpressionP = withMeta $ do
   choice
     [ do
         token $ \case
@@ -103,80 +103,64 @@ directiveExpression = withMeta $ do
 fiddleUnit :: Pa FiddleUnit
 fiddleUnit = do
   withMeta
-    ( FiddleUnit <$> many1 (directed fiddleDecl <* tok TokSemi)
+    ( FiddleUnit <$> many1 (directedP fiddleDeclP <* tok TokSemi)
     )
-    <* many comment
+    <* many commentP
 
-stringToken :: P Text
-stringToken =
+stringTokenP :: P Text
+stringTokenP =
   token
     ( \case
         (TokString str) -> Just str
         _ -> Nothing
     )
 
-importList :: PaS ImportList
-importList = withMeta $ do
+importListP :: PaS ImportList
+importListP = withMeta $ do
   tok TokLParen
   ImportList
     <$> many (ident <* (tok TokComma <|> lookAhead (tok TokRParen)))
     <* tok TokRParen
 
-importStatement :: PaS ImportStatement
-importStatement =
+importStatementP :: PaS ImportStatement
+importStatementP =
   withMeta $
-    ImportStatement <$> stringToken <*> optionMaybe importList
+    ImportStatement <$> stringTokenP <*> optionMaybe importListP
 
-fiddleDecl :: Pa FiddleDecl
-fiddleDecl = do
+fiddleDeclP :: Pa FiddleDecl
+fiddleDeclP = do
   withMeta $ do
     t <- tokenType <$> anyToken
     case t of
-      KWOption -> OptionDecl <$> nextText <*> nextText
+      KWOption -> OptionDecl <$> nextTextP <*> nextTextP
       KWPackage ->
         PackageDecl
           <$> name
-          <*> defer body packageBody
+          <*> defer body packageBodyP
       KWUsing -> UsingDecl <$> name
-      KWLocation -> LocationDecl <$> ident <*> (tok TokEq >> expression)
-      KWBits -> BitsDecl <$> ident <*> (tok TokColon >> bitType)
-      KWImport -> ImportDecl <$> importStatement
+      KWLocation -> LocationDecl <$> ident <*> (tok TokEq >> expressionP)
+      KWBits -> BitsDecl <$> ident <*> (tok TokColon >> bitTypeP)
+      KWImport -> ImportDecl <$> importStatementP
       KWType ->
         ObjTypeDecl
           <$> ident
           <*> ( do
                   tok TokColon
-                  bt <- bodyType
-                  defer body (objTypeBody bt)
+                  bt <- bodyTypeP
+                  defer body (objTypeBodyP bt)
               )
       KWInstance ->
         ObjectDecl
           <$> ident
-          <*> (tok KWAt *> expression)
-          <*> (tok TokColon *> objType)
+          <*> (tok KWAt *> expressionP)
+          <*> (tok TokColon *> objTypeP)
       _ ->
         fail $
           printf "Unexpected token %s. Expected top-level declaration." (show t)
 
--- choice
---   [ tok KWOption >> OptionDecl <$> ident <*> ident,
---     tok KWPackage >> PackageDecl
---       <$> ident
---       <*> defer body packageBody,
---     tok KWLocation >> LocationDecl <$> ident <*> (tok TokEq >> expression),
---     tok KWBits >> BitsDecl <$> ident <*> (tok TokColon >> bitType),
---     tok KWObjtype
---       >> ObjTypeDecl <$> ident <*> (tok TokColon >> defer body objTypeBody),
---     tok KWObject
---       >> ObjectDecl
---         <$> ident
---         <*> (tok KWAt *> expression)
---         <*> (tok TokColon *> objType)
---   ]
-
-objType :: Pa ObjType
-objType = do
-  base <- withMeta baseObj
+objTypeP :: Pa ObjType
+objTypeP = do
+  base <- withMeta baseObjP
   recur' <- recur
   return $ recur' base
   where
@@ -184,54 +168,54 @@ objType = do
     recur =
       ( do
           withMeta $ do
-            expr <- tok TokLBracket *> expression <* tok TokRBracket
+            expr <- tok TokLBracket *> expressionP <* tok TokRBracket
             recur' <- recur
             return (\met base -> recur' (ArrayObjType base expr met))
       )
         <|> return id
 
-    baseObj :: P (A -> ObjType Stage1 F A)
-    baseObj =
+    baseObjP :: P (A -> ObjType Stage1 F A)
+    baseObjP =
       (ReferencedObjType <$> name)
         <|> ( do
-                t <- bodyType
-                AnonymousObjType (Witness ()) <$> defer body (objTypeBody t)
+                t <- bodyTypeP
+                AnonymousObjType (Witness ()) <$> defer body (objTypeBodyP t)
             )
 
-exprInParen :: Pa Expression
-exprInParen = tok TokLParen *> expression <* tok TokRParen
+exprInParenP :: Pa Expression
+exprInParenP = tok TokLParen *> expressionP <* tok TokRParen
 
-objTypeBody :: BodyType F (Commented SourceSpan) -> Pa ObjTypeBody
-objTypeBody bt =
+objTypeBodyP :: BodyType F (Commented SourceSpan) -> Pa ObjTypeBody
+objTypeBodyP bt =
   withMeta $
-    ObjTypeBody bt <$> many (directed objTypeDecl <* tok TokSemi)
+    ObjTypeBody bt <$> many (directedP objTypeDeclP <* tok TokSemi)
 
-objTypeDecl :: Pa ObjTypeDecl
-objTypeDecl =
+objTypeDeclP :: Pa ObjTypeDecl
+objTypeDeclP =
   withMeta $
     ( do
         tok KWAssertPos
-        AssertPosStatement (Witness ()) <$> exprInParen
+        AssertPosStatement (Witness ()) <$> exprInParenP
     )
       <|> ( do
               tok KWReserved
-              ReservedDecl <$> exprInParen
+              ReservedDecl <$> exprInParenP
           )
       <|> ( do
-              bt <- bodyType
-              TypeSubStructure <$> defer body (objTypeBody bt) <*> optionMaybe ident
+              bt <- bodyTypeP
+              TypeSubStructure <$> defer body (objTypeBodyP bt) <*> optionMaybe ident
           )
       <|> ( do
-              mod <- optionMaybe modifier
+              mod <- optionMaybe modifierP
               tok KWReg
               RegisterDecl mod
                 <$> optionMaybe ident
-                <*> exprInParen
-                <*> optionMaybe (tok TokColon *> registerBody)
+                <*> exprInParenP
+                <*> optionMaybe (tok TokColon *> registerBodyP)
           )
 
-modifier :: PaS Modifier
-modifier =
+modifierP :: PaS Modifier
+modifierP =
   withMeta $
     ModifierKeyword
       <$> choice
@@ -240,87 +224,87 @@ modifier =
           tok KWWo >> return Wo
         ]
 
-bitBodyType :: PaS BodyType
-bitBodyType =
+bitBodyTypeP :: PaS BodyType
+bitBodyTypeP =
   withMeta $
     (tok KWStruct >> return Struct)
       <|> (tok KWUnion >> return Union)
 
-bodyType :: PaS BodyType
-bodyType =
+bodyTypeP :: PaS BodyType
+bodyTypeP =
   withMeta $
     (tok KWStruct >> return Struct) <|> (tok KWUnion >> return Union)
 
-registerBody :: Pa RegisterBody
-registerBody = withMeta $ RegisterBody <$> bitBodyType <*> defer body deferredRegisterBody
+registerBodyP :: Pa RegisterBody
+registerBodyP = withMeta $ RegisterBody <$> bitBodyTypeP <*> defer body deferredRegisterBodyP
 
-deferredRegisterBody :: Pa DeferredRegisterBody
-deferredRegisterBody =
+deferredRegisterBodyP :: Pa DeferredRegisterBody
+deferredRegisterBodyP =
   withMeta $
-    DeferredRegisterBody <$> many (directed registerBitsDecl <* tok TokSemi)
+    DeferredRegisterBody <$> many (directedP registerBitsDeclP <* tok TokSemi)
 
-registerBitsDecl :: Pa RegisterBitsDecl
-registerBitsDecl =
+registerBitsDeclP :: Pa RegisterBitsDecl
+registerBitsDeclP =
   withMeta $
     ( do
-        tok KWReserved >> ReservedBits <$> exprInParen
+        tok KWReserved >> ReservedBits <$> exprInParenP
     )
-      <|> (BitsSubStructure <$> registerBody <*> optionMaybe ident)
+      <|> (BitsSubStructure <$> registerBodyP <*> optionMaybe ident)
       <|> ( DefinedBits
-              <$> optionMaybe modifier
+              <$> optionMaybe modifierP
               <*> ident
-              <*> (tok TokColon >> registerBitsTypeRef)
+              <*> (tok TokColon >> registerBitsTypeRefP)
           )
 
-registerBitsTypeRef :: Pa RegisterBitsTypeRef
-registerBitsTypeRef = do
+registerBitsTypeRefP :: Pa RegisterBitsTypeRef
+registerBitsTypeRefP = do
   base <- baseTypeRef
-  recur' <- recur
+  recur' <- recurP
   return (recur' base)
   where
-    recur :: P (RegisterBitsTypeRef Stage1 F A -> RegisterBitsTypeRef Stage1 F A)
-    recur =
+    recurP :: P (RegisterBitsTypeRef Stage1 F A -> RegisterBitsTypeRef Stage1 F A)
+    recurP =
       ( do
           withMeta $ do
-            expr <- tok TokLBracket *> expression <* tok TokRBracket
-            recur' <- recur
+            expr <- tok TokLBracket *> expressionP <* tok TokRBracket
+            recur' <- recurP
             return (\met base -> recur' (RegisterBitsArray base expr met))
       )
         <|> return id
 
     baseTypeRef =
       withMeta $
-        (RegisterBitsJustBits <$> exprInParen)
-          <|> (RegisterBitsAnonymousType (Witness ()) <$> anonymousBitsType)
+        (RegisterBitsJustBits <$> exprInParenP)
+          <|> (RegisterBitsAnonymousType (Witness ()) <$> anonymousBitsTypeP)
           <|> (RegisterBitsReference <$> name)
 
-anonymousBitsType :: Pa AnonymousBitsType
-anonymousBitsType = withMeta $ do
+anonymousBitsTypeP :: Pa AnonymousBitsType
+anonymousBitsTypeP = withMeta $ do
   tok KWEnum
-  AnonymousEnumBody <$> exprInParen <*> defer body enumBody
+  AnonymousEnumBody <$> exprInParenP <*> defer body enumBodyP
 
-bitType :: Pa BitType
-bitType = withMeta $ rawBits <|> enumType
+bitTypeP :: Pa BitType
+bitTypeP = withMeta $ rawBits <|> enumType
   where
-    rawBits = RawBits <$> (tok TokLParen *> expression <* tok TokRParen)
+    rawBits = RawBits <$> (tok TokLParen *> expressionP <* tok TokRParen)
     enumType = do
       tok KWEnum
-      expr <- exprInParen
-      EnumBitType expr <$> defer body enumBody
+      expr <- exprInParenP
+      EnumBitType expr <$> defer body enumBodyP
 
-enumBody :: Pa EnumBody
-enumBody =
+enumBodyP :: Pa EnumBody
+enumBodyP =
   withMeta $
-    EnumBody <$> many (directed enumConstantDecl <* tok TokComma)
+    EnumBody <$> many (directedP enumConstantDeclP <* tok TokComma)
 
-enumConstantDecl :: Pa EnumConstantDecl
-enumConstantDecl =
+enumConstantDeclP :: Pa EnumConstantDecl
+enumConstantDeclP =
   withMeta $
-    (tok KWReserved >> EnumConstantReserved <$> (tok TokEq >> expression))
-      <|> (EnumConstantDecl <$> ident <*> (tok TokEq >> expression))
+    (tok KWReserved >> EnumConstantReserved <$> (tok TokEq >> expressionP))
+      <|> (EnumConstantDecl <$> ident <*> (tok TokEq >> expressionP))
 
-expression :: Pa Expression
-expression = withMeta $
+expressionP :: Pa Expression
+expressionP = withMeta $
   token $ \case
     (TokLitNum num) -> Just (LitNum num)
     (TokIdent i) -> Just $
@@ -373,13 +357,13 @@ defer p0 pb = do
     (sourceName sourcePos)
     <$> p0
 
-packageBody :: Pa PackageBody
-packageBody =
+packageBodyP :: Pa PackageBody
+packageBodyP =
   withMeta $
     PackageBody
       <$> many
-        ( directed $
-            fiddleDecl
+        ( directedP $
+            fiddleDeclP
               <* ( tok TokSemi <|> fail "Expected ';'"
                  )
         )
@@ -409,7 +393,7 @@ name = withMeta $ do
 -- and after and sets the positions and adds it to the annotation.
 withMeta :: P (Commented SourceSpan -> b) -> P b
 withMeta p = do
-  comments <- many comment
+  comments <- many commentP
   start <- getPosition
   fn <- p
   end <- getPosition
@@ -431,7 +415,7 @@ tokKeepComment t' = do
 
 tok :: T -> P (Token SourceSpan)
 tok t' = do
-  many comment
+  many commentP
   Text.Parsec.token
     (\(Token t _) -> show t)
     (\(Token _ (SourceSpan s1 _)) -> s1)