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

Add tests for headwords and inflected POS

parent a85b8e16
No related branches found
No related tags found
No related merge requests found
...@@ -6,26 +6,63 @@ module ExtractMetadata ( ...@@ -6,26 +6,63 @@ module ExtractMetadata (
import Data.Attoparsec.Text (Parser, parseOnly) import Data.Attoparsec.Text (Parser, parseOnly)
import Data.Text as Text (Text, pack) import Data.Text as Text (Text, pack)
import Distribution.TestSuite (Test, testGroup) import Distribution.TestSuite (Test, testGroup)
import Text.Encyclopedia.Article (body_) import Text.Encyclopedia.Article (
InflectedPOS(..), Inflection(..), POS(..), headwords_, inflectedPOS_, body_
)
import Toolbox (simpleTest) import Toolbox (simpleTest)
import Text.Printf (printf) import Text.Printf (printf)
checkAttoparsec :: (Show a, Eq a) => (String, Parser a, Text, Either String a) -> Test checkAttoparsec :: (Show a, Eq a) => Parser a -> (String, Text, Either String a) -> Test
checkAttoparsec (what, parser, input, expected) = checkAttoparsec parser (what, input, expected) =
simpleTest (what, parseOnly parser 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 :: Test
testBodyGrammar = testGroup "body" $ checkAttoparsec <$> [ testBodyGrammar = testGroup "body" $ checkAttoparsec body_ <$> [
("Positive", body_, positive, Right positive) ("Positive", positive, Right positive)
, ("Negative", body_, Text.pack negative, errorMessage) , ("Negative", Text.pack negative, errorMessage "body" negative)
] ]
where where
positive = "Une phrase commence par une majuscule." positive = "Une phrase commence par une majuscule."
negative = "pas par une minuscule" negative = "pas par une minuscule"
errorMessage =
Left . printf "Failed reading: body (got «%s…»)" $ take 20 negative
tests :: IO [Test] tests :: IO [Test]
tests = pure [ tests = pure [
testBodyGrammar testHeadwordGrammar
, testPOSGrammar
, testBodyGrammar
] ]
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