Refactor CLI

app/App.hs

@@ -1,34 +1,40 @@
 module App where
 
+import CommonOptions
 import Data.ByteString qualified as ByteString
 import GlobalOptions
 import Juvix.Compiler.Pipeline
 import Juvix.Data.Error qualified as Error
-import Juvix.Prelude hiding (Doc)
 import Juvix.Prelude.Pretty hiding (Doc)
 import System.Console.ANSI qualified as Ansi
 
 data App m a where
   ExitMsg :: ExitCode -> Text -> App m a
   ExitJuvixError :: JuvixError -> App m a
   PrintJuvixError :: JuvixError -> App m ()
-  ReadGlobalOptions :: App m GlobalOptions
+  AskRoot :: App m FilePath
+  AskPackage :: App m Package
+  AskGlobalOptions :: App m GlobalOptions
   RenderStdOut :: (HasAnsiBackend a, HasTextBackend a) => a -> App m ()
-  RunPipelineEither :: Sem PipelineEff a -> App m (Either JuvixError a)
+  RunPipelineEither :: Path -> Sem PipelineEff a -> App m (Either JuvixError a)
   Say :: Text -> App m ()
   Raw :: ByteString -> App m ()
 
 makeSem ''App
 
-runAppIO :: forall r a. Member (Embed IO) r => GlobalOptions -> Sem (App ': r) a -> Sem r a
-runAppIO g = interpret $ \case
+runAppIO :: forall r a. Member (Embed IO) r => GlobalOptions -> FilePath -> Package -> Sem (App ': r) a -> Sem r a
+runAppIO g root pkg = interpret $ \case
   RenderStdOut t
     | g ^. globalOnlyErrors -> return ()
     | otherwise -> embed $ do
         sup <- Ansi.hSupportsANSI stdout
         renderIO (not (g ^. globalNoColors) && sup) t
-  ReadGlobalOptions -> return g
-  RunPipelineEither p -> embed (runIOEither p)
+  AskGlobalOptions -> return g
+  AskPackage -> return pkg
+  AskRoot -> return root
+  RunPipelineEither input p -> do
+    entry <- embed (getEntryPoint' g root pkg input)
+    embed (runIOEither entry p)
   Say t
     | g ^. globalOnlyErrors -> return ()
     | otherwise -> embed (putStrLn t)
@@ -41,11 +47,39 @@ runAppIO g = interpret $ \case
   Raw b -> embed (ByteString.putStr b)
   where
     printErr e =
-      embed $ hPutStrLn stderr $ run $ runReader (genericFromGlobalOptions g) $ Error.render (not (g ^. globalNoColors)) (g ^. globalOnlyErrors) e
+      embed $ hPutStrLn stderr $ run $ runReader (project' @GenericOptions g) $ Error.render (not (g ^. globalNoColors)) (g ^. globalOnlyErrors) e
 
-runPipeline :: Member App r => Sem PipelineEff a -> Sem r a
-runPipeline p = do
-  r <- runPipelineEither p
+getEntryPoint' :: GlobalOptions -> FilePath -> Package -> Path -> IO EntryPoint
+getEntryPoint' opts root pkg inputFile = do
+  estdin <-
+    if
+        | opts ^. globalStdin -> Just <$> getContents
+        | otherwise -> return Nothing
+  return
+    EntryPoint
+      { _entryPointRoot = root,
+        _entryPointNoTermination = opts ^. globalNoTermination,
+        _entryPointNoPositivity = opts ^. globalNoPositivity,
+        _entryPointNoStdlib = opts ^. globalNoStdlib,
+        _entryPointPackage = pkg,
+        _entryPointModulePaths = pure (inputFile ^. pathPath),
+        _entryPointGenericOptions = project opts,
+        _entryPointStdin = estdin
+      }
+
+askGenericOptions :: Members '[App] r => Sem r GenericOptions
+askGenericOptions = project <$> askGlobalOptions
+
+getEntryPoint :: Members '[Embed IO, App] r => Path -> Sem r EntryPoint
+getEntryPoint inputFile = do
+  opts <- askGlobalOptions
+  root <- askRoot
+  pkg <- askPackage
+  embed (getEntryPoint' opts root pkg inputFile)
+
+runPipeline :: Member App r => Path -> Sem PipelineEff a -> Sem r a
+runPipeline input p = do
+  r <- runPipelineEither input p
   case r of
     Left err -> exitJuvixError err
     Right res -> return res

app/Commands/Base.hs

@@ -0,0 +1,14 @@
+module Commands.Base
+  ( module App,
+    module GlobalOptions,
+    module CommonOptions,
+    module Juvix.Compiler.Pipeline,
+    module Juvix.Prelude,
+  )
+where
+
+import App
+import CommonOptions
+import GlobalOptions
+import Juvix.Compiler.Pipeline
+import Juvix.Prelude