mirror of
https://github.com/anoma/juvix.git
synced 2024-12-13 19:49:20 +03:00
a4eb2124b2
* w.i.p adoption of generic error type * harmonize * Remove the use of Error effect for internal bugs * add location information to expression atom list * Add GenericError instance for PatternAtoms * Remove Maybe GenericError occurrences * [ci] fix draft job's condition * minor changes * [stack] macos support ghc-opts * Fix reviewer's comments * remove accidentally commited file * refactor to avoid duplication * fix Co-authored-by: Jan Mas Rovira <janmasrovira@gmail.com>
44 lines
1.3 KiB
Haskell
44 lines
1.3 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
|
|
ExitError :: MiniJuvixError -> App m a
|
|
Say :: Text -> App m ()
|
|
RenderStdOut :: (HasAnsiBackend a, HasTextBackend a) => a -> App m ()
|
|
RunPipelineEither :: Sem PipelineEff a -> App m (Either MiniJuvixError a)
|
|
ReadGlobalOptions :: App m GlobalOptions
|
|
|
|
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)
|
|
ExitError e -> do
|
|
(embed . hPutStrLn stderr . Error.render (not (g ^. globalNoColors))) e
|
|
embed exitFailure
|
|
|
|
runPipeline :: Member App r => Sem PipelineEff a -> Sem r a
|
|
runPipeline p = do
|
|
r <- runPipelineEither p
|
|
case r of
|
|
Left err -> exitError err
|
|
Right res -> return res
|
|
|
|
newline :: Member App r => Sem r ()
|
|
newline = say ""
|