1 files changed, 28 insertions, 6 deletions
diff --git a/src/Language/Fiddle/Compiler.hs b/src/Language/Fiddle/Compiler.hs
index 5be6355..24c7da0 100644
--- a/src/Language/Fiddle/Compiler.hs
+++ b/src/Language/Fiddle/Compiler.hs
@@ -4,6 +4,7 @@
 
 module Language.Fiddle.Compiler where
 
+import Control.Arrow (Arrow (first, second))
 import Control.Monad (when)
 import Control.Monad.Identity (Identity)
 import Control.Monad.RWS (RWS, RWST, evalRWS, mapRWS, runRWS)
@@ -18,6 +19,7 @@ import System.IO (hPutStrLn, stderr)
 import Text.Parsec (SourcePos, sourceColumn, sourceLine, sourceName)
 
 data Level = Error | Warning | Info
+  deriving (Eq, Ord, Show, Read, Enum)
 
 data Diagnostic = Diagnostic Level String SourceSpan
 
@@ -50,7 +52,10 @@ pushState cp = do
 
 compile :: Compile s a -> s -> ([Diagnostic], Maybe a)
 compile (Compile fn) initState = do
-  let (a, _, w) = runRWS (runMaybeT fn) () initState in (w, a)
+  let (a, _, w) = runRWS (runMaybeT fn) () initState
+   in if hasError w then (w, Nothing) else (w, a)
+  where
+    hasError = any (\(Diagnostic e _ _) -> e == Error)
 
 compile_ :: (Default s) => Compile s a -> ([Diagnostic], Maybe a)
 compile_ c = compile c def
@@ -96,6 +101,12 @@ fromMayberOrFail sourceSpan err Nothing = do
   compilationFailure
 fromMayberOrFail _ _ (Just a) = return a
 
+-- data IOActionExtraData = IOActionExtraData
+--   { parseFile :: FilePath -> IO (TreeType FiddleUnit Parsed),
+--     stage3Compile :: TreeType FiddleUnit Parsed ->
+--       TreeType FiddleUnit Checked
+--   }
+
 -- | 'CompilationPhase' represents a phase in the compilation process.
 -- It consists of an IO action that performs necessary side effects or state
 -- preparations before the next stage, and a function that transforms the
@@ -111,8 +122,8 @@ data CompilationPhase stageFrom stageTo where
       -- only time a side effect may be performed.
       ioAction ::
         privateFlags ->
-        FiddleUnit Parsed (StageFunctor Parsed) (StageAnnotation Parsed) ->
-        IO privateState,
+        TreeType FiddleUnit Parsed ->
+        IO ([Diagnostic], Maybe privateState),
       -- | 'nextStage' is the function that transforms a 'FiddleUnit' from
       -- the current stage ('stageFrom') to the next stage ('stageTo'). It
       -- uses the private state obtained from 'ioAction' and outputs a
@@ -145,7 +156,16 @@ thenPhase
   (CompilationPhase optParse2 ioAction2 compile2) =
     CompilationPhase
       ((,) <$> optParse1 <*> optParse2)
-      (\(f1, f2) unit -> (,) <$> ioAction1 f1 unit <*> ioAction2 f2 unit)
+      ( \(f1, f2) unit -> do
+          (diags1, mst1) <- ioAction1 f1 unit
+          case mst1 of
+            Nothing -> return (diags1, Nothing)
+            Just st1 -> do
+              (diags2, mst2) <- ioAction2 f2 unit
+              return $ case mst2 of
+                Nothing -> (diags1 ++ diags2, Nothing)
+                Just st2 -> (diags1 ++ diags2, Just (st1, st2))
+      )
       ( \(f1, f2) (s1, s2) firstStage -> do
           secondStage <- compile1 f1 s1 firstStage
           compile2 f2 s2 secondStage
@@ -174,7 +194,9 @@ execCompilationPipelineWithCmdline
   (CompilationPhase flagsParser ioAction rest) = do
     fmap
       ( \opts ast -> do
-          s <- ioAction opts ast
-          return $ compile_ $ rest opts s ast
+          (diags, ms) <- ioAction opts ast
+          case ms of
+            Just s -> return $ first (diags ++) $ compile_ $ rest opts s ast
+            Nothing -> return (diags, Nothing)
       )
       flagsParser