remove default from FromParser.fromParserPure
and Main.step
This commit is contained in:
parent
7a0bc73d25
commit
11b0ab6a25
3 changed files with 11 additions and 13 deletions
15
exe/Main.idr
15
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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue