Skip to content
Snippets Groups Projects
Commit a85b8e16 authored by Alice Brenon's avatar Alice Brenon
Browse files

More readable error messages with operator <!> showing an excerpt of what has been actually read

parent aa302481
No related branches found
No related tags found
No related merge requests found
...@@ -34,6 +34,15 @@ data Article = Article { ...@@ -34,6 +34,15 @@ data Article = Article {
, body :: Text , body :: Text
} deriving (Eq, Show) } 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 :: Parser Article
article = Article <$> headwords_ <*> optional inflectedPOS_ <*> body_ article = Article <$> headwords_ <*> optional inflectedPOS_ <*> body_
...@@ -58,7 +67,8 @@ many1Till :: Parser a -> Parser b -> Parser [a] ...@@ -58,7 +67,8 @@ many1Till :: Parser a -> Parser b -> Parser [a]
many1Till p after = (:) <$> p <*> manyTill p after many1Till p after = (:) <$> p <*> manyTill p after
headwords_ :: Parser [String] headwords_ :: Parser [String]
headwords_ = headword `sepBy1` headwordSeparator <* blank headwords_ =
(headword `sepBy1` headwordSeparator <!> "at least one headword") <* blank
where where
headword = headword =
satisfy isUpper `many1Till` lookAhead (sentenceBegining <|> punctOrSpace) satisfy isUpper `many1Till` lookAhead (sentenceBegining <|> punctOrSpace)
...@@ -75,11 +85,7 @@ inflectedPOS_ :: Parser InflectedPOS ...@@ -75,11 +85,7 @@ inflectedPOS_ :: Parser InflectedPOS
inflectedPOS_ = InflectedPOS inflectedPOS_ = InflectedPOS
<$> (punctOrSpace *> abbreviation <* blank) <$> (punctOrSpace *> abbreviation <* blank)
<*> (optional abbreviation <* blank) <*> (optional abbreviation <* blank)
<!> "inflectedPOS"
body_ :: Parser Text body_ :: Parser Text
body_ = Text.append <$> sentenceBegining <*> takeText <|> debug body_ = Text.append <$> sentenceBegining <*> takeText <!> "body"
where
debug = takeText >>= fail . printf "body (got «%s»)" . ellipsis . Text.unpack
ellipsis s
| Prelude.length s < 21 = s
| otherwise = take 20 s ++ "…"
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment