core: Remove type argument from ParseCharResult

This commit is contained in:
Nathan McCarty 2025-01-26 20:51:00 -05:00
parent 2e4ab42aa0
commit b1a4e1a941
2 changed files with 17 additions and 31 deletions

View file

@ -236,7 +236,7 @@ export
parseExactChar : Char -> Parser Char parseExactChar : Char -> Parser Char
parseExactChar c = do parseExactChar c = do
pnote "Parsing exact char: \{show c}" pnote "Parsing exact char: \{show c}"
result <- parseChar (== c) id result <- parseChar (== c)
case result of case result of
GotChar char => pure char GotChar char => pure char
GotError err => throwParseError "Got \{show err} Expected \{show c}" GotError err => throwParseError "Got \{show err} Expected \{show c}"
@ -250,7 +250,7 @@ export
parseTheseChars : List Char -> Parser Char parseTheseChars : List Char -> Parser Char
parseTheseChars cs = do parseTheseChars cs = do
pnote "Parsing one of: \{show cs}" pnote "Parsing one of: \{show cs}"
result <- parseChar (\x => any (== x) cs) id result <- parseChar (\x => any (== x) cs)
case result of case result of
GotChar char => pure char GotChar char => pure char
GotError err => throwParseError "Got \{show err} Expected one of \{show cs}" GotError err => throwParseError "Got \{show err} Expected one of \{show cs}"
@ -268,7 +268,7 @@ exactString str with (asList str)
pure "" pure ""
exactString input@(strCons c str) | (c :: x) = do exactString input@(strCons c str) | (c :: x) = do
pnote "Parsing exact string \{show input}" pnote "Parsing exact string \{show input}"
GotChar next <- parseChar (== c) id GotChar next <- parseChar (== c)
| GotError err => throwParseError "Got \{show err} expected \{show c}" | GotError err => throwParseError "Got \{show err} expected \{show c}"
| EndOfInput => throwParseError "End of input" | EndOfInput => throwParseError "End of input"
rest <- exactString str | x rest <- exactString str | x

View file

@ -195,10 +195,10 @@ btraverse fun (MkInternal input length line_starts position end_of_input) =
```idris ```idris
||| Three way result returned from attempting to parse a single char ||| Three way result returned from attempting to parse a single char
public export public export
data ParseCharResult : Type -> Type where data ParseCharResult : Type where
GotChar : (char : Char) -> ParseCharResult e GotChar : (char : Char) -> ParseCharResult
GotError : (err : e) -> ParseCharResult e GotError : (err : Char) -> ParseCharResult
EndOfInput : ParseCharResult e EndOfInput : ParseCharResult
``` ```
## The Effect Type ## The Effect Type
@ -210,8 +210,7 @@ data ParserState : Type -> Type where
Load : (ParserInternal Id) -> ParserState () Load : (ParserInternal Id) -> ParserState ()
-- TODO: Maybe add a ParseString that parses a string of characters as a -- TODO: Maybe add a ParseString that parses a string of characters as a
-- string using efficent slicing? -- string using efficent slicing?
ParseChar : (predicate : Char -> Bool) -> (err : Char -> e) ParseChar : (predicate : Char -> Bool) -> ParserState ParseCharResult
-> ParserState (ParseCharResult e)
ParseEoF : ParserState Bool ParseEoF : ParserState Bool
Note : Lazy String -> ParserState () Note : Lazy String -> ParserState ()
``` ```
@ -220,7 +219,7 @@ data ParserState : Type -> Type where
Show (ParserState t) where Show (ParserState t) where
show Save = "Saving state" show Save = "Saving state"
show (Load pi) = "Loading state \{show pi}" show (Load pi) = "Loading state \{show pi}"
show (ParseChar predicate err) = "Parsing char" show (ParseChar predicate) = "Parsing char"
show ParseEoF = "Parsing EoF" show ParseEoF = "Parsing EoF"
show (Note _) = "Note" show (Note _) = "Note"
--> -->
@ -242,22 +241,9 @@ load pi = send $ Load pi
||| predicate, updates the state if parsing succeeds, does not alter it in an ||| predicate, updates the state if parsing succeeds, does not alter it in an
||| error condition. ||| error condition.
export export
parseChar : Has ParserState fs => (predicate : Char -> Bool) -> (err : Char -> e) parseChar : Has ParserState fs => (predicate : Char -> Bool)
-> Eff fs (ParseCharResult e) -> Eff fs ParseCharResult
parseChar predicate err = send $ ParseChar predicate err parseChar predicate = send $ ParseChar predicate
||| Wrapper for parseChar that folds the error message into effect stack with the
||| provided callback
export
parseCharE : Has ParserState fs => Has (Except e) fs =>
(predicate : Char -> Bool) -> (err : Char -> e) -> (eof : Lazy e)
-> Eff fs Char
parseCharE predicate err eof = do
result <- parseChar predicate id
case result of
GotChar char => pure char
GotError x => throw $ err x
EndOfInput => throw eof
||| "Parse" the end of input, returning `True` if the parser state is currently ||| "Parse" the end of input, returning `True` if the parser state is currently
||| at the end of the input ||| at the end of the input
@ -285,14 +271,14 @@ handleParserStateIO pi Save = do
handleParserStateIO pi (Load pj) = do handleParserStateIO pi (Load pj) = do
pj <- btraverse newIORef pj pj <- btraverse newIORef pj
writeIORef pi pj writeIORef pi pj
handleParserStateIO pi (ParseChar predicate err) = do handleParserStateIO pi (ParseChar predicate) = do
pi <- readIORef pi pi <- readIORef pi
False <- readIORef pi.end_of_input False <- readIORef pi.end_of_input
| _ => pure $ EndOfInput | _ => pure EndOfInput
position <- readIORef pi.position position <- readIORef pi.position
let char = assert_total $ strIndex pi.input (cast position.index) let char = assert_total $ strIndex pi.input (cast position.index)
True <- pure $ predicate char True <- pure $ predicate char
| _ => pure . GotError $ err char | _ => pure $ GotError char
-- Our refinement type on the position forces us to check that the length is -- Our refinement type on the position forces us to check that the length is
-- in bounds after incrementing it, if its out of bounds, set the end_of_input -- in bounds after incrementing it, if its out of bounds, set the end_of_input
-- flag -- flag
@ -342,7 +328,7 @@ handleParserStateIODebug x y = do
unPS : ParserInternal Id -> ParserState a -> (a, ParserInternal Id) unPS : ParserInternal Id -> ParserState a -> (a, ParserInternal Id)
unPS pi Save = (pi, pi) unPS pi Save = (pi, pi)
unPS pi (Load pj) = ((), pi) unPS pi (Load pj) = ((), pi)
unPS pi (ParseChar predicate err) = unPS pi (ParseChar predicate) =
if pi.end_of_input if pi.end_of_input
then (EndOfInput, pi) then (EndOfInput, pi)
else let else let
@ -353,7 +339,7 @@ unPS pi (ParseChar predicate err) =
(GotChar char, {end_of_input := True} pi) (GotChar char, {end_of_input := True} pi)
Just (Element next _) => Just (Element next _) =>
(GotChar char, {position := MkIndex next} pi) (GotChar char, {position := MkIndex next} pi)
else (GotError $ err char, pi) else (GotError char, pi)
unPS pi ParseEoF = (pi.end_of_input, pi) unPS pi ParseEoF = (pi.end_of_input, pi)
unPS pi (Note _) = ((), pi) unPS pi (Note _) = ((), pi)