diff --git a/test/ExtractMetadata.hs b/test/ExtractMetadata.hs index fc310d3a00a2436d45498e2d9e88be0d8f0dbbcc..281a125f72646377a7b6625693fafe09dbf7c11b 100644 --- a/test/ExtractMetadata.hs +++ b/test/ExtractMetadata.hs @@ -6,26 +6,63 @@ module ExtractMetadata ( import Data.Attoparsec.Text (Parser, parseOnly) import Data.Text as Text (Text, pack) import Distribution.TestSuite (Test, testGroup) -import Text.Encyclopedia.Article (body_) +import Text.Encyclopedia.Article ( + InflectedPOS(..), Inflection(..), POS(..), headwords_, inflectedPOS_, body_ + ) import Toolbox (simpleTest) import Text.Printf (printf) -checkAttoparsec :: (Show a, Eq a) => (String, Parser a, Text, Either String a) -> Test -checkAttoparsec (what, parser, input, expected) = +checkAttoparsec :: (Show a, Eq a) => Parser a -> (String, Text, Either String a) -> Test +checkAttoparsec parser (what, input, expected) = simpleTest (what, parseOnly parser input, expected) +errorMessage :: String -> String -> Either String a +errorMessage expected = + Left . printf "Failed reading: %s (got «%s»)" expected . ellipsis + where + ellipsis s + | length s < 21 = s + | otherwise = take 20 s ++ "…" + +testHeadwordGrammar :: Test +testHeadwordGrammar = testGroup "headword" $ checkAttoparsec headwords_ <$> [ + ("simple headword", "TEST.", Right ["TEST"]) + , ("2 headwords", "KHEIR, ou KEIR.", Right ["KHEIR", "KEIR"]) + , ("several headwords", "HUEY, DEWEY, ou LOUIE.", Right ["HUEY", "DEWEY", "LOUIE"]) + , ("not a head", "truc", errorMessage "at least one headword" "truc") + ] + + +testPOSGrammar :: Test +testPOSGrammar = testGroup "POS" [ + testGroup "POS-only" $ checkAttoparsec inflectedPOS_ <$> [ + ("substantive", " s.", Right subst) + , ("verb", " v.", Right verb) + , ("bad POS", "truc", errorMessage "inflectedPOS" "truc") + ] + , testGroup "inflected" $ checkAttoparsec inflectedPOS_ <$> [ + ("fem. subst.", " s. f.", Right substF) + , ("masc. adj.", " adj. m.", Right adjM) + ] + ] + where + subst = InflectedPOS Substantive Nothing + verb = InflectedPOS Verb Nothing + substF = subst {inflection = Just Feminine} + adjM = InflectedPOS Adjective (Just Masculine) + testBodyGrammar :: Test -testBodyGrammar = testGroup "body" $ checkAttoparsec <$> [ - ("Positive", body_, positive, Right positive) - , ("Negative", body_, Text.pack negative, errorMessage) +testBodyGrammar = testGroup "body" $ checkAttoparsec body_ <$> [ + ("Positive", positive, Right positive) + , ("Negative", Text.pack negative, errorMessage "body" negative) ] where positive = "Une phrase commence par une majuscule." negative = "pas par une minuscule" - errorMessage = - Left . printf "Failed reading: body (got «%s…»)" $ take 20 negative tests :: IO [Test] tests = pure [ - testBodyGrammar + testHeadwordGrammar + , testPOSGrammar + , testBodyGrammar ]