diff --git a/megaparsec.cabal b/megaparsec.cabal index 3a92e2f..a9ea02a 100644 --- a/megaparsec.cabal +++ b/megaparsec.cabal @@ -139,6 +139,8 @@ test-suite tests ghc-options: -O2 -Wall -rtsopts build-depends: base >= 4.8 && < 5 , megaparsec >= 4.0.0 + , mtl == 2.* + , transformers == 0.4.* , QuickCheck >= 2.4 && < 3 , test-framework >= 0.6 && < 1 , test-framework-quickcheck2 >= 0.3 && < 0.4 diff --git a/tests/Prim.hs b/tests/Prim.hs index 2cf9270..1e46e33 100644 --- a/tests/Prim.hs +++ b/tests/Prim.hs @@ -32,13 +32,20 @@ module Prim (tests) where import Control.Applicative -import Control.Monad (guard) +import Control.Monad (guard, void) import Data.Bool (bool) -import Data.Char (isLetter) +import Data.Char (isLetter, toUpper) import Data.Foldable (asum) import Data.List (isPrefixOf) import Data.Maybe (maybeToList, fromMaybe) +import qualified Control.Monad.Trans.Identity as Identity +import qualified Control.Monad.Reader as Reader +import qualified Control.Monad.State.Lazy as L.State +import qualified Control.Monad.State.Strict as S.State +import qualified Control.Monad.Writer.Lazy as L.Writer +import qualified Control.Monad.Writer.Strict as S.Writer + import Test.Framework import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck hiding (label) @@ -85,8 +92,18 @@ tests = testGroup "Primitive parser combinators" , testProperty "parser state position" prop_state_pos , testProperty "parser state input" prop_state_input , testProperty "parser state general" prop_state - -- , testProperty "user state" prop_user_state - -- , testProperty "user state backtracking" prop_user_backtrack + , testProperty "IdentityT try" prop_IdentityT_try + , testProperty "IdentityT notFollowedBy" prop_IdentityT_notFollowedBy + , testProperty "ReaderT try" prop_ReaderT_try + , testProperty "ReaderT notFollowedBy" prop_ReaderT_notFollowedBy + , testProperty "lazy StateT alternative (<|>)" prop_lazy_StateT_alternative + , testProperty "strict StateT alternative (<|>)" prop_strict_StateT_alternative + , testProperty "lazy StateT lookAhead" prop_lazy_StateT_lookAhead + , testProperty "strict StateT lookAhead" prop_strict_StateT_lookAhead + , testProperty "lazy StateT notFollowedBy" prop_lazy_StateT_notFollowedBy + , testProperty "strict StateT notFollowedBy" prop_strict_StateT_notFollowedBy + , testProperty "lazy WriterT" prop_lazy_WriterT + , testProperty "strict WriterT" prop_strict_WriterT ] instance Arbitrary (State String) where @@ -359,12 +376,131 @@ prop_state s1 s2 = runParser p "" "" === Right (f s2 s1) updateParserState (f s2) getParserState --- User state combinators +-- IdentityT/ReaderT + Parser --- prop_user_state :: Integer -> Integer -> Property --- prop_user_state n m = runParser p 0 "" "" === Right (n + m) --- where p = setState n >> modifyState (+ m) >> getState +-- | A copy of 'prop_try'. +prop_IdentityT_try :: String -> String -> String -> Property +prop_IdentityT_try pre s1' s2' = checkParser (Identity.runIdentityT p) r s + where s1 = pre ++ s1' + s2 = pre ++ s2' + p = try (string s1) <|> string s2 + r | s == s1 || s == s2 = Right s + | otherwise = posErr 0 s $ bool [uneStr pre] [uneEof] (null s) + ++ [uneStr pre, exStr s1, exStr s2] + s = pre --- prop_user_backtrack :: Integer -> Integer -> Property --- prop_user_backtrack n m = runParser p 0 "" "" === Right n --- where p = setState n >> lookAhead (setState m >> eof) >> getState +prop_ReaderT_try :: String -> String -> String -> Property +prop_ReaderT_try pre s1' s2' = checkParser (Reader.runReaderT p (s1', s2')) r s + where s1 = pre ++ s1' + s2 = pre ++ s2' + getS1 = Reader.asks ((pre ++) . fst) + getS2 = Reader.asks ((pre ++) . snd) + p = try (string =<< getS1) <|> (string =<< getS2) + r | s == s1 || s == s2 = Right s + | otherwise = posErr 0 s $ bool [uneStr pre] [uneEof] (null s) + ++ [uneStr pre, exStr s1, exStr s2] + s = pre + +-- | A copy of 'prop_notFollowedBy_2'. +prop_IdentityT_notFollowedBy + :: NonNegative Int -> NonNegative Int -> NonNegative Int -> Property +prop_IdentityT_notFollowedBy a' b' c' = checkParser (Identity.runIdentityT p) r s + where [a,b,c] = getNonNegative <$> [a',b',c'] + p = many (char 'a') <* notFollowedBy eof <* many anyChar + r | b > 0 || c > 0 = Right (replicate a 'a') + | otherwise = posErr a s [uneEof, exCh 'a'] + s = abcRow a b c + +prop_ReaderT_notFollowedBy + :: NonNegative Int -> NonNegative Int -> NonNegative Int -> Property +prop_ReaderT_notFollowedBy a' b' c' = checkParser (Reader.runReaderT p 'a') r s + where [a,b,c] = getNonNegative <$> [a',b',c'] + p = many (char =<< Reader.ask) <* notFollowedBy eof <* many anyChar + r | b > 0 || c > 0 = Right (replicate a 'a') + | otherwise = posErr a s [uneEof, exCh 'a'] + s = abcRow a b c + +-- StateT + Parsec + +prop_lazy_StateT_alternative :: Integer -> Property +prop_lazy_StateT_alternative n = checkParser (L.State.evalStateT p 0) (Right n) "" + where p = do + L.State.put n + (L.State.modify (*2) >> void (string "xxx")) <|> return () + L.State.get + +prop_strict_StateT_alternative :: Integer -> Property +prop_strict_StateT_alternative n = checkParser (S.State.evalStateT p 0) (Right n) "" + where p = do + S.State.put n + (S.State.modify (*2) >> void (string "xxx")) <|> return () + S.State.get + +-- | See . +prop_lazy_StateT_lookAhead :: Integer -> Property +prop_lazy_StateT_lookAhead n = checkParser (L.State.evalStateT p 0) (Right n) "" + where p = do + L.State.put n + lookAhead (L.State.modify (*2) >> eof) + L.State.get + +prop_strict_StateT_lookAhead :: Integer -> Property +prop_strict_StateT_lookAhead n = checkParser (S.State.evalStateT p 0) (Right n) "" + where p = do + S.State.put n + lookAhead (S.State.modify (*2) >> eof) + S.State.get + +prop_lazy_StateT_notFollowedBy :: Integer -> Property +prop_lazy_StateT_notFollowedBy n = checkParser (L.State.runStateT p 0) result "abx" + where p = do + L.State.put n + let notEof = notFollowedBy (L.State.modify (*2) >> eof) + some (try (anyChar <* notEof)) <* char 'x' + result = Right ("ab", n) + +prop_strict_StateT_notFollowedBy :: Integer -> Property +prop_strict_StateT_notFollowedBy n = checkParser (S.State.runStateT p 0) result "abx" + where p = do + S.State.put n + let notEof = notFollowedBy (S.State.modify (*2) >> eof) + some (try (anyChar <* notEof)) <* char 'x' + result = Right ("ab", n) + +-- WriterT + Parsec + +prop_lazy_WriterT :: String -> String -> Property +prop_lazy_WriterT pre post = checkParser (L.Writer.runWriterT p) result "abx" + where logged_letter = do + x <- letterChar + L.Writer.tell [x] + return x + logged_eof = do + eof + S.Writer.tell "EOF" + p = do + L.Writer.tell pre + cs <- L.Writer.censor (map toUpper) $ + some (try (logged_letter <* notFollowedBy logged_eof)) + L.Writer.tell post + _ <- logged_letter + return cs + result = Right ("ab", pre ++ "AB" ++ post ++ "x") + +prop_strict_WriterT :: String -> String -> Property +prop_strict_WriterT pre post = checkParser (S.Writer.runWriterT p) result "abx" + where logged_letter = do + x <- letterChar + S.Writer.tell [x] + return x + logged_eof = do + eof + S.Writer.tell "EOF" + p = do + S.Writer.tell pre + cs <- S.Writer.censor (map toUpper) $ + some (try (logged_letter <* notFollowedBy logged_eof)) + S.Writer.tell post + _ <- logged_letter + return cs + result = Right ("ab", pre ++ "AB" ++ post ++ "x")