grammatical-parsers 0.5 → 0.5.1

raw patch · 17 files changed

+288/−55 lines, 17 filesdep +witherable-classdep −bytestringdep ~input-parsersdep ~monoid-subclassesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: witherable-class

Dependencies removed: bytestring

Dependency ranges changed: input-parsers, monoid-subclasses

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−0
• grammatical-parsers.cabal +8/−8
• src/Text/Grampa/Class.hs +5/−1
• src/Text/Grampa/ContextFree/Continued.hs +18/−1
• src/Text/Grampa/ContextFree/Continued/Measured.hs +13/−1
• src/Text/Grampa/ContextFree/LeftRecursive.hs +24/−7
• src/Text/Grampa/ContextFree/LeftRecursive/Transformer.hs +10/−4
• src/Text/Grampa/ContextFree/Memoizing.hs +19/−1
• src/Text/Grampa/ContextFree/Parallel.hs +17/−1
• src/Text/Grampa/ContextFree/SortedMemoizing.hs +9/−1
• src/Text/Grampa/ContextFree/SortedMemoizing/Transformer.hs +51/−10
• src/Text/Grampa/Internal.hs +32/−3
• src/Text/Grampa/PEG/Backtrack.hs +14/−1
• src/Text/Grampa/PEG/Backtrack/Measured.hs +14/−1
• src/Text/Grampa/PEG/Continued.hs +18/−1
• src/Text/Grampa/PEG/Continued/Measured.hs +14/−13
• src/Text/Grampa/PEG/Packrat.hs +14/−1

@@ -1,3 +1,11 @@+Version 0.5.1+---------------+* Fixed the `skipAll` implementation for the `SortedMemoizing.Transformer` parser+* Added the `Filterable` and `MonadFail` instances to all parser types+* Added instances `Monad Ambiguous` and `Functor ParseFailure`+* Generalized the types of `LeftRecursive.Transformer.tmap` and `tbind`+* Incremented dependencies' upper bounds+ Version 0.5 --------------- * Replaced `MonoidParsing` by `InputParsing`

@@ -1,5 +1,5 @@ name:                grammatical-parsers-version:             0.5+version:             0.5.1 synopsis:            parsers that combine into grammars description:   /Gram/matical-/pa/rsers, or Grampa for short, is a library of parser types whose values are meant to be assigned@@ -44,13 +44,13 @@   default-language:    Haskell2010   ghc-options:         -Wall   build-depends:       base >=4.9 && <5,-                       bytestring >= 0.10 && < 0.11,                        containers >= 0.4 && < 0.7,                        transformers >= 0.5 && < 0.6,-                       monoid-subclasses >=1.0 && <1.1,+                       monoid-subclasses >=1.0 && <1.2,                        parsers < 0.13,-                       input-parsers < 0.2,+                       input-parsers < 0.3,                        attoparsec >= 0.13 && < 0.14,+                       witherable-class < 0.1,                        rank2classes >= 1.0.2 && < 1.5  executable             arithmetic@@ -61,7 +61,7 @@   build-depends:       base >=4.9 && <5, containers >= 0.5.7.0 && < 0.7,                        parsers < 0.13,                        rank2classes >= 1.0.2 && < 1.5, grammatical-parsers,-                       monoid-subclasses >=1.0 && <1.1+                       monoid-subclasses >=1.0 && <1.2  executable             boolean-transformations   hs-source-dirs:      examples@@ -71,14 +71,14 @@   build-depends:       base >=4.9 && <5, containers >= 0.5.7.0 && < 0.7,                        parsers < 0.13,                        rank2classes >= 1.0.2 && < 1.5, grammatical-parsers,-                       monoid-subclasses >=1.0 && <1.1+                       monoid-subclasses >=1.0 && <1.2  test-suite           quicktests   type:              exitcode-stdio-1.0   hs-source-dirs:    test, examples   x-uses-tf:         true   build-depends:     base >=4.9 && < 5, containers >= 0.5.7.0 && < 0.7,-                     monoid-subclasses < 1.1, parsers < 0.13,+                     monoid-subclasses < 1.2, parsers < 0.13,                      rank2classes >= 1.0.2 && < 1.5, grammatical-parsers,                      QuickCheck >= 2 && < 3, checkers >= 0.4.6 && < 0.6, size-based < 0.2,                      testing-feat >= 1.1 && < 1.2,@@ -103,7 +103,7 @@   hs-source-dirs:    test, examples   ghc-options:       -O2 -Wall -rtsopts -main-is Benchmark.main   Build-Depends:     base >=4.9 && < 5, rank2classes >= 1.0.2 && < 1.5, grammatical-parsers,-                     monoid-subclasses >=1.0 && <1.1, parsers < 0.13,+                     monoid-subclasses >=1.0 && <1.2, parsers < 0.13,                      criterion >= 1.0, deepseq >= 1.1, containers >= 0.5.7.0 && < 0.7, text >= 1.1   main-is:           Benchmark.hs   other-modules:     Main, Arithmetic, Boolean, Combined, Comparisons, Conditionals, Lambda, Utilities

@@ -34,7 +34,7 @@ type ParseResults s = Either (ParseFailure s)  -- | A 'ParseFailure' contains the offset of the parse failure and the list of things expected at that offset.-data ParseFailure s = ParseFailure Int [Expected s] deriving (Eq, Show)+data ParseFailure s = ParseFailure Int [Expected s] deriving (Eq, Functor, Show) data Expected s = Expected String                 | ExpectedInput s                 deriving (Functor, Eq, Ord, Read, Show)@@ -54,6 +54,10 @@ instance Applicative Ambiguous where    pure a = Ambiguous (pure a)    Ambiguous f <*> Ambiguous a = Ambiguous (f <*> a)++instance Monad Ambiguous where+   return = pure+   Ambiguous a >>= f = Ambiguous (a >>= getAmbiguous . f)  instance Foldable Ambiguous where    foldMap f (Ambiguous a) = foldMap f a

@@ -3,7 +3,7 @@ module Text.Grampa.ContextFree.Continued (Parser(..), Result(..), alt) where  import Control.Applicative (Applicative(..), Alternative(..), liftA2)-import Control.Monad (Monad(..), MonadPlus(..))+import Control.Monad (Monad(..), MonadFail(fail), MonadPlus(..))  import Data.Functor.Classes (Show1(..)) import Data.Functor.Compose (Compose(..))@@ -13,6 +13,7 @@ import Data.Monoid.Factorial(FactorialMonoid) import Data.Monoid.Textual(TextualMonoid) import Data.String (fromString)+import Data.Witherable.Class (Filterable(mapMaybe))  import qualified Data.Monoid.Factorial as Factorial import qualified Data.Monoid.Null as Null@@ -70,12 +71,28 @@       where success' a rest' _ = success a rest' failure'             failure' f1 = q rest success (\f2 -> failure (f1 <> f2)) +instance Factorial.FactorialMonoid s => Filterable (Result g s) where+   mapMaybe f (Parsed a rest) =+      maybe (NoParse $ FailureInfo (Factorial.length rest) [Expected "filter"]) (`Parsed` rest) (f a)+   mapMaybe _ (NoParse failure) = NoParse failure+   +instance Factorial.FactorialMonoid s => Filterable (Parser g s) where+   mapMaybe :: forall a b. (a -> Maybe b) -> Parser g s a -> Parser g s b+   mapMaybe f (Parser p) = Parser q where+      q :: forall x. s -> (b -> s -> (FailureInfo s -> x) -> x) -> (FailureInfo s -> x) -> x+      q rest success failure = p rest (maybe filterFailure success . f) failure+         where filterFailure _ _ = failure (FailureInfo (Factorial.length rest) [Expected "filter"])+   {-# INLINABLE mapMaybe #-}+ instance Monad (Parser g s) where    return = pure    (>>=) :: forall a b. Parser g s a -> (a -> Parser g s b) -> Parser g s b    Parser p >>= f = Parser r where       r :: forall x. s -> (b -> s -> (FailureInfo s -> x) -> x) -> (FailureInfo s -> x) -> x       r rest success failure = p rest (\a rest'-> applyParser (f a) rest' success) failure++instance Factorial.FactorialMonoid s => MonadFail (Parser g s) where+   fail msg = Parser (\rest _ failure-> failure $ FailureInfo (Factorial.length rest) [Expected msg])  instance Factorial.FactorialMonoid s => MonadPlus (Parser g s) where    mzero = empty

@@ -3,7 +3,7 @@ module Text.Grampa.ContextFree.Continued.Measured (Parser(..), Result(..), alt) where  import Control.Applicative (Applicative(..), Alternative(..), liftA2)-import Control.Monad (Monad(..), MonadPlus(..))+import Control.Monad (Monad(..), MonadFail(fail), MonadPlus(..))  import Data.Functor.Classes (Show1(..)) import Data.Functor.Compose (Compose(..))@@ -13,6 +13,7 @@ import Data.Monoid.Factorial(FactorialMonoid) import Data.Monoid.Textual(TextualMonoid) import Data.String (fromString)+import Data.Witherable.Class (Filterable(mapMaybe))  import qualified Data.Monoid.Factorial as Factorial import qualified Data.Monoid.Null as Null@@ -70,6 +71,14 @@       where success' a len rest' _ = success a len rest' failure'             failure' f1 = q rest success (\f2 -> failure (f1 <> f2)) +instance Factorial.FactorialMonoid s => Filterable (Parser g s) where+   mapMaybe :: forall a b. (a -> Maybe b) -> Parser g s a -> Parser g s b+   mapMaybe f (Parser p) = Parser q where+      q :: forall x. s -> (b -> Int -> s -> (FailureInfo s -> x) -> x) -> (FailureInfo s -> x) -> x+      q rest success failure = p rest (maybe filterFailure success . f) failure+         where filterFailure _ _ _ = failure (FailureInfo (Factorial.length rest) [Expected "filter"])+   {-# INLINABLE mapMaybe #-}+ instance Monad (Parser g s) where    return = pure    (>>=) :: forall a b. Parser g s a -> (a -> Parser g s b) -> Parser g s b@@ -78,6 +87,9 @@       r rest success failure = p rest                                  (\a len rest'-> applyParser (f a) rest' $ \b len'-> success b $! len + len')                                  failure++instance Factorial.FactorialMonoid s => MonadFail (Parser g s) where+   fail msg = Parser (\rest _ failure-> failure $ FailureInfo (Factorial.length rest) [Expected msg])  instance Factorial.FactorialMonoid s => MonadPlus (Parser g s) where    mzero = empty

@@ -9,7 +9,7 @@ where  import Control.Applicative-import Control.Monad (Monad(..), MonadPlus(..), void)+import Control.Monad (Monad(..), MonadFail(fail), MonadPlus(..), void) import Control.Monad.Trans.State.Lazy (State, evalState, get, put)  import Data.Functor.Compose (Compose(..))@@ -25,6 +25,7 @@ import qualified Data.Monoid.Textual as Textual import Data.String (fromString) import Data.Type.Equality ((:~:)(Refl))+import Data.Witherable.Class (Filterable(mapMaybe))  import qualified Text.Parser.Char as Char import Text.Parser.Char (CharParsing)@@ -36,7 +37,8 @@                           AmbiguousParsing(..), Ambiguous(..),                           ConsumedInputParsing(..), DeterministicParsing(..),                           TailsParsing(parseTails, parseAllTails), Expected(..))-import Text.Grampa.Internal (ResultList(..), FailureInfo(..), AmbiguousAlternative(ambiguousOr))+import Text.Grampa.Internal (ResultList(..), FailureInfo(..),+                             AmbiguousAlternative(ambiguousOr), AmbiguityDecidable(..), AmbiguityWitness(..)) import qualified Text.Grampa.ContextFree.SortedMemoizing as Memoizing import qualified Text.Grampa.PEG.Backtrack.Measured as Backtrack @@ -57,9 +59,6 @@    | PositiveDirectParser {       complete :: p g s a} -data AmbiguityWitness a where-   AmbiguityWitness :: (a :~: Ambiguous b) -> AmbiguityWitness a- data SeparatedParser p (g :: (* -> *) -> *) s a = FrontParser (p g s a)                                                 | CycleParser {                                                      cycleParser  :: p g s a,@@ -90,13 +89,13 @@    mempty = Union (Rank2.cotraverse (Const . getConst) (Const False))    mappend (Union g1) (Union g2) = Union (Rank2.liftA2 union g1 g2) -mapPrimitive :: (p g s a -> p g s a) -> Fixed p g s a -> Fixed p g s a+mapPrimitive :: forall p g s a b. AmbiguityDecidable b => (p g s a -> p g s b) -> Fixed p g s a -> Fixed p g s b mapPrimitive f p@PositiveDirectParser{} = PositiveDirectParser{complete= f (complete p)} mapPrimitive f p@DirectParser{} = DirectParser{complete= f (complete p),                                                direct0= f (direct0 p),                                                direct1= f (direct1 p)} mapPrimitive f p@Parser{} = Parser{complete= f (complete p),-                                   isAmbiguous= isAmbiguous p,+                                   isAmbiguous= ambiguityWitness @b,                                    cyclicDescendants= cyclicDescendants p,                                    indirect= f (indirect p),                                    direct= f (direct p),@@ -326,6 +325,21 @@    {-# INLINABLE many #-}    {-# INLINABLE some #-} +instance Filterable (p g s) => Filterable (Fixed p g s) where+   mapMaybe f (PositiveDirectParser p) = PositiveDirectParser (mapMaybe f p)+   mapMaybe f p@DirectParser{} = DirectParser{+      complete= mapMaybe f (complete p),+      direct0= mapMaybe f (direct0 p),+      direct1= mapMaybe f (direct1 p)}+   mapMaybe f p@Parser{} = p{+      complete= mapMaybe f (complete p),+      direct= mapMaybe f (direct p),+      direct0= mapMaybe f (direct0 p),+      direct1= mapMaybe f (direct1 p),+      indirect= mapMaybe f (indirect p),+      isAmbiguous= Nothing}+   {-# INLINABLE mapMaybe #-}+ union :: Const Bool x -> Const Bool x -> Const Bool x union (Const False) d = d union (Const True) _ = Const True@@ -359,6 +373,9 @@       where d0 = direct0 p >>= direct0 . general' . cont             d1 = (direct0 p >>= direct1 . general' . cont) <|> (direct1 p >>= complete . cont)             p'@Parser{} = general' p++instance (Alternative (p g s), MonadFail (p g s)) => MonadFail (Fixed p g s) where+   fail msg = PositiveDirectParser{complete= fail msg}  instance MonadPlus (p g s) => MonadPlus (Fixed p g s) where    mzero = empty

@@ -1,5 +1,6 @@-module Text.Grampa.ContextFree.LeftRecursive.Transformer (ParserT, SeparatedParser(..),-                                                          lift, liftPositive, tmap,+{-# Language GADTs #-}+module Text.Grampa.ContextFree.LeftRecursive.Transformer (ParserT, SeparatedParser(..), AmbiguityDecidable,+                                                          lift, liftPositive, tbind, tmap,                                                           parseSeparated, separated) where @@ -7,6 +8,7 @@                                               liftPositive, liftPure, mapPrimitive, parseSeparated, separated) import qualified Text.Grampa.ContextFree.SortedMemoizing.Transformer as Transformer import Text.Grampa.ContextFree.SortedMemoizing.Transformer (ResultListT(ResultList), FailureInfo(FailureInfo))+import Text.Grampa.Internal (AmbiguityDecidable)  type ParserT m = Fixed (Transformer.ParserT m) @@ -14,8 +16,12 @@ lift :: Applicative m => m a -> ParserT m g s a lift = liftPure . Transformer.lift --- | Modify the computation carried by the parser.-tmap :: (m a -> m a) -> ParserT m g s a -> ParserT m g s a+-- | Transform the computation carried by the parser using the monadic bind ('>>=').+tbind :: (Monad m, AmbiguityDecidable b) => ParserT m g s a -> (a -> m b) -> ParserT m g s b+tbind p f = mapPrimitive (`Transformer.tbind` f) p++-- | Transform the computation carried by the parser.+tmap :: AmbiguityDecidable b => (m a -> m b) -> ParserT m g s a -> ParserT m g s b tmap = mapPrimitive . Transformer.tmap  instance FallibleWithExpectations (ResultListT m g) where

@@ -5,7 +5,7 @@ where  import Control.Applicative-import Control.Monad (Monad(..), MonadPlus(..))+import Control.Monad (Monad(..), MonadFail(fail), MonadPlus(..)) import Data.Function (on) import Data.Foldable (toList) import Data.Functor.Classes (Show1(..))@@ -20,6 +20,7 @@ import Data.Semigroup (Semigroup((<>))) import Data.Semigroup.Cancellative (LeftReductive(isPrefixOf)) import Data.String (fromString)+import Data.Witherable.Class (Filterable(mapMaybe))  import qualified Text.Parser.Char import Text.Parser.Char (CharParsing)@@ -56,9 +57,18 @@ instance Functor (ResultInfo g s) where    fmap f (ResultInfo l t r) = ResultInfo l t (f r) +instance Foldable (ResultInfo g s) where+   foldMap f (ResultInfo _ _ r) = f r++instance Traversable (ResultInfo g s) where+   traverse f (ResultInfo l t r) = ResultInfo l t <$> f r+ instance Functor (ResultList g s) where    fmap f (ResultList l failure) = ResultList ((f <$>) <$> l) failure +instance Filterable (ResultList g s) where+   mapMaybe f (ResultList l failure) = ResultList (mapMaybe (traverse f) l) failure+ instance Semigroup (ResultList g s r) where    ResultList rl1 f1 <> ResultList rl2 f2 = ResultList (rl1 <> rl2) (f1 <> f2) @@ -87,6 +97,10 @@       r rest = p rest <> q rest    {-# INLINABLE (<|>) #-} +instance Filterable (Parser g i) where+   mapMaybe f (Parser p) = Parser (mapMaybe f . p)+   {-# INLINABLE mapMaybe #-}+ instance Monad (Parser g i) where    return = pure    Parser p >>= f = Parser q where@@ -95,6 +109,10 @@       continue (ResultInfo l rest' a) = continue' l (applyParser (f a) rest')       continue' l (ResultList rs failure) = ResultList (adjust l <$> rs) failure       adjust l (ResultInfo l' rest' a) = ResultInfo (l+l') rest' a++instance MonadFail (Parser g s) where+   fail msg = Parser p+      where p rest = ResultList mempty (FailureInfo (genericLength rest) [Expected msg])  instance MonadPlus (Parser g s) where    mzero = empty

@@ -4,7 +4,7 @@ where  import Control.Applicative-import Control.Monad (Monad(..), MonadPlus(..))+import Control.Monad (Monad(..), MonadFail(fail), MonadPlus(..)) import Data.Foldable (toList) import Data.Functor.Classes (Show1(..)) import Data.Functor.Compose (Compose(..))@@ -19,6 +19,7 @@ import qualified Data.Monoid.Factorial as Factorial import qualified Data.Monoid.Textual as Textual import Data.String (fromString)+import Data.Witherable.Class (Filterable(mapMaybe))  import qualified Text.Parser.Char import Text.Parser.Char (CharParsing)@@ -53,6 +54,15 @@ instance Functor (ResultInfo s) where    fmap f (ResultInfo s r) = ResultInfo s (f r) +instance Foldable (ResultInfo s) where+   foldMap f (ResultInfo _ r) = f r++instance Traversable (ResultInfo s) where+   traverse f (ResultInfo s r) = ResultInfo s <$> f r++instance Filterable (ResultList s) where+   mapMaybe f (ResultList l failure) = ResultList (mapMaybe (traverse f) l) failure+ instance Functor (ResultList s) where    fmap f (ResultList l failure) = ResultList ((f <$>) <$> l) failure @@ -79,12 +89,18 @@    Parser p <|> Parser q = Parser r where       r rest = p rest <> q rest +instance FactorialMonoid s => Filterable (Parser g s) where+   mapMaybe f (Parser p) = Parser (mapMaybe f . p)+ instance Monad (Parser g s) where    return = pure    Parser p >>= f = Parser q where       q rest = case p rest                of ResultList results failure -> ResultList mempty failure <> foldMap continue results       continue (ResultInfo rest' a) = applyParser (f a) rest'++instance FactorialMonoid s => MonadFail (Parser g s) where+   fail msg = Parser (\s-> ResultList mempty $ FailureInfo (Factorial.length s) [Expected msg])  instance FactorialMonoid s => MonadPlus (Parser g s) where    mzero = empty

@@ -6,7 +6,7 @@ where  import Control.Applicative-import Control.Monad (Monad(..), MonadPlus(..))+import Control.Monad (Monad(..), MonadFail(fail), MonadPlus(..)) import Data.Functor.Compose (Compose(..)) import Data.List (genericLength) import Data.List.NonEmpty (NonEmpty((:|)))@@ -19,6 +19,7 @@ import Data.Semigroup (Semigroup((<>))) import Data.Semigroup.Cancellative (LeftReductive(isPrefixOf)) import Data.String (fromString)+import Data.Witherable.Class (Filterable(mapMaybe))  import qualified Text.Parser.Char import Text.Parser.Char (CharParsing)@@ -62,6 +63,9 @@    {-# INLINE (<|>) #-}    {-# INLINABLE empty #-} +instance Filterable (Parser g i) where+  mapMaybe f (Parser p) = Parser (mapMaybe f . p)+ instance Monad (Parser g i) where    return = pure    (>>) = (*>)@@ -71,6 +75,10 @@       continue (ResultsOfLength l rest' rs) = foldMap (continue' l . flip applyParser rest' . f) rs       continue' l (ResultList rs failure) = ResultList (adjust l <$> rs) failure       adjust l (ResultsOfLength l' rest' rs) = ResultsOfLength (l+l') rest' rs++instance MonadFail (Parser g s) where+   fail msg = Parser p+      where p rest = ResultList mempty (FailureInfo (genericLength rest) [Expected msg])  instance MonadPlus (Parser g s) where    mzero = empty

@@ -1,17 +1,19 @@-{-# LANGUAGE BangPatterns, FlexibleContexts, GeneralizedNewtypeDeriving, InstanceSigs,+{-# LANGUAGE BangPatterns, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, InstanceSigs,              RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-} module Text.Grampa.ContextFree.SortedMemoizing.Transformer        (FailureInfo(..), ResultListT(..), ParserT(..), (<<|>),-        lift, tmap, longest, peg, terminalPEG)+        tbind, lift, tmap, longest, peg, terminalPEG) where  import Control.Applicative-import Control.Monad (MonadPlus(..), join, void)+import Control.Monad (MonadFail(fail), MonadPlus(..), join, void)+import qualified Control.Monad.Trans.Class as Trans (lift)+import Control.Monad.Trans.State.Strict (StateT, evalStateT) import Data.Function (on) import Data.Functor.Compose (Compose(..)) import Data.Functor.Identity (Identity(..)) import Data.List (genericLength, nub)-import Data.List.NonEmpty (NonEmpty((:|)), groupBy, fromList, toList)+import Data.List.NonEmpty (NonEmpty((:|)), groupBy, nonEmpty, fromList, toList) import Data.Monoid.Null (MonoidNull(null)) import Data.Monoid.Factorial (FactorialMonoid, splitPrimePrefix) import Data.Monoid.Textual (TextualMonoid)@@ -19,6 +21,7 @@ import qualified Data.Monoid.Textual as Textual import Data.Semigroup.Cancellative (LeftReductive(isPrefixOf)) import Data.String (fromString)+import Data.Witherable.Class (Filterable(mapMaybe))  import qualified Text.Parser.Char import Text.Parser.Char (CharParsing)@@ -70,6 +73,13 @@    {-# INLINE (<|>) #-}    {-# INLINABLE empty #-} +instance (Applicative m, Traversable m) => Filterable (ParserT m g s) where+  mapMaybe f (Parser p) = Parser (mapMaybe f . p)++-- | The 'StateT' instance dangerously assumes that the filtered parser is stateless.+instance {-# overlaps #-} (Monad m, Traversable m, Monoid state) => Filterable (ParserT (StateT state m) g s) where+  mapMaybe f (Parser p) = Parser (mapMaybe f . p)+ instance (Monad m, Traversable m) => Monad (ParserT m g s) where    return = pure    (>>) = (*>)@@ -86,6 +96,10 @@       rejoinResults m = ResultList (fmap rejoinResultsOfLengthT $ sequence $ resultSuccesses <$> m) (foldMap resultFailures m)       rejoinResultsOfLengthT m = ResultsOfLengthT (join <$> traverse getResultsOfLength m) +instance (Monad m, Traversable m) => MonadFail (ParserT m g s) where+   fail msg = Parser p+      where p rest = ResultList mempty (FailureInfo (genericLength rest) [Expected msg])+ instance (Foldable m, Monad m, Traversable m) => MonadPlus (ParserT m g s) where    mzero = empty    mplus = (<|>)@@ -94,13 +108,23 @@ lift :: m a -> ParserT m g s a lift m = Parser (\rest-> ResultList [ResultsOfLengthT $ ROL 0 rest (m:|[])] mempty) --- | Modify the computation carried by the parser.+-- | Transform the computation carried by the parser using the monadic bind ('>>=').+tbind :: Monad m => ParserT m g s a -> (a -> m b) -> ParserT m g s b+tbind (Parser p) f = Parser (bindResultList f . p)++-- | Transform the computation carried by the parser. tmap :: (m a -> m b) -> ParserT m g s a -> ParserT m g s b tmap f (Parser p) = Parser (mapResultList f . p) +bindResultList :: Monad m => (a -> m b) -> ResultListT m g s a -> ResultListT m g s b+bindResultList f (ResultList successes failures) = ResultList (bindResults f <$> successes) failures+ mapResultList :: (m a -> m b) -> ResultListT m g s a -> ResultListT m g s b mapResultList f (ResultList successes failures) = ResultList (mapResults f <$> successes) failures +bindResults :: Monad m => (a -> m b) -> ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b+bindResults f (ResultsOfLengthT (ROL len rest as)) = ResultsOfLengthT (ROL len rest ((>>= f) <$> as))+ mapResults :: (m a -> m b) -> ResultsOfLengthT m g s a -> ResultsOfLengthT m g s b mapResults f (ResultsOfLengthT rol) = ResultsOfLengthT (f <$> rol) @@ -272,11 +296,12 @@                            ResultList rl _ -> foldMap continue rl          where continue (ResultsOfLengthT (ROL len' rest' results)) =                   foldMap (\r-> q (len + len') (liftA2 (.) acc ((:) <$> r)) rest') results-   skipAll (Parser p) = Parser (q 0) where-      q !len rest = case p rest-                    of ResultList [] _failure -> singleResult len rest ()-                       ResultList rl _failure -> foldMap continue rl-         where continue (ResultsOfLengthT (ROL len' rest' _)) = q (len + len') rest'+   skipAll (Parser p) = Parser (q 0 (pure ())) where+      q !len effects rest = case p rest+                       of ResultList [] _failure -> ResultList [ResultsOfLengthT $ ROL len rest (effects:|[])] mempty+                          ResultList rl _failure -> foldMap continue rl+         where continue (ResultsOfLengthT (ROL len' rest' results)) =+                  foldMap (\r-> q (len + len') (effects <* r) rest') results  instance (Applicative m, MonoidNull s) => LookAheadParsing (ParserT m g s) where    lookAhead (Parser p) = Parser (\input-> rewind input (p input))@@ -379,6 +404,22 @@                | l1 > l2 = rol2 : merge rl1' rest2                | otherwise = ResultsOfLengthT (ROL l1 s1 $ liftA2 (liftA2 collect) r1 r2) : merge rest1 rest2             collect (Ambiguous xs) (Ambiguous ys) = Ambiguous (xs <> ys)++instance Traversable m => Filterable (ResultListT m g s) where+   mapMaybe :: forall a b. (a -> Maybe b) -> ResultListT m g s a -> ResultListT m g s b+   mapMaybe f (ResultList rs failure) = ResultList (mapMaybe filterResults rs) failure+      where filterResults :: ResultsOfLengthT m g s a -> Maybe (ResultsOfLengthT m g s b)+            filterResults (ResultsOfLengthT (ROL l t as)) =+               ResultsOfLengthT . ROL l t <$> nonEmpty (mapMaybe (traverse f) $ toList as)++instance {-# overlaps #-} (Monad m, Traversable m, Monoid state) => Filterable (ResultListT (StateT state m) g s) where+   mapMaybe :: forall a b. (a -> Maybe b) -> ResultListT (StateT state m) g s a -> ResultListT (StateT state m) g s b+   mapMaybe f (ResultList rs failure) = ResultList (mapMaybe filterResults rs) failure+      where filterResults :: ResultsOfLengthT (StateT state m) g s a -> Maybe (ResultsOfLengthT (StateT state m) g s b)+            filterResults (ResultsOfLengthT (ROL l t as)) =+               ResultsOfLengthT . ROL l t <$> nonEmpty (mapMaybe traverseWithMonoid $ toList as)+            traverseWithMonoid :: StateT state m a -> Maybe (StateT state m b)+            traverseWithMonoid m = Trans.lift <$> traverse f (evalStateT m mempty)  instance Semigroup (ResultListT m g s r) where    ResultList rl1 f1 <> ResultList rl2 f2 = ResultList (merge rl1 rl2) (f1 <> f2)

@@ -1,16 +1,18 @@-{-# LANGUAGE FlexibleInstances, RankNTypes #-}+{-# LANGUAGE FlexibleInstances, GADTs, RankNTypes, TypeOperators #-}  module Text.Grampa.Internal (BinTree(..), FailureInfo(..), ResultList(..), ResultsOfLength(..),-                             AmbiguousAlternative(..),+                             AmbiguousAlternative(..), AmbiguityDecidable(..), AmbiguityWitness(..),                              fromResultList, noFailure) where  import Control.Applicative (Applicative(..), Alternative(..)) import Data.Foldable (toList) import Data.Functor.Classes (Show1(..))-import Data.List.NonEmpty (NonEmpty)+import Data.List.NonEmpty (NonEmpty, nonEmpty) import Data.List (nub) import Data.Monoid (Monoid(mappend, mempty)) import Data.Semigroup (Semigroup((<>)))+import Data.Type.Equality ((:~:)(Refl))+import Data.Witherable.Class (Filterable(mapMaybe))  import Data.Monoid.Factorial (FactorialMonoid, length) @@ -29,6 +31,18 @@                | EmptyTree                deriving (Show) +data AmbiguityWitness a where+   AmbiguityWitness :: (a :~: Ambiguous b) -> AmbiguityWitness a++class AmbiguityDecidable a where+   ambiguityWitness :: Maybe (AmbiguityWitness a)++instance {-# overlappable #-} AmbiguityDecidable a where+   ambiguityWitness = Nothing++instance AmbiguityDecidable (Ambiguous a) where+   ambiguityWitness = Just (AmbiguityWitness Refl)+ fromResultList :: (Eq s, FactorialMonoid s) => s -> ResultList g s r -> ParseResults s [(s, r)] fromResultList s (ResultList [] (FailureInfo pos msgs)) =    Left (ParseFailure (length s - pos + 1) (nub msgs))@@ -81,6 +95,11 @@    empty = ResultList mempty mempty    (<|>) = (<>) +instance Filterable (ResultList g s) where+   mapMaybe f (ResultList l failure) = ResultList (mapMaybe maybeROL l) failure+      where maybeROL (ResultsOfLength l t rs) = ResultsOfLength l t <$> nonEmpty (mapMaybe f $ toList rs)+   {-# INLINE mapMaybe #-}+ instance Semigroup (ResultList g s r) where    ResultList rl1 f1 <> ResultList rl2 f2 = ResultList (merge rl1 rl2) (f1 <> f2)       where merge [] rl = rl@@ -116,6 +135,16 @@    foldMap f (Fork left right) = foldMap f left `mappend` foldMap f right    foldMap f (Leaf a) = f a    foldMap _ EmptyTree = mempty++instance Traversable BinTree where+   traverse f (Fork left right) = Fork <$> traverse f left <*> traverse f right+   traverse f (Leaf a) = Leaf <$> f a+   traverse _ EmptyTree = pure EmptyTree++instance Filterable BinTree where+   mapMaybe f (Fork left right) = mapMaybe f left <> mapMaybe f right+   mapMaybe f (Leaf a) = maybe EmptyTree Leaf (f a)+   mapMaybe _ EmptyTree = EmptyTree  instance Semigroup (BinTree a) where    EmptyTree <> t = t

@@ -3,7 +3,7 @@ module Text.Grampa.PEG.Backtrack (Parser(..), Result(..), alt) where  import Control.Applicative (Applicative(..), Alternative(..), liftA2)-import Control.Monad (Monad(..), MonadPlus(..))+import Control.Monad (Monad(..), MonadFail(fail), MonadPlus(..))  import Data.Functor.Classes (Show1(..)) import Data.Functor.Compose (Compose(..))@@ -13,6 +13,7 @@ import Data.Monoid.Factorial(FactorialMonoid) import Data.Monoid.Textual(TextualMonoid) import Data.String (fromString)+import Data.Witherable.Class (Filterable(mapMaybe))  import qualified Data.Monoid.Factorial as Factorial import qualified Data.Monoid.Null as Null@@ -44,6 +45,11 @@ instance Functor (Result g s) where    fmap f (Parsed a rest) = Parsed (f a) rest    fmap _ (NoParse failure) = NoParse failure++instance Factorial.FactorialMonoid s => Filterable (Result g s) where+   mapMaybe f (Parsed a rest) =+      maybe (NoParse $ FailureInfo (Factorial.length rest) [Expected "filter"]) (`Parsed` rest) (f a)+   mapMaybe _ (NoParse failure) = NoParse failure     instance Functor (Parser g s) where    fmap f (Parser p) = Parser (fmap f . p)@@ -67,6 +73,10 @@       r rest = case p rest                of x@Parsed{} -> x                   NoParse{} -> q rest+   +instance Factorial.FactorialMonoid s => Filterable (Parser g s) where+   mapMaybe f (Parser p) = Parser (mapMaybe f . p)+   {-# INLINABLE mapMaybe #-}  instance Monad (Parser g s) where    return = pure@@ -74,6 +84,9 @@       r rest = case p rest                of Parsed a rest' -> applyParser (f a) rest'                   NoParse failure -> NoParse failure++instance Factorial.FactorialMonoid s => MonadFail (Parser g s) where+   fail msg = Parser (\rest-> NoParse $ FailureInfo (Factorial.length rest) [Expected msg])  instance Factorial.FactorialMonoid s => MonadPlus (Parser g s) where    mzero = empty

@@ -3,7 +3,7 @@ module Text.Grampa.PEG.Backtrack.Measured (Parser(..), Result(..), alt) where  import Control.Applicative (Applicative(..), Alternative(..), liftA2)-import Control.Monad (Monad(..), MonadPlus(..))+import Control.Monad (Monad(..), MonadFail(fail), MonadPlus(..))  import Data.Functor.Classes (Show1(..)) import Data.Functor.Compose (Compose(..))@@ -13,6 +13,7 @@ import Data.Monoid.Factorial(FactorialMonoid) import Data.Monoid.Textual(TextualMonoid) import Data.String (fromString)+import Data.Witherable.Class (Filterable(mapMaybe))  import qualified Data.Monoid.Factorial as Factorial import qualified Data.Monoid.Null as Null@@ -45,6 +46,11 @@ instance Functor (Result g s) where    fmap f (Parsed l a rest) = Parsed l (f a) rest    fmap _ (NoParse failure) = NoParse failure++instance Factorial.FactorialMonoid s => Filterable (Result g s) where+   mapMaybe f (Parsed l a rest) =+      maybe (NoParse $ FailureInfo (Factorial.length rest) [Expected "filter"]) (\b-> Parsed l b rest) (f a)+   mapMaybe _ (NoParse failure) = NoParse failure     instance Functor (Parser g s) where    fmap f (Parser p) = Parser (fmap f . p)@@ -70,6 +76,10 @@       r rest = case p rest                of x@Parsed{} -> x                   NoParse{} -> q rest+   +instance FactorialMonoid s => Filterable (Parser g s) where+   mapMaybe f (Parser p) = Parser (mapMaybe f . p)+   {-# INLINABLE mapMaybe #-}  instance Monad (Parser g s) where    return = pure@@ -79,6 +89,9 @@                                       of Parsed l' b rest'' -> Parsed (l+l') b rest''                                          NoParse failure -> NoParse failure                   NoParse failure -> NoParse failure++instance FactorialMonoid s => MonadFail (Parser g s) where+   fail msg = Parser (\rest-> NoParse $ FailureInfo (Factorial.length rest) [Expected msg])  instance FactorialMonoid s => MonadPlus (Parser g s) where    mzero = empty

@@ -3,7 +3,7 @@ module Text.Grampa.PEG.Continued (Parser(..), Result(..), alt) where  import Control.Applicative (Applicative(..), Alternative(..), liftA2)-import Control.Monad (Monad(..), MonadPlus(..))+import Control.Monad (Monad(..), MonadFail(fail), MonadPlus(..))  import Data.Functor.Classes (Show1(..)) import Data.Functor.Compose (Compose(..))@@ -14,6 +14,7 @@ import Data.Monoid.Factorial(FactorialMonoid) import Data.Monoid.Textual(TextualMonoid) import Data.String (fromString)+import Data.Witherable.Class (Filterable(mapMaybe))  import qualified Data.Monoid.Factorial as Factorial import qualified Data.Monoid.Null as Null@@ -45,6 +46,11 @@ instance Functor (Result g s) where    fmap f (Parsed a rest) = Parsed (f a) rest    fmap _ (NoParse failure) = NoParse failure++instance Factorial.FactorialMonoid s => Filterable (Result g s) where+   mapMaybe f (Parsed a rest) =+      maybe (NoParse $ FailureInfo (Factorial.length rest) [Expected "filter"]) (`Parsed` rest) (f a)+   mapMaybe _ (NoParse failure) = NoParse failure     instance Functor (Parser g s) where    fmap f (Parser p) = Parser (\input success-> p input (success . f))@@ -67,6 +73,14 @@ Parser p `alt` Parser q = Parser r where    r :: forall x. s -> (a -> s -> x) -> (FailureInfo s -> x) -> x    r rest success failure = p rest success (\f1-> q rest success $ \f2 -> failure (f1 <> f2))+   +instance Factorial.FactorialMonoid s => Filterable (Parser g s) where+   mapMaybe :: forall a b. (a -> Maybe b) -> Parser g s a -> Parser g s b+   mapMaybe f (Parser p) = Parser q where+      q :: forall x. s -> (b -> s -> x) -> (FailureInfo s -> x) -> x+      q rest success failure = p rest (maybe filterFailure success . f) failure+         where filterFailure _ = failure (FailureInfo (Factorial.length rest) [Expected "filter"])+   {-# INLINABLE mapMaybe #-}  instance Monad (Parser g s) where    return = pure@@ -74,6 +88,9 @@    Parser p >>= f = Parser r where       r :: forall x. s -> (b -> s -> x) -> (FailureInfo s -> x) -> x       r rest success failure = p rest (\a rest'-> applyParser (f a) rest' success failure) failure++instance FactorialMonoid s => MonadFail (Parser g s) where+   fail msg = Parser (\rest _ failure-> failure $ FailureInfo (Factorial.length rest) [Expected msg])  instance FactorialMonoid s => MonadPlus (Parser g s) where    mzero = empty

@@ -3,7 +3,7 @@ module Text.Grampa.PEG.Continued.Measured (Parser(..), Result(..), alt) where  import Control.Applicative (Applicative(..), Alternative(..), liftA2)-import Control.Monad (Monad(..), MonadPlus(..))+import Control.Monad (Monad(..), MonadFail(fail), MonadPlus(..))  import Data.Functor.Classes (Show1(..)) import Data.Functor.Compose (Compose(..))@@ -13,6 +13,7 @@ import Data.Monoid.Factorial(FactorialMonoid) import Data.Monoid.Textual(TextualMonoid) import Data.String (fromString)+import Data.Witherable.Class (Filterable(mapMaybe))  import Data.Semigroup.Cancellative (LeftReductive(stripPrefix)) import qualified Data.Monoid.Factorial as Factorial@@ -28,24 +29,13 @@ import Text.Grampa.Class (DeterministicParsing(..), InputParsing(..), InputCharParsing(..), ConsumedInputParsing(..),                           MultiParsing(..), ParseResults, ParseFailure(..), Expected(..)) import Text.Grampa.Internal (FailureInfo(..))--data Result (g :: (* -> *) -> *) s v = Parsed{parsedPrefix :: !v,-                                              parsedSuffix :: !s}-                                     | NoParse (FailureInfo s)+import Text.Grampa.PEG.Continued (Result(..))  -- | Parser type for Parsing Expression Grammars that uses a continuation-passing algorithm and keeps track of the -- parsed prefix length, fast for grammars in LL(1) class but with potentially exponential performance for longer -- ambiguous prefixes. newtype Parser (g :: (* -> *) -> *) s r =    Parser{applyParser :: forall x. s -> (r -> Int -> s -> x) -> (FailureInfo s -> x) -> x}--instance Show s => Show1 (Result g s) where-   liftShowsPrec showsPrecSub _showList prec Parsed{parsedPrefix= r} rest = "Parsed " ++ showsPrecSub prec r rest-   liftShowsPrec _showsPrec _showList _prec (NoParse f) rest = "NoParse " ++ shows f rest--instance Functor (Result g s) where-   fmap f (Parsed a rest) = Parsed (f a) rest-   fmap _ (NoParse failure) = NoParse failure     instance Functor (Parser g s) where    fmap f (Parser p) = Parser (\input success-> p input (success . f))@@ -68,6 +58,14 @@ Parser p `alt` Parser q = Parser r where    r :: forall x. s -> (a -> Int -> s -> x) -> (FailureInfo s -> x) -> x    r rest success failure = p rest success (\f1-> q rest success $ \f2 -> failure (f1 <> f2))+   +instance Factorial.FactorialMonoid s => Filterable (Parser g s) where+   mapMaybe :: forall a b. (a -> Maybe b) -> Parser g s a -> Parser g s b+   mapMaybe f (Parser p) = Parser q where+      q :: forall x. s -> (b -> Int -> s -> x) -> (FailureInfo s -> x) -> x+      q rest success failure = p rest (maybe filterFailure success . f) failure+         where filterFailure _ _ = failure (FailureInfo (Factorial.length rest) [Expected "filter"])+   {-# INLINABLE mapMaybe #-}  instance Monad (Parser g s) where    return = pure@@ -77,6 +75,9 @@       r rest success failure = p rest                                   (\a len rest'-> applyParser (f a) rest' (\b len'-> success b $! len + len') failure)                                  failure++instance FactorialMonoid s => MonadFail (Parser g s) where+   fail msg = Parser (\rest _ failure-> failure $ FailureInfo (Factorial.length rest) [Expected msg])  instance FactorialMonoid s => MonadPlus (Parser g s) where    mzero = empty

@@ -3,7 +3,7 @@ module Text.Grampa.PEG.Packrat (Parser(..), Result(..)) where  import Control.Applicative (Applicative(..), Alternative(..), liftA2)-import Control.Monad (Monad(..), MonadPlus(..))+import Control.Monad (Monad(..), MonadFail(fail), MonadPlus(..))  import Data.Functor.Classes (Show1(..)) import Data.Functor.Compose (Compose(..))@@ -14,6 +14,7 @@ import Data.Semigroup (Semigroup(..)) import Data.Semigroup.Cancellative (LeftReductive(isPrefixOf)) import Data.String (fromString)+import Data.Witherable.Class (Filterable(mapMaybe))  import qualified Data.Monoid.Factorial as Factorial import qualified Data.Monoid.Null as Null@@ -46,6 +47,11 @@ instance Functor (Result g s) where    fmap f (Parsed a rest) = Parsed (f a) rest    fmap _ (NoParse failure) = NoParse failure++instance Filterable (Result g s) where+   mapMaybe f (Parsed a rest) =+      maybe (NoParse $ FailureInfo (Factorial.length rest) [Expected "filter"]) (`Parsed` rest) (f a)+   mapMaybe _ (NoParse failure) = NoParse failure     instance Functor (Parser g s) where    fmap f (Parser p) = Parser (fmap f . p)@@ -63,6 +69,10 @@       r rest = case p rest                of x@Parsed{} -> x                   NoParse{} -> q rest+   +instance Filterable (Parser g s) where+   mapMaybe f (Parser p) = Parser (mapMaybe f . p)+   {-# INLINABLE mapMaybe #-}  instance Monad (Parser g s) where    return = pure@@ -74,6 +84,9 @@ instance MonadPlus (Parser g s) where    mzero = empty    mplus = (<|>)++instance MonadFail (Parser g s) where+   fail msg = Parser (\rest-> NoParse $ FailureInfo (genericLength rest) [Expected msg])  instance Semigroup x => Semigroup (Parser g s x) where    (<>) = liftA2 (<>)