Option parsing with optparse-applicative

3 files changed, 27 insertions, 18 deletions

diff --git a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
index 4c708f7..5c7b399 100644
--- a/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
+++ b/src/Language/Fiddle/Compiler/ConsistencyCheck.hs
@@ -54,7 +54,7 @@ type SizeBytes = Word32
 consistencyCheckPhase ::
   CompilationPhase Expanded Checked
 consistencyCheckPhase =
-  CompilationPhase (const $ return ()) (\() -> checkConsistency)
+  CompilationPhase (pure ()) (\_ _ -> return ()) (\_ _ -> checkConsistency)
 
 checkConsistency ::
   FiddleUnit Expanded I Annot ->
diff --git a/src/Language/Fiddle/Compiler/Expansion.hs b/src/Language/Fiddle/Compiler/Expansion.hs
index 77ccf6c..7201686 100644
--- a/src/Language/Fiddle/Compiler/Expansion.hs
+++ b/src/Language/Fiddle/Compiler/Expansion.hs
@@ -39,7 +39,7 @@ expandAst :: FiddleUnit CurrentStage I Annot -> Compile () (FiddleUnit Expanded
 expandAst = fmap snd . subCompile (State [] []) . advanceStage (Path mempty)
 
 expansionPhase :: CompilationPhase CurrentStage Expanded
-expansionPhase = CompilationPhase (const $ return ()) (\() -> expandAst)
+expansionPhase = CompilationPhase (pure ()) (\_ _ -> return ()) (\_ _ -> expandAst)
 
 -- Shorthand for Identity
 type I = Identity
diff --git a/src/Language/Fiddle/Compiler/ImportResolution.hs b/src/Language/Fiddle/Compiler/ImportResolution.hs
index b4c5293..90a11d5 100644
--- a/src/Language/Fiddle/Compiler/ImportResolution.hs
+++ b/src/Language/Fiddle/Compiler/ImportResolution.hs
@@ -1,7 +1,6 @@
 module Language.Fiddle.Compiler.ImportResolution
   ( resolveImports,
     getImportResolutionState,
-    ImportResolutionOptions (..),
     importResolutionPhase,
   )
 where
@@ -18,8 +17,30 @@ import Language.Fiddle.Compiler
 import Language.Fiddle.Compiler.Expansion
 import Language.Fiddle.Internal.UnitInterface
 import Language.Fiddle.Types
+import Options.Applicative
 import Text.Printf (printf)
 
+newtype Flags = Flags
+  { importDirectories :: [FilePath]
+  }
+
+parseFlags :: Parser Flags
+parseFlags =
+  Flags
+    <$> many
+      ( strOption
+          ( long "import"
+              <> short 'I'
+              <> metavar "DIRECTORY"
+              <> help "Directory to add to the import search path"
+          )
+      )
+
+importResolutionPhase ::
+  CompilationPhase CurrentStage ImportsResolved
+importResolutionPhase =
+  CompilationPhase parseFlags getImportResolutionState resolveImports
+
 type GlobalState = ()
 
 type LocalState = ResolvedImports
@@ -46,19 +67,12 @@ instance CompilationStage CurrentStage where
   type StageFunctor CurrentStage = Identity
   type StageAnnotation CurrentStage = Annot
 
-importResolutionPhase ::
-  ImportResolutionOptions ->
-  CompilationPhase CurrentStage ImportsResolved
-importResolutionPhase opts =
-  CompilationPhase
-    (getImportResolutionState opts)
-    resolveImports
-
 resolveImports ::
+  Flags ->
   ResolvedImports ->
   FiddleUnit CurrentStage I Annot ->
   Compile () (FiddleUnit ImportsResolved I Annot)
-resolveImports = advanceStage
+resolveImports _ = advanceStage
 
 deriving instance AdvanceStage CurrentStage ObjTypeBody
 
@@ -111,13 +125,8 @@ instance AdvanceStage CurrentStage ImportStatement where
 
     return $ ImportStatement path list v a
 
-newtype ImportResolutionOptions
-  = ImportResolutionOptions
-  { searchPath :: [FilePath]
-  }
-
 getImportResolutionState ::
-  ImportResolutionOptions ->
+  Flags ->
   FiddleUnit CurrentStage Identity Annot ->
   IO ResolvedImports
 getImportResolutionState _ _ = return (ResolvedImports mempty)