55 lines
1.8 KiB
Haskell
55 lines
1.8 KiB
Haskell
|
import qualified Grammar
|
||
|
|
import qualified Registry.Registry as Registry
|
||
|
|
|
||
|
|
import qualified Test.HUnit as HUnit
|
||
|
|
import qualified System.IO
|
||
|
|
import qualified Text.Regex as Regex
|
||
|
|
|
||
|
|
wfTagsFile = "./well-formed-tags.txt"
|
||
|
|
brokenTagsFile = "./broken-tags.txt"
|
||
|
|
validTagsFile = "./valid-tags.txt"
|
||
|
|
invalidTagsFile = "./invalid-tags.txt"
|
||
|
|
|
||
|
|
registryfile = "./language-subtag-registry"
|
||
|
|
|
||
|
|
languageTag = Grammar.tag
|
||
|
|
|
||
|
|
getTag line =
|
||
|
|
let fields = Regex.splitRegex (Regex.mkRegex " +") line in
|
||
|
|
fields !! 0
|
||
|
|
|
||
|
|
shouldBeWellFormed tag =
|
||
|
|
HUnit.TestCase (HUnit.assertBool (tag ++ " should be well-formed")
|
||
|
|
(Grammar.testTag tag == True))
|
||
|
|
|
||
|
|
shouldBeBroken tag =
|
||
|
|
HUnit.TestCase (HUnit.assertBool (tag ++ " should *not* be well-formed")
|
||
|
|
(Grammar.testTag tag == False))
|
||
|
|
|
||
|
|
shouldBeValid reg tag =
|
||
|
|
HUnit.TestCase (HUnit.assertBool (tag ++ " should be valid")
|
||
|
|
(Registry.testTag reg tag == True))
|
||
|
|
|
||
|
|
shouldBeInvalid reg tag =
|
||
|
|
HUnit.TestCase (HUnit.assertBool (tag ++ " should *not* be valid")
|
||
|
|
(Registry.testTag reg tag == False))
|
||
|
|
|
||
|
|
tagsFromFile filename = do
|
||
|
|
myContents <- System.IO.readFile filename
|
||
|
|
let myLines = lines myContents
|
||
|
|
return (map getTag myLines)
|
||
|
|
|
||
|
|
main = do
|
||
|
|
brokenTags <- tagsFromFile brokenTagsFile
|
||
|
|
wfTags <- tagsFromFile wfTagsFile
|
||
|
|
theregistry <- Registry.readRegistry registryfile
|
||
|
|
invalidTags <- tagsFromFile invalidTagsFile
|
||
|
|
validTags <- tagsFromFile validTagsFile
|
||
|
|
let tests = HUnit.TestList (map shouldBeBroken (brokenTags) ++
|
||
|
|
map shouldBeWellFormed (wfTags) ++
|
||
|
|
map (shouldBeValid theregistry) (validTags) ++
|
||
|
|
map (shouldBeInvalid theregistry) (invalidTags))
|
||
|
|
HUnit.runTestTT tests
|
||
|
|
|
||
|
|
|