diff --git a/src/GenericParser/Parser.purs b/src/GenericParser/Parser.purs index 87215a6..db20d52 100644 --- a/src/GenericParser/Parser.purs +++ b/src/GenericParser/Parser.purs @@ -223,3 +223,37 @@ read_input p = do input <- current_input _ <- p endpos <- current_position pure $ CU.take (endpos - input.position) input.string + +-- | `errorParser` provides a parser that keeps the current input position but fails +-- | and gives the argument as the error. +errorParser :: forall e v. Maybe e -> Parser e v +errorParser e = Parser \input -> failureError input.position e + +-- | `error_functor` or `(<:>)` is an `error functor`, allowing to encapsulate +-- | an error in another type. +-- | +-- |``` +-- |data LoginParsingError -- Login parsing errors. +-- | = CannotParse +-- | | CannotEntirelyParse +-- | | Size Int Int Int +-- | +-- |data Error -- Login validation errors. +-- | = ParsingError (G.Error LoginParsingError) +-- | +-- |login_parser :: Parser LoginParsingError String +-- |login_parser = do +-- | input <- current_input +-- | _ <- many1 (alpha <|> digit) <:> \_ -> CannotParse +-- | _ <- SomeParsers.eof <:> \_ -> CannotEntirelyParse +-- | pos <- current_position +-- | if between min_login_size max_login_size pos +-- | then pure input.string +-- | else errorParser (Just $ Size min_login_size max_login_size pos) +-- |``` +error_functor :: forall e v f. Parser e v -> (e -> f) -> Parser f v +error_functor (Parser p) f = Parser \i -> case p i of + Left e -> failureError e.position $ maybe Nothing (Just <<< f) e.error + Right v -> Right v + +infixl 8 error_functor as <:>