{-# 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.0
module Control.Monad.Combinators
  ( -- * Re-exports from "Control.Applicative"
    (C.<|>),
    -- $assocbo
    C.optional,
    -- $optional
    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,
  )
where

import qualified Control.Applicative.Combinators as C
import Control.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 :: Monad m => 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
id Int
n'
  where
    go :: ([a] -> c) -> t -> m c
go [a] -> c
f !t
n =
      if t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0
        then c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> c
f [])
        else do
          a
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)
{-# INLINE count #-}

-- | @'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' :: MonadPlus m => Int -> Int -> m a -> m [a]
count' :: Int -> Int -> m a -> m [a]
count' Int
m' Int
n' m a
p =
  if Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> 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
id Int
m'
    else [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  where
    gom :: ([a] -> b) -> t -> m b
gom [a] -> b
f !t
m =
      if t
m t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
0
        then do
          a
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 (if Int
m' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then Int
n' else Int
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 =
      if t
d t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
0
        then do
          Maybe a
r <- m a -> m (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
C.optional m a
p
          case Maybe a
r of
            Maybe a
Nothing -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> a
f [])
            Just a
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)
        else a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> a
f [])
{-# INLINE count' #-}

-- | @'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` semicolon
endBy :: MonadPlus m => 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)
{-# 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 :: 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)
{-# INLINE endBy1 #-}

-- | @'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 :: MonadPlus m => 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
id
  where
    go :: ([a] -> c) -> m c
go [a] -> c
f = do
      Maybe a
r <- m a -> m (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
C.optional m a
p
      case Maybe a
r of
        Maybe a
Nothing -> c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> c
f [])
        Just a
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]
:))
{-# INLINE many #-}

-- | @'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 :: MonadPlus m => 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
{-# INLINE manyTill #-}

-- | @'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.0
manyTill_ :: MonadPlus m => 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
id
  where
    go :: ([a] -> c) -> m (c, end)
go [a] -> c
f = do
      Maybe end
done <- m end -> m (Maybe end)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
C.optional m end
end
      case Maybe end
done of
        Just end
done' -> (c, end) -> m (c, end)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> c
f [], end
done')
        Maybe end
Nothing -> do
          a
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]
:))
{-# 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 :: 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)
{-# INLINE some #-}

-- | @'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 :: MonadPlus m => 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)
{-# INLINE someTill #-}

-- | @'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.0
someTill_ :: MonadPlus m => 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)
{-# 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 :: m a -> m sep -> m [a]
sepBy m a
p m sep
sep = do
  Maybe a
r <- m a -> m (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
C.optional m a
p
  case Maybe a
r of
    Maybe a
Nothing -> [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Just a
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)
{-# 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 :: m a -> m sep -> m [a]
sepBy1 m a
p m sep
sep = do
  a
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)
{-# 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 :: 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
id
  where
    go :: ([a] -> a) -> m a
go [a] -> a
f = do
      Maybe a
r <- m a -> m (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
C.optional m a
p
      case Maybe a
r of
        Maybe a
Nothing -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> a
f [])
        Just a
x -> do
          Bool
more <- Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
C.option Bool
False (Bool
True Bool -> m sep -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m sep
sep)
          if Bool
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]
:))
            else a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> a
f [a
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 :: m a -> m sep -> m [a]
sepEndBy1 m a
p m sep
sep = do
  a
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
True Bool -> m sep -> m Bool
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m sep
sep)
  if Bool
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]
{-# INLINE sepEndBy1 #-}

-- | @'skipMany' p@ applies the parser @p@ /zero/ or more times, skipping
-- its result.
--
-- See also: 'manyTill', 'skipManyTill'.
skipMany :: MonadPlus m => m a -> m ()
skipMany :: m a -> m ()
skipMany m a
p = m ()
go
  where
    go :: m ()
go = do
      Bool
more <- Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
C.option Bool
False (Bool
True Bool -> 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 ()
when Bool
more m ()
go
{-# INLINE skipMany #-}

-- | @'skipSome' p@ applies the parser @p@ /one/ or more times, skipping its
-- result.
--
-- See also: 'someTill', 'skipSomeTill'.
skipSome :: MonadPlus m => 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
{-# 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' ()@.
--
-- See also: 'count', 'count''.
skipCount :: Monad m => 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'
  where
    go :: 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)
{-# INLINE skipCount #-}

-- | @'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 :: MonadPlus m => m a -> m end -> m end
skipManyTill :: m a -> m end -> m end
skipManyTill m a
p m end
end = m end
go
  where
    go :: m end
go = do
      Maybe end
r <- m end -> m (Maybe end)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
C.optional m end
end
      case Maybe end
r of
        Maybe 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
        Just end
x -> end -> m end
forall (m :: * -> *) a. Monad m => a -> m a
return end
x
{-# INLINE skipManyTill #-}

-- | @'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 :: MonadPlus m => 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
{-# INLINE skipSomeTill #-}