From a85b8e16e96b842250d8ff81d08ca43d57c5b086 Mon Sep 17 00:00:00 2001
From: Alice BRENON <alice.brenon@ens-lyon.fr>
Date: Fri, 23 Jul 2021 12:53:46 +0200
Subject: [PATCH] More readable error messages with operator <!> showing an
 excerpt of what has been actually read

---
 lib/Text/Encyclopedia/Article.hs | 20 +++++++++++++-------
 1 file changed, 13 insertions(+), 7 deletions(-)

diff --git a/lib/Text/Encyclopedia/Article.hs b/lib/Text/Encyclopedia/Article.hs
index 4a9b5bd..870d141 100644
--- a/lib/Text/Encyclopedia/Article.hs
+++ b/lib/Text/Encyclopedia/Article.hs
@@ -34,6 +34,15 @@ data Article = Article {
     , body :: Text
   } deriving (Eq, Show)
 
+(<!>) :: Parser a -> String -> Parser a
+(<!>) p expected = p <|> (takeText >>= fail . formatMessage)
+  where
+    ellipsis s
+      | Prelude.length s < 21 = s
+      | otherwise = take 20 s ++ "…"
+    formatMessage = printf "%s (got «%s»)" expected . ellipsis . Text.unpack
+infix 0 <!>
+
 article :: Parser Article
 article = Article <$> headwords_ <*> optional inflectedPOS_ <*> body_
 
@@ -58,7 +67,8 @@ many1Till :: Parser a -> Parser b -> Parser [a]
 many1Till p after = (:) <$> p <*> manyTill p after
 
 headwords_ :: Parser [String]
-headwords_ = headword `sepBy1` headwordSeparator <* blank
+headwords_ =
+  (headword `sepBy1` headwordSeparator <!> "at least one headword") <* blank
   where
     headword =
       satisfy isUpper `many1Till` lookAhead (sentenceBegining <|> punctOrSpace)
@@ -75,11 +85,7 @@ inflectedPOS_ :: Parser InflectedPOS
 inflectedPOS_ = InflectedPOS
   <$> (punctOrSpace *> abbreviation <* blank)
   <*> (optional abbreviation <* blank)
+  <!> "inflectedPOS"
 
 body_ :: Parser Text
-body_ = Text.append <$> sentenceBegining <*> takeText <|> debug
-  where
-    debug = takeText >>= fail . printf "body (got «%s»)" . ellipsis . Text.unpack
-    ellipsis s
-      | Prelude.length s < 21 = s
-      | otherwise = take 20 s ++ "…"
+body_ = Text.append <$> sentenceBegining <*> takeText <!> "body"
-- 
GitLab