1 files changed, 29 insertions, 30 deletions

diff --git a/src/Language/Fiddle/Compiler.hs b/src/Language/Fiddle/Compiler.hs
index 0fe277f..5be6355 100644
--- a/src/Language/Fiddle/Compiler.hs
+++ b/src/Language/Fiddle/Compiler.hs
@@ -1,18 +1,5 @@
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
--- Compilation monad. Has diagnostics. Optionally produces a value.
--- newtype Compile s a = Compile (s -> (s, [Diagnostic], Maybe a))
--- Runs a sub-compilation routine with the given state, but discards the
--- resulting state in favor of the original state.
--- mapMaybeT (mapRWS (\(a, _, w) -> (a, s', w))) mtrws
--- Saves the state, runs the routine, then restores the state.
--- Runs a compilation routine. It produces diagnostics and maybe a result.
--- Generally if the diagnostics contain an error, the result will be Nothing,
--- but if only Warnings are generated, then Just something will be returned.
---
--- Note that there is no actual type-level mechanism restricting this function
--- from returning something even if the diagnostics contain errors, but it
--- generally wouldn't make much sense for this to be the case.
 {-# LANGUAGE RankNTypes #-}
 
 module Language.Fiddle.Compiler where
@@ -26,6 +13,7 @@ import Control.Monad.Writer
 import Data.Default
 import Language.Fiddle.Ast
 import Language.Fiddle.Types
+import Options.Applicative
 import System.IO (hPutStrLn, stderr)
 import Text.Parsec (SourcePos, sourceColumn, sourceLine, sourceName)
 
@@ -114,13 +102,15 @@ fromMayberOrFail _ _ (Just a) = return a
 -- 'FiddleUnit' from the current stage to the next.
 data CompilationPhase stageFrom stageTo where
   CompilationPhase ::
-    forall privateState stageFrom stageTo.
+    forall privateFlags privateState stageFrom stageTo.
     (CompilationStage stageFrom) =>
-    { -- | 'ioAction' is an IO operation that runs after the ast is parsed. It
+    { optionsParser :: Parser privateFlags,
+      -- | 'ioAction' is an IO operation that runs after the ast is parsed. It
       -- takes the parsed 'FiddleUnit' and performs some side effect
       -- returning a private state that is passed to 'nextStage'. This is the
       -- only time a side effect may be performed.
       ioAction ::
+        privateFlags ->
         FiddleUnit Parsed (StageFunctor Parsed) (StageAnnotation Parsed) ->
         IO privateState,
       -- | 'nextStage' is the function that transforms a 'FiddleUnit' from
@@ -128,6 +118,7 @@ data CompilationPhase stageFrom stageTo where
       -- uses the private state obtained from 'ioAction' and outputs a
       -- potentially updated 'FiddleUnit' in the compilation pipeline.
       nextStage ::
+        privateFlags ->
         privateState ->
         FiddleUnit
           stageFrom
@@ -150,13 +141,14 @@ thenPhase ::
   CompilationPhase stage2 stage3 ->
   CompilationPhase stage1 stage3
 thenPhase
-  (CompilationPhase ioAction1 compile1)
-  (CompilationPhase ioAction2 compile2) =
+  (CompilationPhase optParse1 ioAction1 compile1)
+  (CompilationPhase optParse2 ioAction2 compile2) =
     CompilationPhase
-      (\unit -> (,) <$> ioAction1 unit <*> ioAction2 unit)
-      ( \(s1, s2) firstStage -> do
-          secondStage <- compile1 s1 firstStage
-          compile2 s2 secondStage
+      ((,) <$> optParse1 <*> optParse2)
+      (\(f1, f2) unit -> (,) <$> ioAction1 f1 unit <*> ioAction2 f2 unit)
+      ( \(f1, f2) (s1, s2) firstStage -> do
+          secondStage <- compile1 f1 s1 firstStage
+          compile2 f2 s2 secondStage
       )
 
 -- | Infix operator for 'thenPhase' to chain compilation phases.
@@ -167,15 +159,22 @@ thenPhase
 -- from the 'Parsed' phase. It performs the IO action of the first phase and
 -- then invokes the compilation function for the remaining stages. It returns
 -- a tuple containing diagnostics and an optional final 'FiddleUnit'.
-execCompilationPipeline ::
+execCompilationPipelineWithCmdline ::
   CompilationPhase Parsed s' ->
-  FiddleUnit Parsed (StageFunctor Parsed) (StageAnnotation Parsed) ->
-  IO
-    ( [Diagnostic],
-      Maybe
-        ( FiddleUnit s' (StageFunctor s') (StageAnnotation s')
+  Parser
+    ( FiddleUnit Parsed (StageFunctor Parsed) (StageAnnotation Parsed) ->
+      IO
+        ( [Diagnostic],
+          Maybe
+            ( FiddleUnit s' (StageFunctor s') (StageAnnotation s')
+            )
         )
     )
-execCompilationPipeline (CompilationPhase ioAction rest) ast = do
-  s <- ioAction ast
-  return $ compile_ $ rest s ast
+execCompilationPipelineWithCmdline
+  (CompilationPhase flagsParser ioAction rest) = do
+    fmap
+      ( \opts ast -> do
+          s <- ioAction opts ast
+          return $ compile_ $ rest opts s ast
+      )
+      flagsParser