diff options
Diffstat (limited to 'src/Main.hs')
-rw-r--r-- | src/Main.hs | 31 |
1 files changed, 27 insertions, 4 deletions
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 |