From 991a4f36a374ce38367f05d4b2329c9669241199 Mon Sep 17 00:00:00 2001
From: Philippe Pittoli <karchnu@karchnu.fr>
Date: Thu, 15 Feb 2024 20:42:39 +0100
Subject: [PATCH] New `errorParser` and `<:>` (error functor) functions.

---
 src/GenericParser/Parser.purs | 34 ++++++++++++++++++++++++++++++++++
 1 file changed, 34 insertions(+)

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 <:>