packages feed

parser-combinators 1.2.1 → 1.3.0

raw patch · 10 files changed

+378/−285 lines, 10 filesdep ~base

Dependency ranges changed: base

Files

CHANGELOG.md view
@@ -1,3 +1,16 @@+## Parser combinators 1.3.0++* Changed the `Control.Applicative.Permutations` module to only require+  `Applicative` and not `Monad`. This module is the least restrictive and works+  with parsers which are not `Monad`s.++* Added the `Control.Monad.Permutations` module. This module may be+  substantially more efficient for some parsers which are `Monad`s.++* Corrected how permutation parsers intercalate effects and components; parsing+  an effect requires that a component immediately follows or else a parse error+  will result.+ ## Parser combinators 1.2.1  * The tests in `parser-combinators-tests` now work with Megaparsec 8.
Control/Applicative/Combinators.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE TupleSections #-}+ -- | -- Module      :  Control.Applicative.Combinators -- Copyright   :  © 2017–present Mark Karpov@@ -41,45 +44,42 @@ -- backtrack in order for the alternative branch of parsing to be tried. -- Thus it is the responsibility of the programmer to wrap more complex, -- composite parsers in @try@ to achieve correct behavior.--{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE TupleSections #-}- module Control.Applicative.Combinators   ( -- * Re-exports from "Control.Applicative"-    (<|>)+    (<|>),     -- $assocbo-  , many+    many,     -- $many-  , some+    some,     -- $some-  , optional+    optional,     -- $optional-  , empty+    empty,     -- $empty      -- * Original combinators-  , between-  , choice-  , count-  , count'-  , eitherP-  , endBy-  , endBy1-  , manyTill-  , manyTill_-  , someTill-  , someTill_-  , option-  , sepBy-  , sepBy1-  , sepEndBy-  , sepEndBy1-  , skipMany-  , skipSome-  , skipCount-  , skipManyTill-  , skipSomeTill )+    between,+    choice,+    count,+    count',+    eitherP,+    endBy,+    endBy1,+    manyTill,+    manyTill_,+    someTill,+    someTill_,+    option,+    sepBy,+    sepBy1,+    sepEndBy,+    sepEndBy1,+    skipMany,+    skipSome,+    skipCount,+    skipManyTill,+    skipSomeTill,+  ) where  import Control.Applicative@@ -132,7 +132,6 @@ -- Returns the value returned by @p@. -- -- > braces = between (symbol "{") (symbol "}")- between :: Applicative m => m open -> m close -> m a -> m a between open close p = open *> p <* close {-# INLINE between #-}@@ -141,7 +140,6 @@ -- until one of them succeeds. Returns the value of the succeeding parser. -- -- > choice = asum- choice :: (Foldable f, Alternative m) => f (m a) -> m a choice = asum {-# INLINE choice #-}@@ -153,7 +151,6 @@ -- > count = replicateM -- -- See also: 'skipCount', 'count''.- count :: Applicative m => Int -> m a -> m [a] count = replicateM {-# INLINE count #-}@@ -166,20 +163,18 @@ -- as if it were equal to zero. -- -- See also: 'skipCount', 'count'.- count' :: Alternative m => Int -> Int -> m a -> m [a] count' m' n' p = go m' n'   where     go !m !n       | n <= 0 || m > n = pure []-      | m > 0           = liftA2 (:) p (go (m - 1) (n - 1))-      | otherwise       = liftA2 (:) p (go 0 (n - 1)) <|> pure []+      | m > 0 = liftA2 (:) p (go (m - 1) (n - 1))+      | otherwise = liftA2 (:) p (go 0 (n - 1)) <|> pure [] {-# INLINE count' #-}  -- | Combine two alternatives. -- -- > eitherP a b = (Left <$> a) <|> (Right <$> b)- eitherP :: Alternative m => m a -> m b -> m (Either a b) eitherP a b = (Left <$> a) <|> (Right <$> b) {-# INLINE eitherP #-}@@ -188,14 +183,12 @@ -- ended by @sep@. Returns a list of values returned by @p@. -- -- > cStatements = cStatement `endBy` semicolon- endBy :: Alternative m => m a -> m sep -> m [a] endBy p sep = many (p <* sep) {-# INLINE endBy #-}  -- | @'endBy1' p sep@ parses /one/ or more occurrences of @p@, separated and -- ended by @sep@. Returns a list of values returned by @p@.- endBy1 :: Alternative m => m a -> m sep -> m [a] endBy1 p sep = some (p <* sep) {-# INLINE endBy1 #-}@@ -205,7 +198,6 @@ -- is consumed and lost. Use 'manyTill_' if you wish to keep it. -- -- See also: 'skipMany', 'skipManyTill'.- manyTill :: Alternative m => m a -> m end -> m [a] manyTill p end = go   where@@ -220,11 +212,10 @@ -- See also: 'skipMany', 'skipManyTill'. -- -- @since 1.2.0- manyTill_ :: Alternative m => m a -> m end -> m ([a], end) manyTill_ p end = go   where-    go = (([],) <$> end) <|> liftA2 (\x (xs, y) -> (x:xs, y)) p go+    go = (([],) <$> end) <|> liftA2 (\x (xs, y) -> (x : xs, y)) p go {-# INLINE manyTill_ #-}  -- | @'someTill' p end@ works similarly to @'manyTill' p end@, but @p@@@ -234,7 +225,6 @@ -- > someTill p end = liftA2 (:) p (manyTill p end) -- -- See also: 'skipSome', 'skipSomeTill'.- someTill :: Alternative m => m a -> m end -> m [a] someTill p end = liftA2 (:) p (manyTill p end) {-# INLINE someTill #-}@@ -246,10 +236,9 @@ -- See also: 'skipSome', 'skipSomeTill'. -- -- @since 1.2.0- someTill_ :: Alternative m => m a -> m end -> m ([a], end) someTill_ p end =-  liftA2 (\x (xs, y) -> (x:xs, y)) p (manyTill_ p end)+  liftA2 (\x (xs, y) -> (x : xs, y)) p (manyTill_ p end) {-# INLINE someTill_ #-}  -- | @'option' x p@ tries to apply the parser @p@. If @p@ fails without@@ -259,7 +248,6 @@ -- > option x p = p <|> pure x -- -- See also: 'optional'.- option :: Alternative m => a -> m a -> m a option x p = p <|> pure x {-# INLINE option #-}@@ -268,28 +256,24 @@ -- @sep@. Returns a list of values returned by @p@. -- -- > commaSep p = p `sepBy` comma- sepBy :: Alternative m => m a -> m sep -> m [a] sepBy p sep = sepBy1 p sep <|> pure [] {-# INLINE sepBy #-}  -- | @'sepBy1' p sep@ parses /one/ or more occurrences of @p@, separated by -- @sep@. Returns a list of values returned by @p@.- sepBy1 :: Alternative m => m a -> m sep -> m [a] sepBy1 p sep = liftA2 (:) p (many (sep *> p)) {-# INLINE sepBy1 #-}  -- | @'sepEndBy' p sep@ parses /zero/ or more occurrences of @p@, separated -- and optionally ended by @sep@. Returns a list of values returned by @p@.- sepEndBy :: Alternative m => m a -> m sep -> m [a] sepEndBy p sep = sepEndBy1 p sep <|> pure [] {-# INLINE sepEndBy #-}  -- | @'sepEndBy1' p sep@ parses /one/ or more occurrences of @p@, separated -- and optionally ended by @sep@. Returns a list of values returned by @p@.- sepEndBy1 :: Alternative m => m a -> m sep -> m [a] sepEndBy1 p sep = liftA2 (:) p ((sep *> sepEndBy p sep) <|> pure []) {-# INLINEABLE sepEndBy1 #-}@@ -298,7 +282,6 @@ -- its result. -- -- See also: 'manyTill', 'skipManyTill'.- skipMany :: Alternative m => m a -> m () skipMany p = go   where@@ -309,21 +292,18 @@ -- result. -- -- See also: 'someTill', 'skipSomeTill'.- skipSome :: Alternative m => m a -> m () skipSome p = p *> skipMany p {-# INLINE skipSome #-}  -- | @'skipCount' n p@ parses @n@ occurrences of @p@, skipping its result.--- If @n@ is not positive, the parser equals to @'pure' []@. Returns a list--- of @n@ values.+-- If @n@ is not positive, the parser equals to @'pure' ()@. -- -- > skipCount = replicateM_ -- -- See also: 'count', 'count''. -- -- @since 0.3.0- skipCount :: Applicative m => Int -> m a -> m () skipCount = replicateM_ {-# INLINE skipCount #-}@@ -333,7 +313,6 @@ -- then returned. -- -- See also: 'manyTill', 'skipMany'.- skipManyTill :: Alternative m => m a -> m end -> m end skipManyTill p end = go   where@@ -345,7 +324,6 @@ -- then returned. -- -- See also: 'someTill', 'skipSome'.- skipSomeTill :: Alternative m => m a -> m end -> m end skipSomeTill p end = p *> skipManyTill p end {-# INLINE skipSomeTill #-}
Control/Applicative/Combinators/NonEmpty.hs view
@@ -11,32 +11,30 @@ -- from "Control.Applicative.Combinators". -- -- @since 0.2.0- module Control.Applicative.Combinators.NonEmpty-  ( some-  , endBy1-  , someTill-  , sepBy1-  , sepEndBy1 )+  ( some,+    endBy1,+    someTill,+    sepBy1,+    sepEndBy1,+  ) where  import Control.Applicative hiding (some)-import Data.List.NonEmpty (NonEmpty (..)) import qualified Control.Applicative.Combinators as C-import qualified Data.List.NonEmpty              as NE+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE  -- | @'some' p@ applies the parser @p@ /one/ or more times and returns a -- list of the values returned by @p@. -- -- > word = some letter- some :: Alternative m => m a -> m (NonEmpty a) some p = NE.fromList <$> C.some p {-# INLINE some #-}  -- | @'endBy1' p sep@ parses /one/ or more occurrences of @p@, separated and -- ended by @sep@. Returns a non-empty list of values returned by @p@.- endBy1 :: Alternative m => m a -> m sep -> m (NonEmpty a) endBy1 p sep = NE.fromList <$> C.endBy1 p sep {-# INLINE endBy1 #-}@@ -45,14 +43,12 @@ -- should succeed at least once. -- -- See also: 'C.skipSome', 'C.skipSomeTill'.- someTill :: Alternative m => m a -> m end -> m (NonEmpty a) someTill p end = NE.fromList <$> C.someTill p end {-# INLINE someTill #-}  -- | @'sepBy1' p sep@ parses /one/ or more occurrences of @p@, separated by -- @sep@. Returns a non-empty list of values returned by @p@.- sepBy1 :: Alternative m => m a -> m sep -> m (NonEmpty a) sepBy1 p sep = NE.fromList <$> C.sepBy1 p sep {-# INLINE sepBy1 #-}@@ -60,7 +56,6 @@ -- | @'sepEndBy1' p sep@ parses /one/ or more occurrences of @p@, separated -- and optionally ended by @sep@. Returns a non-empty list of values returned by -- @p@.- sepEndBy1 :: Alternative m => m a -> m sep -> m (NonEmpty a) sepEndBy1 p sep = NE.fromList <$> C.sepEndBy1 p sep {-# INLINE sepEndBy1 #-}
Control/Applicative/Permutations.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE ExistentialQuantification #-}+ -- | -- Module      :  Control.Applicative.Permutations -- Copyright   :  © 2017–present Alex Washburn@@ -30,8 +32,8 @@ -- -- For example, suppose we want to parse a permutation of: an optional -- string of @a@'s, the character @b@ and an optional @c@. Using a standard--- parsing library combinator @char@, this can be described using the--- 'Applicative' instance by:+-- parsing library combinator @char@ (e.g. 'Text.ParserCombinators.ReadP.ReadP')+-- this can be described using the 'Applicative' instance by: -- -- > test = runPermutation $ -- >          (,,) <$> toPermutationWithDefault ""  (some (char 'a'))@@ -39,49 +41,56 @@ -- >               <*> toPermutationWithDefault '_' (char 'c') -- -- @since 0.2.0- module Control.Applicative.Permutations   ( -- ** Permutation type-    Permutation+    Permutation,+     -- ** Permutation evaluators-  , runPermutation-  , intercalateEffect+    runPermutation,+    intercalateEffect,+     -- ** Permutation constructors-  , toPermutation-  , toPermutationWithDefault )+    toPermutation,+    toPermutationWithDefault,+  ) where  import Control.Applicative+import Data.Function ((&))  -- | An 'Applicative' wrapper-type for constructing permutation parsers.+data Permutation m a = P !(Maybe a) [Branch m a] -data Permutation m a = P !(Maybe a) (m (Permutation m a))+data Branch m a = forall z. Branch (Permutation m (z -> a)) (m z)  instance Functor m => Functor (Permutation m) where-  fmap f (P v p) = P (f <$> v) (fmap f <$> p)+  fmap f (P v bs) = P (f <$> v) (fmap f <$> bs) -instance Alternative m => Applicative (Permutation m) where+instance Functor p => Functor (Branch p) where+  fmap f (Branch perm p) = Branch (fmap (f .) perm) p++instance Functor m => Applicative (Permutation m) where   pure value = P (Just value) empty-  lhs@(P f v) <*> rhs@(P g w) = P (f <*> g) (lhsAlt <|> rhsAlt)+  lhs@(P f v) <*> rhs@(P g w) = P (f <*> g) $ (ins2 <$> v) <> (ins1 <$> w)     where-      lhsAlt = (<*> rhs) <$> v-      rhsAlt = (lhs <*>) <$> w-  liftA2 f lhs@(P x v) rhs@(P y w) = P (liftA2 f x y) (lhsAlt <|> rhsAlt)+      ins1 (Branch perm p) = Branch ((.) <$> lhs <*> perm) p+      ins2 (Branch perm p) = Branch (flip <$> perm <*> rhs) p+  liftA2 f lhs@(P x v) rhs@(P y w) = P (liftA2 f x y) $ (ins2 <$> v) <> (ins1 <$> w)     where-      lhsAlt = (\p -> liftA2 f p rhs) <$> v-      rhsAlt = liftA2 f lhs <$> w+      ins1 (Branch perm p) = Branch (liftA2 ((.) . f) lhs perm) p+      ins2 (Branch perm p) = Branch (liftA2 (\b g z -> f (g z) b) rhs perm) p  -- | \"Unlifts\" a permutation parser into a parser to be evaluated.--runPermutation-  :: ( Alternative m-     , Monad m)-  => Permutation m a -- ^ Permutation specification-  -> m a             -- ^ Resulting base monad capable of handling the permutation-runPermutation (P value parser) = optional parser >>= f-   where-      f  Nothing = maybe empty pure value-      f (Just p) = runPermutation p+runPermutation ::+  Alternative m =>+  -- | Permutation specification+  Permutation m a ->+  -- | Resulting base monad capable of handling the permutation+  m a+runPermutation = foldAlt f+  where+    -- INCORRECT   = runPerms t <*> p+    f (Branch t p) = (&) <$> p <*> runPermutation t  -- | \"Unlifts\" a permutation parser into a parser to be evaluated with an -- intercalated effect. Useful for separators between permutation elements.@@ -109,41 +118,48 @@ --       permutation. --     * No effects are intercalated between missing components with a --       default value.--intercalateEffect-  :: ( Alternative m-     , Monad m)-  => m b             -- ^ Effect to be intercalated between permutation components-  -> Permutation m a -- ^ Permutation specification-  -> m a             -- ^ Resulting base monad capable of handling the permutation-intercalateEffect = run noEffect-   where-     noEffect = pure ()+--     * If an effect is encountered after a component, another component must+--       immediately follow the effect.+intercalateEffect ::+  Alternative m =>+  -- | Effect to be intercalated between permutation components+  m b ->+  -- | Permutation specification+  Permutation m a ->+  -- | Resulting base applicative capable of handling the permutation+  m a+intercalateEffect effect = foldAlt (runBranchEff effect)+  where+    runPermEff :: Alternative m => m b -> Permutation m a -> m a+    runPermEff eff (P v bs) =+      eff *> foldr ((<|>) . runBranchEff eff) empty bs <|> maybe empty pure v -     run :: (Alternative m, Monad m) => m c -> m b -> Permutation m a -> m a-     run headSep tailSep (P value parser) = optional headSep >>= f-       where-         f  Nothing = maybe empty pure value-         f (Just _) = optional parser >>= g-         g  Nothing = maybe empty pure value-         g (Just p) = run tailSep tailSep p+    runBranchEff :: Alternative m => m b -> Branch m a -> m a+    runBranchEff eff (Branch t p) = (&) <$> p <*> runPermEff eff t  -- | \"Lifts\" a parser to a permutation parser.--toPermutation-  :: Alternative m-  => m a -- ^ Permutation component-  -> Permutation m a-toPermutation p = P Nothing $ pure <$> p+toPermutation ::+  Alternative m =>+  -- | Permutation component+  m a ->+  Permutation m a+toPermutation = P Nothing . pure . branch  -- | \"Lifts\" a parser with a default value to a permutation parser. -- -- If no permutation containing the supplied parser can be parsed from the input, -- then the supplied default value is returned in lieu of a parse result.+toPermutationWithDefault ::+  Alternative m =>+  -- | Default Value+  a ->+  -- | Permutation component+  m a ->+  Permutation m a+toPermutationWithDefault v = P (Just v) . pure . branch -toPermutationWithDefault-  :: Alternative m-  => a   -- ^ Default Value-  -> m a -- ^ Permutation component-  -> Permutation m a-toPermutationWithDefault v p = P (Just v) $ pure <$> p+branch :: Functor m => m a -> Branch m a+branch = Branch $ pure id++foldAlt :: Alternative m => (Branch m a -> m a) -> Permutation m a -> m a+foldAlt f (P v bs) = foldr ((<|>) . f) (maybe empty pure v) bs
Control/Monad/Combinators.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE BangPatterns #-}+ -- | -- Module      :  Control.Monad.Combinators -- Copyright   :  © 2017–present Mark Karpov@@ -15,46 +17,44 @@ -- "Control.Applicative.Combinators". -- -- @since 0.4.0--{-# LANGUAGE BangPatterns #-}- module Control.Monad.Combinators   ( -- * Re-exports from "Control.Applicative"-    (C.<|>)+    (C.<|>),     -- $assocbo-  , C.optional+    C.optional,     -- $optional-  , C.empty+    C.empty,     -- $empty      -- * Original combinators-  , C.between-  , C.choice-  , count-  , count'-  , C.eitherP-  , endBy-  , endBy1-  , many-  , manyTill-  , manyTill_-  , some-  , someTill-  , someTill_-  , C.option-  , sepBy-  , sepBy1-  , sepEndBy-  , sepEndBy1-  , skipMany-  , skipSome-  , skipCount-  , skipManyTill-  , skipSomeTill )+    C.between,+    C.choice,+    count,+    count',+    C.eitherP,+    endBy,+    endBy1,+    many,+    manyTill,+    manyTill_,+    some,+    someTill,+    someTill_,+    C.option,+    sepBy,+    sepBy1,+    sepEndBy,+    sepEndBy1,+    skipMany,+    skipSome,+    skipCount,+    skipManyTill,+    skipSomeTill,+  ) where -import Control.Monad import qualified Control.Applicative.Combinators as C+import Control.Monad  ---------------------------------------------------------------------------- -- Re-exports from "Control.Applicative"@@ -87,7 +87,6 @@ -- values. -- -- See also: 'skipCount', 'count''.- count :: Monad m => Int -> m a -> m [a] count n' p = go id n'   where@@ -96,7 +95,7 @@         then return (f [])         else do           x <- p-          go (f . (x:)) (n - 1)+          go (f . (x :)) (n - 1) {-# INLINE count #-}  -- | @'count'' m n p@ parses from @m@ to @n@ occurrences of @p@. If @n@ is@@ -107,7 +106,6 @@ -- as if it were equal to zero. -- -- See also: 'skipCount', 'count'.- count' :: MonadPlus m => Int -> Int -> m a -> m [a] count' m' n' p =   if n' > 0 && n' >= m'@@ -118,7 +116,7 @@       if m > 0         then do           x <- p-          gom (f . (x:)) (m - 1)+          gom (f . (x :)) (m - 1)         else god f (if m' <= 0 then n' else n' - m')     god f !d =       if d > 0@@ -126,7 +124,7 @@           r <- C.optional p           case r of             Nothing -> return (f [])-            Just  x -> god (f . (x:)) (d - 1)+            Just x -> god (f . (x :)) (d - 1)         else return (f []) {-# INLINE count' #-} @@ -134,14 +132,12 @@ -- ended by @sep@. Returns a list of values returned by @p@. -- -- > cStatements = cStatement `endBy` semicolon- endBy :: MonadPlus m => m a -> m sep -> m [a] endBy p sep = many (p >>= \x -> x <$ sep) {-# INLINE endBy #-}  -- | @'endBy1' p sep@ parses /one/ or more occurrences of @p@, separated and -- ended by @sep@. Returns a list of values returned by @p@.- endBy1 :: MonadPlus m => m a -> m sep -> m [a] endBy1 p sep = some (p >>= \x -> x <$ sep) {-# INLINE endBy1 #-}@@ -150,7 +146,6 @@ -- list of the values returned by @p@. -- -- > identifier = (:) <$> letter <*> many (alphaNumChar <|> char '_')- many :: MonadPlus m => m a -> m [a] many p = go id   where@@ -158,7 +153,7 @@       r <- C.optional p       case r of         Nothing -> return (f [])-        Just  x -> go (f . (x:))+        Just x -> go (f . (x :)) {-# INLINE many #-}  -- | @'manyTill' p end@ applies parser @p@ /zero/ or more times until parser@@ -167,7 +162,6 @@ -- it. -- -- See also: 'skipMany', 'skipManyTill'.- manyTill :: MonadPlus m => m a -> m end -> m [a] manyTill p end = fst <$> manyTill_ p end {-# INLINE manyTill #-}@@ -180,7 +174,6 @@ -- See also: 'skipMany', 'skipManyTill'. -- -- @since 1.2.0- manyTill_ :: MonadPlus m => m a -> m end -> m ([a], end) manyTill_ p end = go id   where@@ -188,16 +181,15 @@       done <- C.optional end       case done of         Just done' -> return (f [], done')-        Nothing  -> do+        Nothing -> do           x <- p-          go (f . (x:))+          go (f . (x :)) {-# INLINE manyTill_ #-}  -- | @'some' p@ applies the parser @p@ /one/ or more times and returns a -- list of the values returned by @p@. -- -- > word = some letter- some :: MonadPlus m => m a -> m [a] some p = liftM2 (:) p (many p) {-# INLINE some #-}@@ -209,7 +201,6 @@ -- > someTill p end = liftM2 (:) p (manyTill p end) -- -- See also: 'skipSome', 'skipSomeTill'.- someTill :: MonadPlus m => m a -> m end -> m [a] someTill p end = liftM2 (:) p (manyTill p end) {-# INLINE someTill #-}@@ -221,36 +212,32 @@ -- See also: 'skipSome', 'skipSomeTill'. -- -- @since 1.2.0- someTill_ :: MonadPlus m => m a -> m end -> m ([a], end)-someTill_ p end = liftM2 (\x (xs, y) -> (x:xs, y)) p (manyTill_ p end)+someTill_ p end = liftM2 (\x (xs, y) -> (x : xs, y)) p (manyTill_ p end) {-# INLINE someTill_ #-}  -- | @'sepBy' p sep@ parses /zero/ or more occurrences of @p@, separated by -- @sep@. Returns a list of values returned by @p@. -- -- > commaSep p = p `sepBy` comma- sepBy :: MonadPlus m => m a -> m sep -> m [a] sepBy p sep = do   r <- C.optional p   case r of     Nothing -> return []-    Just  x -> (x:) <$> many (sep >> p)+    Just x -> (x :) <$> many (sep >> p) {-# INLINE sepBy #-}  -- | @'sepBy1' p sep@ parses /one/ or more occurrences of @p@, separated by -- @sep@. Returns a list of values returned by @p@.- sepBy1 :: MonadPlus m => m a -> m sep -> m [a] sepBy1 p sep = do   x <- p-  (x:) <$> many (sep >> p)+  (x :) <$> many (sep >> p) {-# INLINE sepBy1 #-}  -- | @'sepEndBy' p sep@ parses /zero/ or more occurrences of @p@, separated -- and optionally ended by @sep@. Returns a list of values returned by @p@.- sepEndBy :: MonadPlus m => m a -> m sep -> m [a] sepEndBy p sep = go id   where@@ -258,22 +245,21 @@       r <- C.optional p       case r of         Nothing -> return (f [])-        Just  x -> do+        Just x -> do           more <- C.option False (True <$ sep)           if more-            then go (f . (x:))+            then go (f . (x :))             else return (f [x]) {-# INLINE sepEndBy #-}  -- | @'sepEndBy1' p sep@ parses /one/ or more occurrences of @p@, separated -- and optionally ended by @sep@. Returns a list of values returned by @p@.- sepEndBy1 :: MonadPlus m => m a -> m sep -> m [a] sepEndBy1 p sep = do   x <- p   more <- C.option False (True <$ sep)   if more-    then (x:) <$> sepEndBy p sep+    then (x :) <$> sepEndBy p sep     else return [x] {-# INLINE sepEndBy1 #-} @@ -281,7 +267,6 @@ -- its result. -- -- See also: 'manyTill', 'skipManyTill'.- skipMany :: MonadPlus m => m a -> m () skipMany p = go   where@@ -294,17 +279,14 @@ -- result. -- -- See also: 'someTill', 'skipSomeTill'.- skipSome :: MonadPlus m => m a -> m () skipSome p = p >> skipMany p {-# INLINE skipSome #-}  -- | @'skipCount' n p@ parses @n@ occurrences of @p@, skipping its result.--- If @n@ is smaller or equal to zero, the parser equals to @'return' []@.--- Returns a list of @n@ values.+-- If @n@ is smaller or equal to zero, the parser equals to @'return' ()@. -- -- See also: 'count', 'count''.- skipCount :: Monad m => Int -> m a -> m () skipCount n' p = go n'   where@@ -318,7 +300,6 @@ -- then returned. -- -- See also: 'manyTill', 'skipMany'.- skipManyTill :: MonadPlus m => m a -> m end -> m end skipManyTill p end = go   where@@ -326,7 +307,7 @@       r <- C.optional end       case r of         Nothing -> p >> go-        Just  x -> return x+        Just x -> return x {-# INLINE skipManyTill #-}  -- | @'skipSomeTill' p end@ applies the parser @p@ /one/ or more times@@ -334,7 +315,6 @@ -- then returned. -- -- See also: 'someTill', 'skipSome'.- skipSomeTill :: MonadPlus m => m a -> m end -> m end skipSomeTill p end = p >> skipManyTill p end {-# INLINE skipSomeTill #-}
Control/Monad/Combinators/Expr.hs view
@@ -11,10 +11,10 @@ -- of operators. -- -- @since 1.0.0- module Control.Monad.Combinators.Expr-  ( Operator (..)-  , makeExprParser )+  ( Operator (..),+    makeExprParser,+  ) where  import Control.Monad@@ -23,15 +23,18 @@ -- | This data type specifies operators that work on values of type @a@. An -- operator is either binary infix or unary prefix or postfix. A binary -- operator has also an associated associativity.- data Operator m a-  = InfixN  (m (a -> a -> a)) -- ^ Non-associative infix-  | InfixL  (m (a -> a -> a)) -- ^ Left-associative infix-  | InfixR  (m (a -> a -> a)) -- ^ Right-associative infix-  | Prefix  (m (a -> a))      -- ^ Prefix-  | Postfix (m (a -> a))      -- ^ Postfix-  | TernR   (m (m (a -> a -> a -> a)))-    -- ^ Right-associative ternary. Right-associative means that+  = -- | Non-associative infix+    InfixN (m (a -> a -> a))+  | -- | Left-associative infix+    InfixL (m (a -> a -> a))+  | -- | Right-associative infix+    InfixR (m (a -> a -> a))+  | -- | Prefix+    Prefix (m (a -> a))+  | -- | Postfix+    Postfix (m (a -> a))+  | -- | Right-associative ternary. Right-associative means that     -- @a ? b : d ? e : f@ parsed as     -- @a ? b : (d ? e : f)@ and not as @(a ? b : d) ? e : f@.     --@@ -42,6 +45,7 @@     -- Example usage:     --     -- >>> TernR ((If <$ char ':') <$ char '?')+    TernR (m (m (a -> a -> a -> a)))  -- | @'makeExprParser' term table@ builds an expression parser for terms -- @term@ with operators from @table@, taking the associativity and@@ -88,37 +92,38 @@ -- > binary  name f = InfixL  (f <$ symbol name) -- > prefix  name f = Prefix  (f <$ symbol name) -- > postfix name f = Postfix (f <$ symbol name)--makeExprParser :: MonadPlus m-  => m a               -- ^ Term parser-  -> [[Operator m a]]  -- ^ Operator table, see 'Operator'-  -> m a               -- ^ Resulting expression parser+makeExprParser ::+  MonadPlus m =>+  -- | Term parser+  m a ->+  -- | Operator table, see 'Operator'+  [[Operator m a]] ->+  -- | Resulting expression parser+  m a makeExprParser = foldl addPrecLevel {-# INLINEABLE makeExprParser #-}  -- | @addPrecLevel p ops@ adds the ability to parse operators in table @ops@ -- to parser @p@.- addPrecLevel :: MonadPlus m => m a -> [Operator m a] -> m a addPrecLevel term ops =   term' >>= \x -> choice [ras' x, las' x, nas' x, tern' x, return x]   where-    (ras, las, nas, prefix, postfix, tern) = foldr splitOp ([],[],[],[],[],[]) ops+    (ras, las, nas, prefix, postfix, tern) = foldr splitOp ([], [], [], [], [], []) ops     term' = pTerm (choice prefix) term (choice postfix)-    ras'  = pInfixR (choice ras) term'-    las'  = pInfixL (choice las) term'-    nas'  = pInfixN (choice nas) term'-    tern' = pTernR  (choice tern) term'+    ras' = pInfixR (choice ras) term'+    las' = pInfixL (choice las) term'+    nas' = pInfixN (choice nas) term'+    tern' = pTernR (choice tern) term' {-# INLINEABLE addPrecLevel #-}  -- | @pTerm prefix term postfix@ parses a @term@ surrounded by optional -- prefix and postfix unary operators. Parsers @prefix@ and @postfix@ are -- allowed to fail, in this case 'id' is used.- pTerm :: MonadPlus m => m (a -> a) -> m a -> m (a -> a) -> m a pTerm prefix term postfix = do-  pre  <- option id prefix-  x    <- term+  pre <- option id prefix+  x <- term   post <- option id postfix   return . post . pre $ x {-# INLINE pTerm #-}@@ -126,7 +131,6 @@ -- | @pInfixN op p x@ parses non-associative infix operator @op@, then term -- with parser @p@, then returns result of the operator application on @x@ -- and the term.- pInfixN :: MonadPlus m => m (a -> a -> a) -> m a -> a -> m a pInfixN op p x = do   f <- op@@ -137,7 +141,6 @@ -- | @pInfixL op p x@ parses left-associative infix operator @op@, then term -- with parser @p@, then returns result of the operator application on @x@ -- and the term.- pInfixL :: MonadPlus m => m (a -> a -> a) -> m a -> a -> m a pInfixL op p x = do   f <- op@@ -149,7 +152,6 @@ -- | @pInfixR op p x@ parses right-associative infix operator @op@, then -- term with parser @p@, then returns result of the operator application on -- @x@ and the term.- pInfixR :: MonadPlus m => m (a -> a -> a) -> m a -> a -> m a pInfixR op p x = do   f <- op@@ -158,7 +160,6 @@ {-# INLINE pInfixR #-}  -- | Parse the first separator of a ternary operator- pTernR :: MonadPlus m => m (m (a -> a -> a -> a)) -> m a -> a -> m a pTernR sep1 p x = do   sep2 <- sep1@@ -169,21 +170,20 @@ {-# INLINE pTernR #-}  type Batch m a =-  ( [m (a -> a -> a)]-  , [m (a -> a -> a)]-  , [m (a -> a -> a)]-  , [m (a -> a)]-  , [m (a -> a)]-  , [m (m (a -> a -> a -> a))]+  ( [m (a -> a -> a)],+    [m (a -> a -> a)],+    [m (a -> a -> a)],+    [m (a -> a)],+    [m (a -> a)],+    [m (m (a -> a -> a -> a))]   )  -- | A helper to separate various operators (binary, unary, and according to -- associativity) and return them in a tuple.- splitOp :: Operator m a -> Batch m a -> Batch m a-splitOp (InfixR  op) (r, l, n, pre, post, tern) = (op:r, l, n, pre, post, tern)-splitOp (InfixL  op) (r, l, n, pre, post, tern) = (r, op:l, n, pre, post, tern)-splitOp (InfixN  op) (r, l, n, pre, post, tern) = (r, l, op:n, pre, post, tern)-splitOp (Prefix  op) (r, l, n, pre, post, tern) = (r, l, n, op:pre, post, tern)-splitOp (Postfix op) (r, l, n, pre, post, tern) = (r, l, n, pre, op:post, tern)-splitOp (TernR   op) (r, l, n, pre, post, tern) = (r, l, n, pre, post, op:tern)+splitOp (InfixR op) (r, l, n, pre, post, tern) = (op : r, l, n, pre, post, tern)+splitOp (InfixL op) (r, l, n, pre, post, tern) = (r, op : l, n, pre, post, tern)+splitOp (InfixN op) (r, l, n, pre, post, tern) = (r, l, op : n, pre, post, tern)+splitOp (Prefix op) (r, l, n, pre, post, tern) = (r, l, n, op : pre, post, tern)+splitOp (Postfix op) (r, l, n, pre, post, tern) = (r, l, n, pre, op : post, tern)+splitOp (TernR op) (r, l, n, pre, post, tern) = (r, l, n, pre, post, op : tern)
Control/Monad/Combinators/NonEmpty.hs view
@@ -11,32 +11,30 @@ -- from "Control.Monad.Combinators". -- -- @since 0.4.0- module Control.Monad.Combinators.NonEmpty-  ( some-  , endBy1-  , someTill-  , sepBy1-  , sepEndBy1 )+  ( some,+    endBy1,+    someTill,+    sepBy1,+    sepEndBy1,+  ) where  import Control.Monad-import Data.List.NonEmpty (NonEmpty (..)) import qualified Control.Monad.Combinators as C-import qualified Data.List.NonEmpty        as NE+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE  -- | @'some' p@ applies the parser @p@ /one/ or more times and returns a -- list of the values returned by @p@. -- -- > word = some letter- some :: MonadPlus m => m a -> m (NonEmpty a) some p = NE.fromList <$> C.some p {-# INLINE some #-}  -- | @'endBy1' p sep@ parses /one/ or more occurrences of @p@, separated and -- ended by @sep@. Returns a non-empty list of values returned by @p@.- endBy1 :: MonadPlus m => m a -> m sep -> m (NonEmpty a) endBy1 p sep = NE.fromList <$> C.endBy1 p sep {-# INLINE endBy1 #-}@@ -45,14 +43,12 @@ -- should succeed at least once. -- -- See also: 'C.skipSome', 'C.skipSomeTill'.- someTill :: MonadPlus m => m a -> m end -> m (NonEmpty a) someTill p end = NE.fromList <$> C.someTill p end {-# INLINE someTill #-}  -- | @'sepBy1' p sep@ parses /one/ or more occurrences of @p@, separated by -- @sep@. Returns a non-empty list of values returned by @p@.- sepBy1 :: MonadPlus m => m a -> m sep -> m (NonEmpty a) sepBy1 p sep = NE.fromList <$> C.sepBy1 p sep {-# INLINE sepBy1 #-}@@ -60,7 +56,6 @@ -- | @'sepEndBy1' p sep@ parses /one/ or more occurrences of @p@, separated -- and optionally ended by @sep@. Returns a non-empty list of values returned by -- @p@.- sepEndBy1 :: MonadPlus m => m a -> m sep -> m (NonEmpty a) sepEndBy1 p sep = NE.fromList <$> C.sepEndBy1 p sep {-# INLINE sepEndBy1 #-}
+ Control/Monad/Permutations.hs view
@@ -0,0 +1,104 @@+-- |+-- Module      :  Control.Monad.Permutations+-- Copyright   :  © 2017–present Alex Washburn+-- License     :  BSD 3 clause+--+-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- This module specialized the interface to 'Monad' for potential efficiency+-- considerations, depending on the monad the permutations are run over.+--+-- For a more general interface requiring only 'Applicative', and for more+-- complete documentation, see the 'Control.Applicative.Permutations' module.+--+-- @since 1.3.0+module Control.Monad.Permutations+  ( -- ** Permutation type+    Permutation,++    -- ** Permutation evaluators+    runPermutation,+    intercalateEffect,++    -- ** Permutation constructors+    toPermutation,+    toPermutationWithDefault,+  )+where++import Control.Applicative++-- | An 'Applicative' wrapper-type for constructing permutation parsers.+data Permutation m a = P !(Maybe a) (m (Permutation m a))++instance Functor m => Functor (Permutation m) where+  fmap f (P v p) = P (f <$> v) (fmap f <$> p)++instance Alternative m => Applicative (Permutation m) where+  pure value = P (Just value) empty+  lhs@(P f v) <*> rhs@(P g w) = P (f <*> g) (lhsAlt <|> rhsAlt)+    where+      lhsAlt = (<*> rhs) <$> v+      rhsAlt = (lhs <*>) <$> w+  liftA2 f lhs@(P x v) rhs@(P y w) = P (liftA2 f x y) (lhsAlt <|> rhsAlt)+    where+      lhsAlt = (\p -> liftA2 f p rhs) <$> v+      rhsAlt = liftA2 f lhs <$> w++-- | \"Unlifts\" a permutation parser into a parser to be evaluated.+runPermutation ::+  ( Alternative m,+    Monad m+  ) =>+  -- | Permutation specification+  Permutation m a ->+  -- | Resulting base monad capable of handling the permutation+  m a+runPermutation (P value parser) = optional parser >>= f+  where+    f Nothing = maybe empty pure value+    f (Just p) = runPermutation p++-- | \"Unlifts\" a permutation parser into a parser to be evaluated with an+-- intercalated effect. Useful for separators between permutation elements.+intercalateEffect ::+  ( Alternative m,+    Monad m+  ) =>+  -- | Effect to be intercalated between permutation components+  m b ->+  -- | Permutation specification+  Permutation m a ->+  -- | Resulting base monad capable of handling the permutation+  m a+intercalateEffect = run noEffect+  where+    noEffect = pure ()+    run :: (Alternative m, Monad m) => m c -> m b -> Permutation m a -> m a+    run headSep tailSep (P value parser) = optional (headSep *> parser) >>= f+      where+        f Nothing = maybe empty pure value+        f (Just p) = run tailSep tailSep p++-- | \"Lifts\" a parser to a permutation parser.+toPermutation ::+  Alternative m =>+  -- | Permutation component+  m a ->+  Permutation m a+toPermutation p = P Nothing $ pure <$> p++-- | \"Lifts\" a parser with a default value to a permutation parser.+--+-- If no permutation containing the supplied parser can be parsed from the input,+-- then the supplied default value is returned in lieu of a parse result.+toPermutationWithDefault ::+  Alternative m =>+  -- | Default Value+  a ->+  -- | Permutation component+  m a ->+  Permutation m a+toPermutationWithDefault v p = P (Just v) $ pure <$> p
README.md view
@@ -4,7 +4,7 @@ [![Hackage](https://img.shields.io/hackage/v/parser-combinators.svg?style=flat)](https://hackage.haskell.org/package/parser-combinators) [![Stackage Nightly](http://stackage.org/package/parser-combinators/badge/nightly)](http://stackage.org/nightly/package/parser-combinators) [![Stackage LTS](http://stackage.org/package/parser-combinators/badge/lts)](http://stackage.org/lts/package/parser-combinators)-[![Build Status](https://travis-ci.org/mrkkrp/parser-combinators.svg?branch=master)](https://travis-ci.org/mrkkrp/parser-combinators)+![CI](https://github.com/mrkkrp/parser-combinators/workflows/CI/badge.svg?branch=master)  The package provides common parser combinators defined in terms of `Applicative` and `Alternative` without any dependencies but `base`. There
parser-combinators.cabal view
@@ -1,45 +1,57 @@-name:                 parser-combinators-version:              1.2.1-cabal-version:        1.18-tested-with:          GHC==8.4.4, GHC==8.6.5, GHC==8.8.1-license:              BSD3-license-file:         LICENSE.md-author:               Mark Karpov <markkarpov92@gmail.com>-                      Alex Washburn <github@recursion.ninja>-maintainer:           Mark Karpov <markkarpov92@gmail.com>-homepage:             https://github.com/mrkkrp/parser-combinators-bug-reports:          https://github.com/mrkkrp/parser-combinators/issues-category:             Parsing-synopsis:             Lightweight package providing commonly useful parser combinators-build-type:           Simple-description:          Lightweight package providing commonly useful parser combinators.-extra-doc-files:      CHANGELOG.md-                    , README.md+cabal-version:   1.18+name:            parser-combinators+version:         1.3.0+license:         BSD3+license-file:    LICENSE.md+maintainer:      Mark Karpov <markkarpov92@gmail.com>+author:+    Mark Karpov <markkarpov92@gmail.com>+    Alex Washburn <github@recursion.ninja> +tested-with:     ghc ==8.6.5 ghc ==8.8.4 ghc ==8.10.3+homepage:        https://github.com/mrkkrp/parser-combinators+bug-reports:     https://github.com/mrkkrp/parser-combinators/issues+synopsis:+    Lightweight package providing commonly useful parser combinators++description:+    Lightweight package providing commonly useful parser combinators.++category:        Parsing+build-type:      Simple+extra-doc-files:+    CHANGELOG.md+    README.md+ source-repository head-  type:               git-  location:           https://github.com/mrkkrp/parser-combinators.git+    type:     git+    location: https://github.com/mrkkrp/parser-combinators.git  flag dev-  description:        Turn on development settings.-  manual:             True-  default:            False+    description: Turn on development settings.+    default:     False+    manual:      True  library-  build-depends:      base             >= 4.11 && < 5.0-  exposed-modules:    Control.Applicative.Combinators-                    , Control.Applicative.Combinators.NonEmpty-                    , Control.Applicative.Permutations-                    , Control.Monad.Combinators-                    , Control.Monad.Combinators.Expr-                    , Control.Monad.Combinators.NonEmpty-  if flag(dev)-    ghc-options:      -Wall -Werror-  else-    ghc-options:      -O2 -Wall-  if flag(dev)-    ghc-options:      -Wcompat-                      -Wincomplete-record-updates-                      -Wincomplete-uni-patterns-                      -Wnoncanonical-monad-instances-  default-language:   Haskell2010+    exposed-modules:+        Control.Applicative.Combinators+        Control.Applicative.Combinators.NonEmpty+        Control.Applicative.Permutations+        Control.Monad.Combinators+        Control.Monad.Combinators.Expr+        Control.Monad.Combinators.NonEmpty+        Control.Monad.Permutations++    default-language: Haskell2010+    build-depends:    base >=4.12 && <5.0++    if flag(dev)+        ghc-options: -Wall -Werror++    else+        ghc-options: -O2 -Wall++    if flag(dev)+        ghc-options:+            -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns+            -Wnoncanonical-monad-instances