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
|
Step a b = OpenFile -> a -> Eff Compile b
|
||||||
|
|
||||||
private
|
private
|
||||||
step : {default CErr console : ConsoleChannel} ->
|
step : ConsoleChannel -> Phase -> OutFile -> Step a b -> a -> Eff CompileStop b
|
||||||
Phase -> OutFile -> Step a b -> a -> Eff CompileStop b
|
step console phase file act x = do
|
||||||
step phase file act x = do
|
|
||||||
opts <- askAt OPTS
|
opts <- askAt OPTS
|
||||||
res <- withOutFile console file fromError $ \h => lift $ act h x
|
res <- withOutFile console file fromError $ \h => lift $ act h x
|
||||||
when (opts.until == Just phase) stopHere
|
when (opts.until == Just phase) stopHere
|
||||||
|
@ -99,11 +98,11 @@ processFile : String -> Eff Compile ()
|
||||||
processFile file = withEarlyStop $ pipeline !(askAt OPTS) file where
|
processFile file = withEarlyStop $ pipeline !(askAt OPTS) file where
|
||||||
pipeline : Options -> String -> Eff CompileStop ()
|
pipeline : Options -> String -> Eff CompileStop ()
|
||||||
pipeline opts =
|
pipeline opts =
|
||||||
step Parse opts.dump.parse Main.parse >=>
|
step CErr Parse opts.dump.parse Main.parse >=>
|
||||||
step Check opts.dump.check Main.check >=>
|
step CErr Check opts.dump.check Main.check >=>
|
||||||
step Erase opts.dump.erase Main.erase >=>
|
step CErr Erase opts.dump.erase Main.erase >=>
|
||||||
step Scheme opts.dump.scheme Main.scheme >=>
|
step CErr Scheme opts.dump.scheme Main.scheme >=>
|
||||||
step End opts.outFile Main.output {console = COut}
|
step COut End opts.outFile Main.output
|
||||||
|
|
||||||
|
|
||||||
export covering
|
export covering
|
||||||
|
|
|
@ -49,10 +49,9 @@ record PureParserResult a where
|
||||||
logLevels : LevelStack
|
logLevels : LevelStack
|
||||||
|
|
||||||
export
|
export
|
||||||
fromParserPure : {default [<] ns : Mods} ->
|
fromParserPure : Mods -> NameSuf -> Definitions -> LevelStack ->
|
||||||
NameSuf -> Definitions -> LevelStack ->
|
|
||||||
Eff FromParserPure a -> Either Error (PureParserResult a)
|
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
|
suf <- newSTRef' suf
|
||||||
defs <- newSTRef' defs
|
defs <- newSTRef' defs
|
||||||
log <- newSTRef' [<]
|
log <- newSTRef' [<]
|
||||||
|
@ -376,7 +375,7 @@ export covering
|
||||||
expectFail : Loc -> Eff FromParserPure a -> Eff FromParserPure Error
|
expectFail : Loc -> Eff FromParserPure a -> Eff FromParserPure Error
|
||||||
expectFail loc act = do
|
expectFail loc act = do
|
||||||
gen <- getAt GEN; defs <- getAt DEFS; ns <- getAt NS; lvl <- curLevels
|
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
|
Left err => pure err
|
||||||
Right _ => throw $ ExpectedFail loc
|
Right _ => throw $ ExpectedFail loc
|
||||||
|
|
||||||
|
|
|
@ -68,7 +68,7 @@ parameters {c : Bool} {auto _ : Show b}
|
||||||
|
|
||||||
runFromParser : {default empty defs : Definitions} ->
|
runFromParser : {default empty defs : Definitions} ->
|
||||||
Eff FromParserPure a -> Either FromParser.Error a
|
Eff FromParserPure a -> Either FromParser.Error a
|
||||||
runFromParser = map val . fromParserPure 0 defs initStack
|
runFromParser = map val . fromParserPure [<] 0 defs initStack
|
||||||
|
|
||||||
export
|
export
|
||||||
tests : Test
|
tests : Test
|
||||||
|
|
Loading…
Reference in a new issue