mirror of
https://github.com/anoma/juvix.git
synced 2024-11-10 15:06:54 +03:00
3b0cde27bb
* Remove input file fields from command opts * [cli] Make version and help commands * Fix on reviews * Fixes for dealing with global options inside subcmds * Fix minijuvix emacs mode and add some instance to GlobalOpts * Remove unrelated code * Propagate globals opts in each cmd parser * Add initial shell tests * Add test-shell to makefile and CI * Fix CI: adding .local/bin to PATH * Fixing CI * Installing shelltest just before running it * Install app for shell testing * Hide global flags after cmd. Fix shell tests accordingly. * Fixing CI * Shell test only run on ubuntu for now
52 lines
1.6 KiB
Haskell
52 lines
1.6 KiB
Haskell
module App where
|
|
|
|
import GlobalOptions
|
|
import MiniJuvix.Pipeline
|
|
import MiniJuvix.Prelude hiding (Doc)
|
|
import MiniJuvix.Prelude.Error qualified as Error
|
|
import MiniJuvix.Prelude.Pretty hiding (Doc)
|
|
import System.Console.ANSI qualified as Ansi
|
|
|
|
data App m a where
|
|
ExitMsg :: ExitCode -> Text -> App m ()
|
|
ExitMiniJuvixError :: MiniJuvixError -> App m a
|
|
ReadGlobalOptions :: App m GlobalOptions
|
|
RenderStdOut :: (HasAnsiBackend a, HasTextBackend a) => a -> App m ()
|
|
RunPipelineEither :: Sem PipelineEff a -> App m (Either MiniJuvixError a)
|
|
Say :: Text -> App m ()
|
|
|
|
makeSem ''App
|
|
|
|
runAppIO :: forall r a. Member (Embed IO) r => GlobalOptions -> Sem (App ': r) a -> Sem r a
|
|
runAppIO g = 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)
|
|
Say t
|
|
| g ^. globalOnlyErrors -> return ()
|
|
| otherwise -> embed (putStrLn t)
|
|
ExitMiniJuvixError e -> do
|
|
(embed . hPutStrLn stderr . Error.render (not (g ^. globalNoColors))) e
|
|
embed exitFailure
|
|
ExitMsg exitCode t -> embed (putStrLn t >> exitWith exitCode)
|
|
|
|
runPipeline :: Member App r => Sem PipelineEff a -> Sem r a
|
|
runPipeline p = do
|
|
r <- runPipelineEither p
|
|
case r of
|
|
Left err -> exitMiniJuvixError err
|
|
Right res -> return res
|
|
|
|
newline :: Member App r => Sem r ()
|
|
newline = say ""
|
|
|
|
printSuccessExit :: Member App r => Text -> Sem r ()
|
|
printSuccessExit = exitMsg ExitSuccess
|
|
|
|
printFailureExit :: Member App r => Text -> Sem r ()
|
|
printFailureExit = exitMsg (ExitFailure 1)
|