faster-megaparsec (empty) → 0.1.0.0

raw patch · 7 files changed

+644/−0 lines, 7 filesdep +QuickCheckdep +basedep +containerssetup-changed

Dependencies added: QuickCheck, base, containers, faster-megaparsec, megaparsec, mtl, text

Files

CHANGELOG.md +11/−0
LICENSE +1/−0
README.md +23/−0
Setup.hs +2/−0
faster-megaparsec.cabal +52/−0
src/Text/Megaparsec/Simple.hs +292/−0
test/Spec.hs +263/−0

+ CHANGELOG.md view

@@ -0,0 +1,11 @@+# Changelog for `faster-megaparsec`++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to the+[Haskell Package Versioning Policy](https://pvp.haskell.org/).++## Unreleased++## 0.1.0.0 - YYYY-MM-DD

+ LICENSE view

@@ -0,0 +1,1 @@+See https://www.gnu.org/licenses/gpl-3.0.txt

+ README.md view

@@ -0,0 +1,23 @@+# faster-megaparsec++This package defines a MonadParsec instance for +(a type isomorphic to) `StateT s Maybe`+where `s` is a Megaparsec Stream type such as `String`, `Text` or `ByteString`.+This parser can be faster than Cassava for csv parsing +but at the cost of no error information whatsoever. ++If, however, you construct your parser in a generic `MonadParsec` fashion, +then with the help of `Text.Megaparsec.Simple.tryFast` +you can first attempt to specialize and run the fast parser +supplied by this package and only on parse error specialize +the parser to `ParsecT` and parse again, yielding an informative +error message.  +This buys you speed in the smooth case of successful parsing +at the cost of double parse when something goes wrong. ++Beware that the behaviour of a `SimpleParser` can differ from its `Parsec` sibling +because ++ * `SimpleParser` is always backtracking since it does not know whether it has consumed tokens,+ * any fancy parsing that relies on inspecting parser state components such as offset will not work as intended.+

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ faster-megaparsec.cabal view

@@ -0,0 +1,52 @@+cabal-version: 1.12+name:           faster-megaparsec+version:        0.1.0.0+description:    Speed up Megaparsec parsing when parsing succeeds+homepage:       https://hub.darcs.net/olf/faster-megaparsec+bug-reports:    https://hub.darcs.net/olf/faster-megaparsec/issues+author:         Olaf Klinke+maintainer:     olaf.klinke@phymetric.de, olf@aatal-apotheke.de+copyright:      2022 Lackmann Phymetric GmbH+license:        GPL-3+license-file:   LICENSE+build-type:     Simple+category:       Parsing+synopsis:       see README.md+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: darcs+  location: https://hub.darcs.net/olf/faster-megaparsec++library+  exposed-modules:+      Text.Megaparsec.Simple+  other-modules:+      Paths_faster_megaparsec+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+  build-depends:+      base >=4.7 && <5+    , megaparsec >= 6 && <10+    , mtl < 2.4+  default-language: Haskell2010++test-suite faster-megaparsec-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_faster_megaparsec+  hs-source-dirs:+      test+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , containers >= 0.5.11+    , megaparsec+    , faster-megaparsec+    , text+    , QuickCheck+  default-language: Haskell2010

+ src/Text/Megaparsec/Simple.hs view

@@ -0,0 +1,292 @@+{-# LANGUAGE MultiParamTypeClasses+ ,FlexibleInstances+ ,FlexibleContexts+ ,Rank2Types+ ,TypeFamilies+ ,ScopedTypeVariables+ ,DerivingVia+ ,CPP #-}+{-|+Module      : Text.Megaparsec.Simple+Description : primitive StateT parser with Megaparsec instance+Copyright   : (c) Lackmann Phymetric+License     : GPL-3+Maintainer  : olaf.klinke@phymetric.de+Stability   : experimental++This module defines a 'MonadParsec' instance for +(a type isomorphic to) @'StateT' s 'Maybe'@+where @s@ is a Megaparsec 'Mega.Stream' type such as @String@, @Text@ or @ByteString@.+This parser can be faster than Cassava for csv parsing +but at the cost of no error information whatsoever. ++If, however, you construct your parser in a generic 'MonadParsec' fashion, +then with the help of 'tryFast' you can first attempt to specialize and run the fast parser +supplied by this module and only on parse error specialize +the parser to @ParsecT@ and parse again, yielding an informative +error message.  +This buys you speed in the smooth case of successful parsing +at the cost of double parse when something goes wrong. ++Beware that the behaviour of a 'SimpleParser' can differ from its 'Mega.Parsec' sibling +because ++ * 'SimpleParser' is always backtracking since it does not know whether it has consumed tokens,+ * any fancy parsing that relies on inspecting parser state components such as offset will not work as intended.++-}+module Text.Megaparsec.Simple (+    SimpleParser,+    tryFast,+    -- * Conversion from/to StateT+    toSimpleParser,+    runSimpleParser) where+import Control.Monad.State.Strict+import Control.Applicative+import Data.String (IsString(..))+import Data.Maybe (isNothing)+import Data.Proxy (Proxy(..))+import Data.Void (Void)+import qualified Text.Megaparsec as Mega+import Text.Megaparsec (MonadParsec,State(..))++-- * Parsing++-- | This parser type is isomorphic to +-- @StateT s Maybe@ +-- but has roughly the same instances as 'Mega.Parsec'. +-- Since it maintains no state besides the unconsumed input, +-- it is considerably faster than 'Mega.Parsec' +-- but can be built using the same combinators. +newtype SimpleParser s a = SimpleParser (StateT s Maybe a)+    deriving (Functor,Applicative,Alternative,Monad,MonadPlus,MonadFail) +    via (StateT s Maybe)++instance Semigroup a => Semigroup (SimpleParser s a) where+    p <> q = liftA2 (<>) p q+instance Monoid a => Monoid (SimpleParser s a) where+    mempty = pure mempty+    mappend = (<>)+instance (a ~ Mega.Tokens s, IsString a, Eq a, Mega.Stream s)+    => IsString (SimpleParser s a) where+  fromString s = Mega.tokens (==) (fromString s)++-- | The 'Parser' is an ordinary State transformer +-- on Megaparsec streams.  +type Parser a = forall s. Mega.Stream s => StateT s Maybe a++-- | synonym for 'evalStateT'+parse :: SimpleParser s a -> s -> Maybe a+parse (SimpleParser p) = evalStateT p++-- | Run the 'SimpleParser' on the given input. +-- Consider using 'tryFast' instead if possible.  +runSimpleParser :: SimpleParser s a -> s -> Maybe (a,s)+runSimpleParser (SimpleParser p) = runStateT p++-- | Use this to implement more parser combinators.+toSimpleParser :: StateT s Maybe a -> SimpleParser s a+toSimpleParser = SimpleParser++-- | The @result@ type of Megaparsec has changed through +-- the library versions +-- (commonly @result = Either err@ for some @err@) +-- whence we abstract over it. +-- Instead of +--+-- @+-- 'Mega.runParser' p+-- @+-- +-- you should use +--+-- @+-- 'tryFast' 'Mega.runParser' p+-- @+-- +-- which tries the fast parser and falls back to 'Mega.Parsec' +-- in case of a parse failure.+tryFast :: forall s a result. (Applicative result, Mega.Stream s) +    => (Mega.Parsec Void s a -> String -> s -> result a) -- ^ function to run if fast parsing fails+    -> (forall p. (MonadParsec Void s p) => p a) -- ^ a generic parser+    -> String                                    -- ^ input stream name +    -> s                                         -- ^ input stream+    -> result a+tryFast runParser p name s = case parse p s of+    Just a -> pure a+    Nothing -> runParser p name s++-- * Combinators++-- ** String parsing++-- | parses end of input+eof :: Parser ()+eof = StateT (\s -> if isNothing (Mega.take1_ s) then Just ((),s) else Nothing)+{-# INLINE eof #-}++-- | more efficient than, but equivalent to 'many' . 'satisfy'+takeWhileP :: (Mega.Stream s) => (Mega.Token s -> Bool) -> StateT s Maybe (Mega.Tokens s)+takeWhileP p = StateT (Just . Mega.takeWhile_ p)+{-# INLINE takeWhileP #-}++-- | more efficient than, but equivalent to 'some' . 'satisfy'+takeWhile1P :: forall s. (Mega.Stream s) => (Mega.Token s -> Bool) -> StateT s Maybe (Mega.Tokens s)+takeWhile1P = mfilter (not. Mega.chunkEmpty (Proxy :: Proxy s)) . takeWhileP+{-# INLINE takeWhile1P #-}++-- | parse any string of given length, using 'splitAt'.  +-- More efficient than @\\n -> 'count' n ('satisfy' ('const' 'True'))@.+-- Fails if input does not have that many characters left. +-- Since 'Mega.takeP' requests this parser to succeed only if +-- the requested number of tokens can be returned, and we can never +-- return a negative number of tokens, this parser fails for negative inputs. +countAny :: forall s. (Mega.Stream s) => Int -> StateT s Maybe (Mega.Tokens s)+countAny n = if n < 0 then mzero else StateT (\s -> Mega.takeN_ n s)+{-# INLINE countAny #-}++-- | (For the 'MonadParsec' instance) 'Parser' does not contain any state besides the input left to parse. +#if MIN_VERSION_megaparsec(7,0,0)+#if MIN_VERSION_megaparsec(8,0,0) +dummyState :: s -> Mega.State s e+dummyState s = Mega.State {+    stateInput = s,+    stateOffset = 0,+    statePosState = Mega.PosState {+        Mega.pstateInput = s,+        Mega.pstateOffset = 0,+        Mega.pstateSourcePos = Mega.initialPos "",+        Mega.pstateTabWidth = Mega.pos1,+        Mega.pstateLinePrefix = ""+        },+    stateParseErrors = []+}+getDummyState :: StateT s Maybe (Mega.State s e)+getDummyState = fmap dummyState get+#else+dummyState :: s -> Mega.State s+dummyState s = Mega.State {+    stateInput = s,+    stateOffset = 0,+    statePosState = Mega.PosState {+        Mega.pstateInput = s,+        Mega.pstateOffset = 0,+        Mega.pstateSourcePos = Mega.initialPos "",+        Mega.pstateTabWidth = Mega.pos1,+        Mega.pstateLinePrefix = ""+        }+}+getDummyState :: StateT s Maybe (Mega.State s)+getDummyState = fmap dummyState get+#endif+#else+dummyState :: s -> Mega.State s+dummyState s = Mega.State {+    stateInput = s,+    statePos = return (Mega.initialPos "no source info"),+    stateTokensProcessed = 0,+    stateTabWidth = Mega.pos1+    }+getDummyState :: StateT s Maybe (Mega.State s)+getDummyState = fmap dummyState get+#endif++-- smart constructor+sStateT :: (s -> Maybe (a,s)) -> SimpleParser s a+sStateT = SimpleParser. StateT++#if MIN_VERSION_megaparsec(7,0,0) +#if MIN_VERSION_megaparsec(8,0,0)+instance forall s. (Mega.Stream s) => MonadParsec Void s (SimpleParser s) where+    parseError _ = sStateT (const Nothing)+    label _ = id+    hidden = id+    try = id+    lookAhead p = sStateT (\s -> case parse p s of+        Nothing -> Nothing+        Just a  -> Just (a,s))+    notFollowedBy p = sStateT (\s -> case parse p s of+        Nothing -> Just ((),s)+        Just _ ->  Nothing)+    withRecovery handle p = sStateT (\s -> maybe (runSimpleParser (handle mempty) s) Just (runSimpleParser p s))+    observing p = sStateT (\s -> case runSimpleParser p s of+        Nothing -> Just (Left mempty,s)+        Just (a,s') -> Just (Right a,s'))+    eof = SimpleParser eof+    token test _ = sStateT (\s -> case Mega.take1_ s of+        Nothing -> Nothing+        Just (t,s') -> case test t of+            Nothing -> Nothing+            Just  a -> Just (a,s'))+    tokens cmp xs = sStateT (\s -> case Mega.takeN_ (Mega.chunkLength (Proxy :: Proxy s) xs) s of+        Nothing -> Nothing+        Just (ys,s') -> if cmp xs ys then Just (xs,s') else Nothing)+    getParserState = SimpleParser getDummyState+    updateParserState f = sStateT (\s -> Just ((),(stateInput.f.dummyState) s))+    takeWhileP _  = SimpleParser . takeWhileP+    takeWhile1P _ = SimpleParser . takeWhile1P+    takeP _ = SimpleParser . countAny+#else+instance forall s. (Mega.Stream s) => MonadParsec Void s (SimpleParser s) where+    failure _ _ = sStateT (const Nothing)+    fancyFailure _ = sStateT (const Nothing)+    label _ = id+    hidden = id+    try = id+    lookAhead p = sStateT (\s -> case parse p s of+        Nothing -> Nothing+        Just a  -> Just (a,s))+    notFollowedBy p = sStateT (\s -> case parse p s of+        Nothing -> Just ((),s)+        Just _ ->  Nothing)+    withRecovery handle p = sStateT (\s -> maybe (runSimpleParser (handle mempty) s) Just (runSimpleParser p s))+    observing p = sStateT (\s -> case runSimpleParser p s of+        Nothing -> Just (Left mempty,s)+        Just (a,s') -> Just (Right a,s'))+    eof = SimpleParser eof+    token test _ = sStateT (\s -> case Mega.take1_ s of+        Nothing -> Nothing+        Just (t,s') -> case test t of+            Nothing -> Nothing+            Just  a -> Just (a,s'))+    tokens cmp xs = sStateT (\s -> case Mega.takeN_ (Mega.chunkLength (Proxy :: Proxy s) xs) s of+        Nothing -> Nothing+        Just (ys,s') -> if cmp xs ys then Just (xs,s') else Nothing)+    getParserState = SimpleParser getDummyState+    updateParserState f = sStateT (\s -> Just ((),(stateInput.f.dummyState) s))+    takeWhileP _  = SimpleParser . takeWhileP+    takeWhile1P _ = SimpleParser . takeWhile1P+    takeP _ = SimpleParser . countAny+#endif+#else+instance forall s. (Mega.Stream s) => MonadParsec Void s (SimpleParser s) where+    failure _ _ = sStateT (const Nothing)+    fancyFailure _ = sStateT (const Nothing)+    label _ = id+    hidden = id+    try = id+    lookAhead p = sStateT (\s -> case parse p s of+        Nothing -> Nothing+        Just a  -> Just (a,s))+    notFollowedBy p = sStateT (\s -> case parse p s of+        Nothing -> Just ((),s)+        Just _ ->  Nothing)+    withRecovery handle p = sStateT (\s -> maybe (runSimpleParser (handle mempty) s) Just (runSimpleParser p s))+    observing p = sStateT (\s -> case runSimpleParser p s of+        Nothing -> Just (Left mempty,s)+        Just (a,s') -> Just (Right a,s'))+    eof = SimpleParser eof+    token test _ = sStateT (\s -> case Mega.take1_ s of+        Nothing -> Nothing+        Just (t,s') -> case test t of+            Nothing -> Nothing+            Just  a -> Just (a,s'))+    tokens cmp xs = sStateT (\s -> case Mega.takeN_ (Mega.chunkLength (Proxy :: Proxy s) xs) s of+        Nothing -> Nothing+        Just (ys,s') -> if cmp xs ys then Just (xs,s') else Nothing)+    getParserState = SimpleParser getDummyState+    updateParserState f = sStateT (\s -> Just ((),(stateInput.f.dummyState) s))+    takeWhileP _  = SimpleParser . takeWhileP+    takeWhile1P _ = SimpleParser . takeWhile1P+    takeP _ = SimpleParser . countAny+#endif

+ test/Spec.hs view

@@ -0,0 +1,263 @@+{--+Parsers form a semigroup in two ways:+Given parsers (p :: Parser s) and (q :: Parser s)+where s is the type of input stream (or any other semigroup) +there is the concatenation++p <> q = do+    x <- p+    y <- q+    return (x<>y)++as well as the (backtracking) choice, try p <|> q. +In this test suite we test whether the ParsecT parser provided by megaparsec +and the SimpleParser provided in this package +behave identically under these two operations. +To this end, we randomly generate languages and parsers for them +and test both parsers on the words of the language. ++--}+{-# LANGUAGE +    FlexibleContexts, +    FlexibleInstances, +    TypeFamilies, +    OverloadedStrings, +    DeriveGeneric, +    DeriveFunctor, +    RankNTypes,+    ScopedTypeVariables+#-}+import Text.Megaparsec+import Text.Megaparsec.Simple+import Data.Void (Void)+import Data.String (IsString(..))+import Data.Text (Text)+import qualified Data.Text as T+import Data.Maybe (isJust)+import Data.List (transpose)+import Control.Applicative (liftA2)+import GHC.Generics (Generic)+import Test.QuickCheck (Arbitrary(..))+import qualified Test.QuickCheck as Q+import Data.Set (Set)+import qualified Data.Set as Set++main :: IO ()+main = do+    putStrLn "\ntesting whether the fast parser accepts words of the language"+    Q.quickCheck (prop_AcceptsLang Fast) +    putStrLn "testing whether the fast parser accepts the entire language"+    Q.quickCheck (prop_AcceptsAllWords Fast)+    putStrLn "testing whether parsers accept the same words"+    Q.quickCheck (prop_AcceptSameWords)+    putStrLn "testing whether lookAhead behaves identically"+    Q.quickCheck prop_LookAhead+    putStrLn "testing whether takeWhileP behaves identically"+    Q.quickCheck prop_takeWhileP+    putStrLn "testing whether takeWhile1P behaves identically"+    Q.quickCheck prop_takeWhile1P+    putStrLn "testing whether takeP behaves identically"+    Q.quickCheck prop_takeP++data WhichParser = Fast | Ordinary++-- * Parsing languages++-- | The language is designed to test the basic +-- parser operations concatenation and choice. +data Language x = Word String+    | Choice x (Language x) (Language x)+    | Concat x (Language x) (Language x)+    deriving (Show,Eq,Ord,Generic,Functor)++instance IsString (Language x) where+    fromString = Word+instance Semigroup (Language ()) where+    (<>) = Concat ()+instance Semigroup (Language (Set Text)) where+    (Word w1) <> (Word w2) = Word (w1<>w2)+    x@(Word w) <> y@(Choice ws _ _) = let pfx = fromString w +        in Concat (Set.mapMonotonic (pfx<>) ws) x y+    x@(Word w) <> y@(Concat ws _ _) = let pfx = fromString w+        in Concat (Set.mapMonotonic (pfx<>) ws) x y+    x <> y = let ws = Set.map (uncurry (<>)) (Set.cartesianProduct (allWords x) (allWords y))+        in Concat ws x y++class Monad m => NonDeterministic m where+    nonDeterministically :: [m a] -> m a+instance NonDeterministic [] where+    nonDeterministically = concat . transpose -- can enumerate finite choice of infinite lists+instance NonDeterministic Q.Gen where+    nonDeterministically = Q.oneof++class Conditionable m where+    suchThat :: m a -> (a -> Bool) -> m a+instance Conditionable [] where+    suchThat = flip filter+instance Conditionable Q.Gen where +    suchThat = Q.suchThat+instance Conditionable Set where+    suchThat = flip Set.filter+++infixl 3 <||>+-- | The choice operator of 'Language's+(<||>) :: Language (Set Text) -> Language (Set Text) -> Language (Set Text)+x <||> y = Choice (choiceWords (allWords x) (allWords y)) x y++-- |Even with backtracking, +-- a parser may fail to recognize a word of the language +-- if the choices are ordered in a way such that +-- an earlier choice contains a proper prefix of a later choice. +-- Consider for example the regular expression+-- +-- @+-- (a|ab)c+-- @+--+-- and the word @abc@ which is not accepted by the parser +-- +-- @+-- (try (chunk "a") <|> chunk "ab") <> chunk "c"+-- @+-- +-- but is accepted by the parser +-- +-- @+-- (try (chunk "ab") <|> chunk "a") <> chunk "c"+-- @+choiceWords :: Set Text -> Set Text -> Set Text+choiceWords left right = Set.union left (right `suchThat` notSuffixOf left) where+    notSuffixOf earlier = \w -> not (any (\a -> a `T.isPrefixOf` w) earlier)++genWords :: NonDeterministic gen => +    Language (Set Text) -> gen Text+genWords = nonDeterministically . fmap pure . Set.toList . allWords++-- | We record the set of words in the constructor.+allWords :: Language (Set Text) -> Set Text+allWords (Word w) = Set.singleton (fromString w)+allWords (Choice ws _ _) = ws+allWords (Concat ws _ _) = ws++-- ** non-deterministic language generation++-- non-deterministically generate a language+-- +-- >>> mapM_ print $ fmap (const ()) $ genLanguage ["Foo","Bar"] 1+-- >>> Q.sample' (arbitrary :: Q.Gen (Language (Set Text))) >>= (print.fmap (const ()).head) +genLanguage :: NonDeterministic gen => +    gen String -> +    Int -> +    gen (Language (Set Text))+genLanguage genWord = let +    sizedLang = \size -> if size <= 0 then fmap Word genWord else let+        lang' = sizedLang (size `div` 2)+        in nonDeterministically [+            fmap Word genWord,+            liftA2 (<>)   lang' lang',+            liftA2 (<||>) lang' lang'+            ]+    in sizedLang++genAlphaChar :: NonDeterministic gen => gen Char+genAlphaChar = nonDeterministically [return c | c <- ['a'..'z']]++genWordQ :: Q.Gen String+genWordQ = fmap pure genAlphaChar -- use single-letter words as building blocks+-- genWordQ = let g = genAlphaChar in liftA2 (:) (fmap toUpper g) (Q.listOf g)++instance Arbitrary (Language (Set Text)) where+    arbitrary = Q.sized (genLanguage genWordQ)+    shrink (Word _) = []+    shrink (Concat _ lang1 lang2) = [lang1,lang2] ++ [x <>   y | (x,y) <- shrink (lang1,lang2)]+    shrink (Choice _ lang1 lang2) = [lang1,lang2] ++ [x <||> y | (x,y) <- shrink (lang1,lang2)]++-- maximum word length+maxWord :: Language (Set Text) -> Int+maxWord = Set.foldl' (\imum w -> max imum (T.length w)) 0 . allWords++-- ** checking the behaviour of parsers++genParser :: MonadParsec Void Text p => Language x -> p Text+genParser (Word txt) = chunk (fromString txt)+genParser (Choice _ x y) = try (genParser x) <|> genParser y -- backtracking choice+genParser (Concat _ x y) = liftA2 (<>) (genParser x) (genParser y)++-- Tests whether 'genParser' accepts all words generated by 'genWords'.+-- This can take loooong if the language is large.+prop_AcceptsAllWords :: WhichParser -> Language (Set Text)-> Bool+prop_AcceptsAllWords which lang = all acceptsWord (allWords lang) where+    acceptsWord :: Text -> Bool+    acceptsWord w = isJust (case which of+        Ordinary -> rightToMaybe (runParser (genParser lang <* eof :: Parsec Void Text Text) "test word" w)+        Fast     -> simpleParse             (genParser lang <* eof)                                      w)++-- generates random words of the language and checks whether +-- the language parser accepts the word.+prop_AcceptsLang :: WhichParser -> Language (Set Text) -> Q.Property+prop_AcceptsLang which lang = let +    parseWord = case which of+        Ordinary -> rightToMaybe . runParser (genParser lang <* eof :: Parsec Void Text Text) "test word"+        Fast     -> simpleParse              (genParser lang <* eof)+    in Q.forAll (genWords lang) (\w -> isJust (parseWord w))++-- generates random words +-- and checks whether both the fast and ordinary parsers +-- accept them or not. +prop_AcceptSameWords :: Language (Set Text) -> Q.Property+prop_AcceptSameWords lang = let+    p1 = rightToMaybe . runParser (genParser lang :: Parsec Void Text Text) "test word"+    p2 = simpleParse              (genParser lang)+    maxLen = maxWord lang+    in Q.forAll (fmap fromString (genWordQ `Q.suchThat` ((maxLen >=).length))) +        (\w -> isJust (p1 w) Q.=== isJust (p2 w))++-- * Testing the MonadParsec primitives++rightToMaybe :: Either a b -> Maybe b+rightToMaybe = either (const Nothing) Just ++simpleParse :: SimpleParser s a -> s -> Maybe a+simpleParse p = fmap fst . runSimpleParser p++type GenericParser a = forall p. MonadParsec Void Text p => p a++behaveEquallyOn :: forall a. (Show a, Eq a) => GenericParser a -> Text -> Q.Property+behaveEquallyOn p = let+    run1 = rightToMaybe . runParser (p :: Parsec Void Text a) "input"+    run2 = simpleParse p+    in \input -> run1 input Q.=== run2 input++genShortText :: Q.Gen Text+genShortText = Q.sized gen where +    gen size = if size <= 0 +        then fmap T.singleton genAlphaChar +        else let size' = size `div` 2 in liftA2 (<>) (gen size') (gen size')++{--+newtype AlphaText = Alpha {getAlpha :: Text}+instance Arbitrary AlphaText where+    arbitrary = fmap Alpha genShortText+    shrink = const [Alpha mempty]+--}++prop_LookAhead :: Q.Property+prop_LookAhead = Q.forAll genShortText $ \needle -> +    Q.forAll genShortText $ \haystack -> +        lookAhead (chunk needle) `behaveEquallyOn` haystack++prop_takeWhileP :: Q.Property+prop_takeWhileP = Q.forAllBlind arbitrary $ \predicate -> +    Q.forAll genShortText $ \input -> +        (takeWhileP Nothing predicate) `behaveEquallyOn` input++prop_takeWhile1P :: Q.Property+prop_takeWhile1P = Q.forAllBlind arbitrary $ \predicate -> +    Q.forAll genShortText $ \input -> +        (takeWhile1P Nothing predicate) `behaveEquallyOn` input++prop_takeP :: Q.Property+prop_takeP = Q.forAll arbitrary $ \len -> +    Q.forAll genShortText $ \input -> +        (takeP Nothing len) `behaveEquallyOn` input