Add import resolution phase and also add a more abstractions around

compliation phases.

1 files changed, 35 insertions, 21 deletions

diff --git a/src/Main.hs b/src/Main.hs
index cf33e62..f643320 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -11,42 +11,56 @@ 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.Expansion
+import Language.Fiddle.Compiler
 import Language.Fiddle.Compiler.ConsistencyCheck
+import Language.Fiddle.Compiler.Expansion
+import Language.Fiddle.Compiler.ImportResolution
+import Language.Fiddle.Compiler.Stage0
 import Language.Fiddle.GenericTree (GenericSyntaxTree (..), ToGenericSyntaxTree (toGenericSyntaxTree), alterGenericSyntaxTree)
 import qualified Language.Fiddle.Parser
 import qualified Language.Fiddle.Tokenizer
 import qualified System.Environment as System
 import System.Exit (exitWith)
 
+phases res =
+  importResolutionPhase res >>> expansionPhase >>> consistencyCheckPhase
+
 main :: IO ()
 main = do
   argv <- System.getArgs
+  let opts = ImportResolutionOptions ["."]
 
   case argv of
     [filePath] -> do
       text <- Data.Text.IO.readFile filePath
-      let (diags, ma) = compile_ $ checkConsistency =<< expandAst =<< toStage1 =<< toStage0 filePath text
-      ec <-
-        case ma of
-          Just ast -> do
-            putStrLn $
-              BL.unpack $
-                encode $
-                  alterGenericSyntaxTree cleanupIdentifiers $
-                    toGenericSyntaxTree $
-                      fmap
-                        (const (Nothing :: Maybe Value))
-                        ast
-            return ExitSuccess
-          Nothing -> do
-            putStrLn "\x1b[1;31mCompilation Failed\x1b[0m"
-            return (ExitFailure 1)
+      let maybeParsedAst = compile_ $ toStage0 filePath text >>= toStage1
+
+      case maybeParsedAst of
+        (priorDiags, Just ast) -> do
+          ((priorDiags ++) -> diags, ma) <-
+            execCompilationPipeline (phases opts) ast
+          ec <-
+            case ma of
+              Just ast -> do
+                putStrLn $
+                  BL.unpack $
+                    encode $
+                      alterGenericSyntaxTree cleanupIdentifiers $
+                        toGenericSyntaxTree $
+                          fmap
+                            (const (Nothing :: Maybe Value))
+                            ast
+                return ExitSuccess
+              Nothing -> do
+                putStrLn "\x1b[1;31mCompilation Failed\x1b[0m"
+                return (ExitFailure 1)
 
-      forM_ diags printDiagnostic
-      exitWith ec
+          forM_ diags printDiagnostic
+          exitWith ec
+        (diags, _) -> do
+          putStrLn "\x1b[1;31mParsing Failed\x1b[0m"
+          forM_ diags printDiagnostic
+          exitWith (ExitFailure 1)
     _ -> do
       putStrLn "Wrong Args"
       exitWith (ExitFailure 2)