finished tests for ‘Text.Megaparsec.Char’

This commit is contained in:
mrkkrp 2015-08-11 03:22:29 +06:00
parent 176fe8d9c1
commit da48d0c690
2 changed files with 53 additions and 41 deletions

View File

@ -30,17 +30,13 @@
module Char (tests) where
import Data.Char
import Data.List (findIndex, isPrefixOf)
import Data.List (findIndex)
import Test.Framework
import Test.QuickCheck
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Text.Megaparsec.Char
import Text.Megaparsec.Combinator
import Text.Megaparsec.Error
import Text.Megaparsec.Pos
import Text.Megaparsec.Prim
import Util
@ -66,10 +62,10 @@ tests = testGroup "Character parsers"
, testProperty "string" prop_string ]
prop_oneOf :: String -> String -> Property
prop_oneOf a = singleChar (oneOf a) (`elem` a) Nothing
prop_oneOf a = checkChar (oneOf a) (`elem` a) Nothing
prop_noneOf :: String -> String -> Property
prop_noneOf a = singleChar (noneOf a) (`notElem` a) Nothing
prop_noneOf a = checkChar (noneOf a) (`notElem` a) Nothing
prop_spaces :: String -> Property
prop_spaces s = checkParser spaces r s
@ -84,59 +80,48 @@ prop_spaces s = checkParser spaces r s
Nothing -> Right ()
prop_space :: String -> Property
prop_space = singleChar space isSpace (Just "white space")
prop_space = checkChar space isSpace (Just "white space")
prop_newline :: String -> Property
prop_newline = singleChar newline (== '\n') (Just "newline")
prop_newline = checkChar newline (== '\n') (Just "newline")
prop_crlf :: String -> Property
prop_crlf s = property True -- TODO
prop_crlf = checkString crlf "\r\n" "crlf newline"
prop_eol :: String -> Property
prop_eol s = property True -- TODO
prop_eol s = checkParser eol r s
where r | not (null s) && head s == '\r' = simpleParse crlf s
| otherwise = simpleParse eol s
prop_tab :: String -> Property
prop_tab = singleChar tab (== '\t') (Just "tab")
prop_tab = checkChar tab (== '\t') (Just "tab")
prop_upper :: String -> Property
prop_upper = singleChar upper isUpper (Just "uppercase letter")
prop_upper = checkChar upper isUpper (Just "uppercase letter")
prop_lower :: String -> Property
prop_lower = singleChar lower isLower (Just "lowercase letter")
prop_lower = checkChar lower isLower (Just "lowercase letter")
prop_alphaNum :: String -> Property
prop_alphaNum = singleChar alphaNum isAlphaNum (Just "letter or digit")
prop_alphaNum = checkChar alphaNum isAlphaNum (Just "letter or digit")
prop_letter :: String -> Property
prop_letter = singleChar letter isAlpha (Just "letter")
prop_letter = checkChar letter isAlpha (Just "letter")
prop_digit :: String -> Property
prop_digit = singleChar digit isDigit (Just "digit")
prop_digit = checkChar digit isDigit (Just "digit")
prop_hexDigit :: String -> Property
prop_hexDigit = singleChar hexDigit isHexDigit (Just "hexadecimal digit")
prop_hexDigit = checkChar hexDigit isHexDigit (Just "hexadecimal digit")
prop_octDigit :: String -> Property
prop_octDigit = singleChar octDigit isOctDigit (Just "octal digit")
prop_octDigit = checkChar octDigit isOctDigit (Just "octal digit")
prop_char :: Char -> String -> Property
prop_char c = singleChar (char c) (== c) (Just $ showToken c)
prop_char c = checkChar (char c) (== c) (Just $ showToken c)
prop_anyChar :: String -> Property
prop_anyChar = singleChar anyChar (const True) (Just "character")
-- FIXME: In general, currently I don't like error messages that string
-- produces. It tells me about first mismatching letter, but also presents
-- the whole expected word:
--
-- λ> parseTest (string "re" <* eof) "ri"
-- parse error at line 1, column 1:
-- unexpected "i"
-- expecting "re"
--
-- is it the best error message we can get here?
prop_anyChar = checkChar anyChar (const True) (Just "character")
prop_string :: String -> String -> Property
prop_string a s = property True
-- prop_string a s = checkParser (string a) r s
-- where r | a == s = Right s
prop_string a = checkString (string a) a (showToken a)

View File

@ -29,7 +29,9 @@
module Util
( checkParser
, singleChar
, simpleParse
, checkChar
, checkString
, posErr
, suneStr
, suneCh
@ -58,16 +60,24 @@ import Text.Megaparsec.String
checkParser :: (Eq a, Show a) =>
Parser a -> Either ParseError a -> String -> Property
checkParser p r s = parse (p <* eof) "" s === r
checkParser p r s = simpleParse p s === r
-- | @singleChar p test label s@ runs parser @p@ on input @s@ and checks if
-- | @simpleParse p s@ runs parser @p@ on input @s@ and returns corresponding
-- result of type @Either ParseError a@, where @a@ is type of parsed
-- value. This parser tries to parser end of file too and name of input file
-- is always empty string.
simpleParse :: Parser a -> String -> Either ParseError a
simpleParse p = parse (p <* eof) ""
-- | @checkChar p test label s@ runs parser @p@ on input @s@ and checks if
-- the parser correctly parses single character that satisfies @test@. The
-- character may be labelled, in this case @label@ is used to check quality
-- of error messages.
singleChar :: Parser Char -> (Char -> Bool) ->
checkChar :: Parser Char -> (Char -> Bool) ->
Maybe String -> String -> Property
singleChar p f l' s = checkParser p r s
checkChar p f l' s = checkParser p r s
where h = head s
l = exSpec <$> maybeToList l'
r | null s = posErr 0 s (suneStr "" : l)
@ -75,6 +85,21 @@ singleChar p f l' s = checkParser p r s
| not (f h) = posErr 0 s (suneCh h : l)
| otherwise = posErr 1 s [uneCh (s !! 1), exStr ""]
-- | @checkString p a label s@ runs parser @p@ on input @s@ and checks if
-- the result is equal to @a@ and also quality of error messages. @label@ is
-- used as expected representation of parser's result in error messages.
checkString :: Parser String -> String -> String -> String -> Property
checkString p a' l s' = checkParser p (w a' 0 s') s'
where w [] _ [] = Right a'
w [] i (s:_) = posErr i s' [uneCh s, exStr ""]
w _ 0 [] = posErr 0 s' [suneStr "", exSpec l]
w _ i [] = posErr 0 s' [suneStr (take i s'), exSpec l]
w (a:as) i (s:ss)
| a == s = w as i' ss
| otherwise = posErr 0 s' [suneStr (take i' s'), exSpec l]
where i' = succ i
-- | @posErr pos s ms@ is an easy way to model result of parser that
-- fails. @pos@ is how many tokens (characters) has been consumed before
-- failure. @s@ is input of the parser. @ms@ is a list, collection of
@ -123,7 +148,9 @@ exCh :: Char -> Message
exCh s = Expect $ showToken s
-- | @exSpec s@ returns message created with 'Expect' constructor that tells
-- the system that string @s@ is expected.
-- the system that string @s@ is expected. This is different from 'exStr' in
-- that it doesn't use 'showToken' but rather pass its argument unaltered
-- allowing for “special” labels.
exSpec :: String -> Message
exSpec = Expect