{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TupleSections #-}

-- |
-- Module      :  Control.Applicative.Combinators
-- Copyright   :  © 2017–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- The module provides parser combinators defined for instances of
-- 'Applicative' and 'Alternative'. It also re-exports functions that are
-- commonly used in parsing from "Control.Applicative" with additional
-- parsing-related comments added.
--
-- Due to the nature of the 'Applicative' and 'Alternative' abstractions,
-- they are prone to memory leaks and not as efficient as their monadic
-- counterparts. Although all the combinators we provide in this module are
-- perfectly expressible in terms of 'Applicative' and 'Alternative', please
-- prefer "Control.Monad.Combinators" instead when possible.
--
-- If you wish that the combinators that cannot return empty lists return
-- values of the 'Data.List.NonEmpty.NonEmpty' data type, use the
-- "Control.Applicative.Combinators.NonEmpty" module.
--
-- === A note on backtracking
--
-- Certain parsing libraries, such as Megaparsec, do not backtrack every
-- branch of parsing automatically for the sake of performance and better
-- error messages. They typically backtrack only “atomic” parsers, e.g.
-- those that match a token or several tokens in a row. To backtrack an
-- arbitrary complex parser\/branch, a special combinator should be used,
-- typically called @try@. Combinators in this module are defined in terms
-- 'Applicative' and 'Alternative' operations. Being quite abstract, they
-- cannot know anything about inner workings of any concrete parsing
-- library, and so they cannot use @try@.
--
-- The essential feature of the 'Alternative' type class is the @('<|>')@
-- operator that allows to express choice. In libraries that do not
-- backtrack everything automatically, the choice operator and everything
-- that is build on top of it require the parser on the left hand side to
-- 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.
module Control.Applicative.Combinators
  ( -- * Re-exports from "Control.Applicative"
    (<|>),
    -- $assocbo
    many,
    -- $many
    some,
    -- $some
    optional,
    -- $optional
    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,
  )
where

import Control.Applicative
import Control.Monad (replicateM, replicateM_)
import Data.Foldable

----------------------------------------------------------------------------
-- Re-exports from "Control.Applicative"

-- $assocbo
--
-- This combinator implements choice. The parser @p '<|>' q@ first applies
-- @p@. If it succeeds, the value of @p@ is returned. If @p@ fails, parser
-- @q@ is tried.

-- $many
--
-- @'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 '_')

-- $some
--
-- @'some' p@ applies the parser @p@ /one/ or more times and returns a list
-- of the values returned by @p@.
--
-- > word = some letter

-- $optional
--
-- @'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: 'option'.

-- $empty
--
-- This parser fails unconditionally without providing any information about
-- the cause of the failure.
--
-- @since 0.4.0

----------------------------------------------------------------------------
-- Original combinators

-- | @'between' open close p@ parses @open@, followed by @p@ and @close@.
-- Returns the value returned by @p@.
--
-- > braces = between (symbol "{") (symbol "}")
between :: Applicative m => m open -> m close -> m a -> m a
between :: m open -> m close -> m a -> m a
between m open
open m close
close m a
p = m open
open m open -> m a -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a
p m a -> m close -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m close
close
{-# INLINE between #-}

-- | @'choice' ps@ tries to apply the parsers in the list @ps@ in order,
-- 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 :: f (m a) -> m a
choice = f (m a) -> m a
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
{-# INLINE choice #-}

-- | @'count' n p@ parses @n@ occurrences of @p@. If @n@ is smaller or equal
-- to zero, the parser equals to @'pure' []@. Returns a list of @n@ parsed
-- values.
--
-- > count = replicateM
--
-- See also: 'skipCount', 'count''.
count :: Applicative m => Int -> m a -> m [a]
count :: Int -> m a -> m [a]
count = Int -> m a -> m [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM
{-# 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 @'pure' []@. 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' :: Alternative m => Int -> Int -> m a -> m [a]
count' :: Int -> Int -> m a -> m [a]
count' Int
m' Int
n' m a
p = Int -> Int -> m [a]
forall a. (Ord a, Num a) => a -> a -> m [a]
go Int
m' Int
n'
  where
    go :: a -> a -> m [a]
go !a
m !a
n
      | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0 Bool -> Bool -> Bool
|| a
m a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
n = [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      | a
m a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 = (a -> [a] -> [a]) -> m a -> m [a] -> m [a]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) m a
p (a -> a -> m [a]
go (a
m a -> a -> a
forall a. Num a => a -> a -> a
- a
1) (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1))
      | Bool
otherwise = (a -> [a] -> [a]) -> m a -> m [a] -> m [a]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) m a
p (a -> a -> m [a]
go a
0 (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1)) m [a] -> m [a] -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
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 :: m a -> m b -> m (Either a b)
eitherP m a
a m b
b = (a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> m a -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
a) m (Either a b) -> m (Either a b) -> m (Either a b)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> m b -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
b)
{-# INLINE eitherP #-}

-- | @'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 :: Alternative 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 (f :: * -> *) a. Alternative f => f a -> f [a]
many (m a
p m a -> m sep -> m a
forall (f :: * -> *) a b. Applicative f => 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 :: Alternative 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 (f :: * -> *) a. Alternative f => f a -> f [a]
some (m a
p m a -> m sep -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m sep
sep)
{-# INLINE endBy1 #-}

-- | @'manyTill' p end@ applies parser @p@ /zero/ or more times until parser
-- @end@ succeeds. Returns the list of values returned by @p@. @end@ result
-- 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 :: m a -> m end -> m [a]
manyTill m a
p m end
end = m [a]
go
  where
    go :: m [a]
go = ([] [a] -> m end -> m [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m end
end) m [a] -> m [a] -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> [a] -> [a]) -> m a -> m [a] -> m [a]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) m a
p m [a]
go
{-# 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_ :: Alternative m => m a -> m end -> m ([a], end)
manyTill_ :: m a -> m end -> m ([a], end)
manyTill_ m a
p m end
end = m ([a], end)
go
  where
    go :: m ([a], end)
go = (([],) (end -> ([a], end)) -> m end -> m ([a], end)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m end
end) m ([a], end) -> m ([a], end) -> m ([a], end)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> ([a], end) -> ([a], end))
-> m a -> m ([a], end) -> m ([a], end)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\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], end)
go
{-# INLINE manyTill_ #-}

-- | @'someTill' p end@ works similarly to @'manyTill' p end@, but @p@
-- should succeed at least once. @end@ result is consumed and lost. Use
-- 'someTill_' if you wish to keep it.
--
-- > someTill p end = liftA2 (:) p (manyTill p end)
--
-- See also: 'skipSome', 'skipSomeTill'.
someTill :: Alternative 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 (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) m a
p (m a -> m end -> m [a]
forall (m :: * -> *) a end. Alternative 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_ :: Alternative 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 (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\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.
Alternative m =>
m a -> m end -> m ([a], end)
manyTill_ m a
p m end
end)
{-# INLINE someTill_ #-}

-- | @'option' x p@ tries to apply the parser @p@. If @p@ fails without
-- consuming input, it returns the value @x@, otherwise the value returned
-- by @p@.
--
-- > option x p = p <|> pure x
--
-- See also: 'optional'.
option :: Alternative m => a -> m a -> m a
option :: a -> m a -> m a
option a
x m a
p = m a
p m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# INLINE option #-}

-- | @'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 :: Alternative m => m a -> m sep -> m [a]
sepBy :: m a -> m sep -> m [a]
sepBy m a
p m sep
sep = m a -> m sep -> m [a]
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m [a]
sepBy1 m a
p m sep
sep m [a] -> m [a] -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
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 :: m a -> m sep -> m [a]
sepBy1 m a
p m sep
sep = (a -> [a] -> [a]) -> m a -> m [a] -> m [a]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) m a
p (m a -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (m sep
sep m sep -> m a -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f 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 :: Alternative m => m a -> m sep -> m [a]
sepEndBy :: m a -> m sep -> m [a]
sepEndBy m a
p m sep
sep = m a -> m sep -> m [a]
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m [a]
sepEndBy1 m a
p m sep
sep m [a] -> m [a] -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
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 :: m a -> m sep -> m [a]
sepEndBy1 m a
p m sep
sep = (a -> [a] -> [a]) -> m a -> m [a] -> m [a]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) m a
p ((m sep
sep m sep -> m [a] -> m [a]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a -> m sep -> m [a]
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m [a]
sepEndBy m a
p m sep
sep) m [a] -> m [a] -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
{-# INLINEABLE sepEndBy1 #-}

-- | @'skipMany' p@ applies the parser @p@ /zero/ or more times, skipping
-- its result.
--
-- See also: 'manyTill', 'skipManyTill'.
skipMany :: Alternative m => m a -> m ()
skipMany :: m a -> m ()
skipMany m a
p = m ()
go
  where
    go :: m ()
go = (m a
p m a -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m ()
go) m () -> m () -> m ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-# INLINE skipMany #-}

-- | @'skipSome' p@ applies the parser @p@ /one/ or more times, skipping its
-- result.
--
-- See also: 'someTill', 'skipSomeTill'.
skipSome :: Alternative m => m a -> m ()
skipSome :: m a -> m ()
skipSome m a
p = m a
p m a -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a -> m ()
forall (m :: * -> *) a. Alternative m => m a -> m ()
skipMany m a
p
{-# INLINE skipSome #-}

-- | @'skipCount' n p@ parses @n@ occurrences of @p@, skipping its result.
-- 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 :: Int -> m a -> m ()
skipCount = Int -> m a -> m ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_
{-# 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 :: Alternative 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 = m end
end m end -> m end -> m end
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (m a
p m a -> m end -> m end
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m end
go)
{-# 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 :: Alternative 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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a -> m end -> m end
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m end
skipManyTill m a
p m end
end
{-# INLINE skipSomeTill #-}