diff --git a/lib/Text/Encyclopedia/Article.hs b/lib/Text/Encyclopedia/Article.hs index 4a9b5bd3a30eeb4a3a4bf88d80cd4dc57bd46e65..870d1417d4ea9cc5ebcc9d55d282c4729be3dbdc 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"