{-# LANGUAGE BangPatterns #-}-- |-- Module : Control.Monad.Combinators-- Copyright : © 2017–present Mark Karpov-- License : BSD 3 clause---- Maintainer : Mark Karpov <markkarpov92@gmail.com>-- Stability : experimental-- Portability : portable---- The module provides more efficient versions of the combinators from-- "Control.Applicative.Combinators" defined in terms of 'Monad' and-- 'MonadPlus' instead of 'Control.Applicative.Applicative' and-- 'Control.Applicative.Alternative'. When there is no difference in-- performance we just re-export the combinators from-- "Control.Applicative.Combinators".---- @since 0.4.0moduleControl.Monad.Combinators(-- * Re-exports from "Control.Applicative"(C.<|>),-- $assocboC.optional,-- $optionalC.empty,-- $empty-- * Original combinatorsC.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 ,)whereimportqualifiedControl.Applicative.Combinators asCimportControl.Monad------------------------------------------------------------------------------ Re-exports from "Control.Applicative"-- $assocbo---- This combinator implements choice. The parser @p 'C.<|>' q@ first applies-- @p@. If it succeeds, the value of @p@ is returned. If @p@ fails, parser-- @q@ is tried.-- $optional---- @'C.optional' p@ tries to apply the parser @p@. It will parse @p@ or-- 'Nothing'. It only fails if @p@ fails after consuming input. On success-- result of @p@ is returned inside of 'Just', on failure 'Nothing' is-- returned.---- See also: 'C.option'.-- $empty---- This parser fails unconditionally without providing any information about-- the cause of the failure.------------------------------------------------------------------------------ Original combinators-- | @'count' n p@ parses @n@ occurrences of @p@. If @n@ is smaller or equal-- to zero, the parser equals to @'return' []@. Returns a list of @n@-- values.---- See also: 'skipCount', 'count''.count ::Monadm =>Int->m a ->m [a ]count :: Int -> m a -> m [a]
count Int
n' m a
p =([a] -> [a]) -> Int -> m [a]
forall t c. (Ord t, Num t) => ([a] -> c) -> t -> m c
go [a] -> [a]
forall a. a -> a
idInt
n' wherego :: ([a] -> c) -> t -> m c
go [a] -> c
f !t
n =ift
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<=t
0thenc -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return([a] -> c
f [])elsedoa
x <-m a
p ([a] -> c) -> t -> m c
go ([a] -> c
f ([a] -> c) -> ([a] -> [a]) -> [a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:))(t
n t -> t -> t
forall a. Num a => a -> a -> a
-t
1){-# INLINEcount #-}-- | @'count'' m n p@ parses from @m@ to @n@ occurrences of @p@. If @n@ is-- not positive or @m > n@, the parser equals to @'return' []@. Returns a-- list of parsed values.---- Please note that @m@ /may/ be negative, in this case effect is the same-- as if it were equal to zero.---- See also: 'skipCount', 'count'.count' ::MonadPlusm =>Int->Int->m a ->m [a ]count' :: Int -> Int -> m a -> m [a]
count' Int
m' Int
n' m a
p =ifInt
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0Bool -> Bool -> Bool
&&Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
m' then([a] -> [a]) -> Int -> m [a]
forall t b. (Ord t, Num t) => ([a] -> b) -> t -> m b
gom [a] -> [a]
forall a. a -> a
idInt
m' else[a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return[]wheregom :: ([a] -> b) -> t -> m b
gom [a] -> b
f !t
m =ift
m t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>t
0thendoa
x <-m a
p ([a] -> b) -> t -> m b
gom ([a] -> b
f ([a] -> b) -> ([a] -> [a]) -> [a] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:))(t
m t -> t -> t
forall a. Num a => a -> a -> a
-t
1)else([a] -> b) -> Int -> m b
forall t b. (Ord t, Num t) => ([a] -> b) -> t -> m b
god [a] -> b
f (ifInt
m' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
0thenInt
n' elseInt
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
m' )god :: ([a] -> a) -> t -> m a
god [a] -> a
f !t
d =ift
d t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>t
0thendoMaybe a
r <-m a -> m (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
C.optionalm a
p caseMaybe a
r ofMaybe a
Nothing->a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return([a] -> a
f [])Justa
x ->([a] -> a) -> t -> m a
god ([a] -> a
f ([a] -> a) -> ([a] -> [a]) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:))(t
d t -> t -> t
forall a. Num a => a -> a -> a
-t
1)elsea -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return([a] -> a
f []){-# INLINEcount' #-}-- | @'endBy' p sep@ parses /zero/ or more occurrences of @p@, separated and-- ended by @sep@. Returns a list of values returned by @p@.---- > cStatements = cStatement `endBy` semicolonendBy ::MonadPlusm =>m a ->m sep ->m [a ]endBy :: m a -> m sep -> m [a]
endBy m a
p m sep
sep =m a -> m [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m a
p m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=\a
x ->a
x a -> m sep -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$m sep
sep ){-# INLINEendBy #-}-- | @'endBy1' p sep@ parses /one/ or more occurrences of @p@, separated and-- ended by @sep@. Returns a list of values returned by @p@.endBy1 ::MonadPlusm =>m a ->m sep ->m [a ]endBy1 :: m a -> m sep -> m [a]
endBy1 m a
p m sep
sep =m a -> m [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (m a
p m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=\a
x ->a
x a -> m sep -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$m sep
sep ){-# INLINEendBy1 #-}-- | @'many' p@ applies the parser @p@ /zero/ or more times and returns a-- list of the values returned by @p@.---- > identifier = (:) <$> letter <*> many (alphaNumChar <|> char '_')many ::MonadPlusm =>m a ->m [a ]many :: m a -> m [a]
many m a
p =([a] -> [a]) -> m [a]
forall c. ([a] -> c) -> m c
go [a] -> [a]
forall a. a -> a
idwherego :: ([a] -> c) -> m c
go [a] -> c
f =doMaybe a
r <-m a -> m (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
C.optionalm a
p caseMaybe a
r ofMaybe a
Nothing->c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return([a] -> c
f [])Justa
x ->([a] -> c) -> m c
go ([a] -> c
f ([a] -> c) -> ([a] -> [a]) -> [a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)){-# INLINEmany #-}-- | @'manyTill' p end@ applies parser @p@ /zero/ or more times until parser-- @end@ succeeds. Returns the list of values returned by @p@. __Note__ that-- @end@ result is consumed and lost. Use 'manyTill_' if you wish to keep-- it.---- See also: 'skipMany', 'skipManyTill'.manyTill ::MonadPlusm =>m a ->m end ->m [a ]manyTill :: m a -> m end -> m [a]
manyTill m a
p m end
end =([a], end) -> [a]
forall a b. (a, b) -> a
fst(([a], end) -> [a]) -> m ([a], end) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>m a -> m end -> m ([a], end)
forall (m :: * -> *) a end.
MonadPlus m =>
m a -> m end -> m ([a], end)
manyTill_ m a
p m end
end {-# INLINEmanyTill #-}-- | @'manyTill_' p end@ applies parser @p@ /zero/ or more times until-- parser @end@ succeeds. Returns the list of values returned by @p@ and the-- @end@ result. Use 'manyTill' if you have no need in the result of the-- @end@.---- See also: 'skipMany', 'skipManyTill'.---- @since 1.2.0manyTill_ ::MonadPlusm =>m a ->m end ->m ([a ],end )manyTill_ :: m a -> m end -> m ([a], end)
manyTill_ m a
p m end
end =([a] -> [a]) -> m ([a], end)
forall c. ([a] -> c) -> m (c, end)
go [a] -> [a]
forall a. a -> a
idwherego :: ([a] -> c) -> m (c, end)
go [a] -> c
f =doMaybe end
done <-m end -> m (Maybe end)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
C.optionalm end
end caseMaybe end
done ofJustend
done' ->(c, end) -> m (c, end)
forall (m :: * -> *) a. Monad m => a -> m a
return([a] -> c
f [],end
done' )Maybe end
Nothing->doa
x <-m a
p ([a] -> c) -> m (c, end)
go ([a] -> c
f ([a] -> c) -> ([a] -> [a]) -> [a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)){-# INLINEmanyTill_ #-}-- | @'some' p@ applies the parser @p@ /one/ or more times and returns a-- list of the values returned by @p@.---- > word = some lettersome ::MonadPlusm =>m a ->m [a ]some :: m a -> m [a]
some m a
p =(a -> [a] -> [a]) -> m a -> m [a] -> m [a]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2(:)m a
p (m a -> m [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many m a
p ){-# INLINEsome #-}-- | @'someTill' p end@ works similarly to @'manyTill' p end@, but @p@-- should succeed at least once. __Note__ that @end@ result is consumed and-- lost. Use 'someTill_' if you wish to keep it.---- > someTill p end = liftM2 (:) p (manyTill p end)---- See also: 'skipSome', 'skipSomeTill'.someTill ::MonadPlusm =>m a ->m end ->m [a ]someTill :: m a -> m end -> m [a]
someTill m a
p m end
end =(a -> [a] -> [a]) -> m a -> m [a] -> m [a]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2(:)m a
p (m a -> m end -> m [a]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill m a
p m end
end ){-# INLINEsomeTill #-}-- | @'someTill_' p end@ works similarly to @'manyTill_' p end@, but @p@-- should succeed at least once. Use 'someTill' if you have no need in the-- result of the @end@.---- See also: 'skipSome', 'skipSomeTill'.---- @since 1.2.0someTill_ ::MonadPlusm =>m a ->m end ->m ([a ],end )someTill_ :: m a -> m end -> m ([a], end)
someTill_ m a
p m end
end =(a -> ([a], end) -> ([a], end))
-> m a -> m ([a], end) -> m ([a], end)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2(\a
x ([a]
xs ,end
y )->(a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs ,end
y ))m a
p (m a -> m end -> m ([a], end)
forall (m :: * -> *) a end.
MonadPlus m =>
m a -> m end -> m ([a], end)
manyTill_ m a
p m end
end ){-# INLINEsomeTill_ #-}-- | @'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` commasepBy ::MonadPlusm =>m a ->m sep ->m [a ]sepBy :: m a -> m sep -> m [a]
sepBy m a
p m sep
sep =doMaybe a
r <-m a -> m (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
C.optionalm a
p caseMaybe a
r ofMaybe a
Nothing->[a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return[]Justa
x ->(a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>m a -> m [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m sep
sep m sep -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>m a
p ){-# INLINEsepBy #-}-- | @'sepBy1' p sep@ parses /one/ or more occurrences of @p@, separated by-- @sep@. Returns a list of values returned by @p@.sepBy1 ::MonadPlusm =>m a ->m sep ->m [a ]sepBy1 :: m a -> m sep -> m [a]
sepBy1 m a
p m sep
sep =doa
x <-m a
p (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>m a -> m [a]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (m sep
sep m sep -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>m a
p ){-# INLINEsepBy1 #-}-- | @'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 ::MonadPlusm =>m a ->m sep ->m [a ]sepEndBy :: m a -> m sep -> m [a]
sepEndBy m a
p m sep
sep =([a] -> [a]) -> m [a]
forall a. ([a] -> a) -> m a
go [a] -> [a]
forall a. a -> a
idwherego :: ([a] -> a) -> m a
go [a] -> a
f =doMaybe a
r <-m a -> m (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
C.optionalm a
p caseMaybe a
r ofMaybe a
Nothing->a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return([a] -> a
f [])Justa
x ->doBool
more <-Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
C.option Bool
False(Bool
TrueBool -> m sep -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$m sep
sep )ifBool
more then([a] -> a) -> m a
go ([a] -> a
f ([a] -> a) -> ([a] -> [a]) -> [a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:))elsea -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return([a] -> a
f [a
x ]){-# INLINEsepEndBy #-}-- | @'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 ::MonadPlusm =>m a ->m sep ->m [a ]sepEndBy1 :: m a -> m sep -> m [a]
sepEndBy1 m a
p m sep
sep =doa
x <-m a
p Bool
more <-Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
C.option Bool
False(Bool
TrueBool -> m sep -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$m sep
sep )ifBool
more then(a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)([a] -> [a]) -> m [a] -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>m a -> m sep -> m [a]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
sepEndBy m a
p m sep
sep else[a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return[a
x ]{-# INLINEsepEndBy1 #-}-- | @'skipMany' p@ applies the parser @p@ /zero/ or more times, skipping-- its result.---- See also: 'manyTill', 'skipManyTill'.skipMany ::MonadPlusm =>m a ->m ()skipMany :: m a -> m ()
skipMany m a
p =m ()
go wherego :: m ()
go =doBool
more <-Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
C.option Bool
False(Bool
TrueBool -> m a -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$m a
p )Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenBool
more m ()
go {-# INLINEskipMany #-}-- | @'skipSome' p@ applies the parser @p@ /one/ or more times, skipping its-- result.---- See also: 'someTill', 'skipSomeTill'.skipSome ::MonadPlusm =>m a ->m ()skipSome :: m a -> m ()
skipSome m a
p =m a
p m a -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>m a -> m ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany m a
p {-# INLINEskipSome #-}-- | @'skipCount' n p@ parses @n@ occurrences of @p@, skipping its result.-- If @n@ is smaller or equal to zero, the parser equals to @'return' ()@.---- See also: 'count', 'count''.skipCount ::Monadm =>Int->m a ->m ()skipCount :: Int -> m a -> m ()
skipCount Int
n' m a
p =Int -> m ()
forall t. (Ord t, Num t) => t -> m ()
go Int
n' wherego :: t -> m ()
go !t
n =Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless(t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<=t
0)(m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$m a
p m a -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>t -> m ()
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
-t
1){-# INLINEskipCount #-}-- | @'skipManyTill' p end@ applies the parser @p@ /zero/ or more times-- skipping results until parser @end@ succeeds. Result parsed by @end@ is-- then returned.---- See also: 'manyTill', 'skipMany'.skipManyTill ::MonadPlusm =>m a ->m end ->m end skipManyTill :: m a -> m end -> m end
skipManyTill m a
p m end
end =m end
go wherego :: m end
go =doMaybe end
r <-m end -> m (Maybe end)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
C.optionalm end
end caseMaybe end
r ofMaybe end
Nothing->m a
p m a -> m end -> m end
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>m end
go Justend
x ->end -> m end
forall (m :: * -> *) a. Monad m => a -> m a
returnend
x {-# INLINEskipManyTill #-}-- | @'skipSomeTill' p end@ applies the parser @p@ /one/ or more times-- skipping results until parser @end@ succeeds. Result parsed by @end@ is-- then returned.---- See also: 'someTill', 'skipSome'.skipSomeTill ::MonadPlusm =>m a ->m end ->m end skipSomeTill :: m a -> m end -> m end
skipSomeTill m a
p m end
end =m a
p m a -> m end -> m end
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>m a -> m end -> m end
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m end
skipManyTill m a
p m end
end {-# INLINEskipSomeTill #-}