diff --git a/exe/Main.idr b/exe/Main.idr index e23184b..c9e7f0b 100644 --- a/exe/Main.idr +++ b/exe/Main.idr @@ -34,9 +34,8 @@ Step : Type -> Type -> Type Step a b = OpenFile -> a -> Eff Compile b private -step : {default CErr console : ConsoleChannel} -> - Phase -> OutFile -> Step a b -> a -> Eff CompileStop b -step phase file act x = do +step : ConsoleChannel -> Phase -> OutFile -> Step a b -> a -> Eff CompileStop b +step console phase file act x = do opts <- askAt OPTS res <- withOutFile console file fromError $ \h => lift $ act h x when (opts.until == Just phase) stopHere @@ -99,11 +98,11 @@ processFile : String -> Eff Compile () processFile file = withEarlyStop $ pipeline !(askAt OPTS) file where pipeline : Options -> String -> Eff CompileStop () pipeline opts = - step Parse opts.dump.parse Main.parse >=> - step Check opts.dump.check Main.check >=> - step Erase opts.dump.erase Main.erase >=> - step Scheme opts.dump.scheme Main.scheme >=> - step End opts.outFile Main.output {console = COut} + step CErr Parse opts.dump.parse Main.parse >=> + step CErr Check opts.dump.check Main.check >=> + step CErr Erase opts.dump.erase Main.erase >=> + step CErr Scheme opts.dump.scheme Main.scheme >=> + step COut End opts.outFile Main.output export covering diff --git a/lib/Quox/Parser/FromParser.idr b/lib/Quox/Parser/FromParser.idr index 8328272..88017fd 100644 --- a/lib/Quox/Parser/FromParser.idr +++ b/lib/Quox/Parser/FromParser.idr @@ -49,10 +49,9 @@ record PureParserResult a where logLevels : LevelStack export -fromParserPure : {default [<] ns : Mods} -> - NameSuf -> Definitions -> LevelStack -> +fromParserPure : Mods -> NameSuf -> Definitions -> LevelStack -> Eff FromParserPure a -> Either Error (PureParserResult a) -fromParserPure suf defs lvls act = runSTErr $ do +fromParserPure ns suf defs lvls act = runSTErr $ do suf <- newSTRef' suf defs <- newSTRef' defs log <- newSTRef' [<] @@ -376,7 +375,7 @@ export covering expectFail : Loc -> Eff FromParserPure a -> Eff FromParserPure Error expectFail loc act = do gen <- getAt GEN; defs <- getAt DEFS; ns <- getAt NS; lvl <- curLevels - case fromParserPure {ns} gen defs (singleton lvl) act of + case fromParserPure ns gen defs (singleton lvl) act of Left err => pure err Right _ => throw $ ExpectedFail loc diff --git a/tests/Tests/FromPTerm.idr b/tests/Tests/FromPTerm.idr index 319d407..de7bd24 100644 --- a/tests/Tests/FromPTerm.idr +++ b/tests/Tests/FromPTerm.idr @@ -68,7 +68,7 @@ parameters {c : Bool} {auto _ : Show b} runFromParser : {default empty defs : Definitions} -> Eff FromParserPure a -> Either FromParser.Error a -runFromParser = map val . fromParserPure 0 defs initStack +runFromParser = map val . fromParserPure [<] 0 defs initStack export tests : Test