From 0274c964874801d7cbde8f13fa13e11ed7948660 Mon Sep 17 00:00:00 2001
From: Josh Rahm <joshuarahm@gmail.com>
Date: Wed, 25 Sep 2024 22:51:32 -0600
Subject: 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.
---
 src/Main.hs | 31 +++++++++++++++++++++++++++----
 1 file changed, 27 insertions(+), 4 deletions(-)

(limited to 'src/Main.hs')

diff --git a/src/Main.hs b/src/Main.hs
index f92d6c6..6fba502 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,17 +1,21 @@
 module Main where
 
 import Control.Monad (forM_)
+import Control.Monad.Identity (Identity)
 import Control.Monad.Writer
-import Data.Aeson (encode)
+import Data.Aeson (Value (Null), encode)
 import qualified Data.ByteString.Lazy.Char8 as BL
+import Data.Data (cast)
+import qualified Data.Text as Text
 import qualified Data.Text.IO
+import Data.Typeable
 import GHC.IO.Exception (ExitCode (ExitFailure, ExitSuccess))
 import Language.Fiddle.Ast
 import Language.Fiddle.Compiler (coloredFormat, compile_, printDiagnostic)
 import Language.Fiddle.Compiler.Stage0
 import Language.Fiddle.Compiler.Stage1
 import Language.Fiddle.Compiler.Stage2
-import Language.Fiddle.GenericTree (ToGenericSyntaxTree (toGenericSyntaxTree))
+import Language.Fiddle.GenericTree (GenericSyntaxTree (..), ToGenericSyntaxTree (toGenericSyntaxTree), alterGenericSyntaxTree)
 import qualified Language.Fiddle.Parser
 import qualified Language.Fiddle.Tokenizer
 import qualified System.Environment as System
@@ -25,10 +29,17 @@ main = do
     [filePath] -> do
       text <- Data.Text.IO.readFile filePath
       let (diags, ma) = compile_ $ toStage3 =<< toStage2 =<< toStage1 =<< toStage0 filePath text
-      ec <- 
+      ec <-
         case ma of
           Just ast -> do
-            putStrLn $ BL.unpack $ encode $ toGenericSyntaxTree ast
+            putStrLn $
+              BL.unpack $
+                encode $
+                  alterGenericSyntaxTree cleanupIdentifiers $
+                    toGenericSyntaxTree $
+                      fmap
+                        (const (Nothing :: Maybe Value))
+                        ast
             return ExitSuccess
           Nothing -> do
             putStrLn "\x1b[1;31mCompilation Failed\x1b[0m"
@@ -39,3 +50,15 @@ main = do
     _ -> do
       putStrLn "Wrong Args"
       exitWith (ExitFailure 2)
+
+cleanupIdentifiers :: GenericSyntaxTree Identity a -> Maybe (GenericSyntaxTree Identity a)
+cleanupIdentifiers (SyntaxTreeObject _ _ _ tr)
+  | (Just (Identifier n _)) <- castT tr =
+      Just $ SyntaxTreeValue (Text.unpack n)
+  where
+    castT ::
+      (Typeable t, Typeable f, Typeable a, Typeable t') =>
+      t f a ->
+      Maybe (t' f a)
+    castT = cast
+cleanupIdentifiers _ = Nothing
-- 
cgit