{-# LANGUAGE PatternSynonyms #-}
{-|
Module      : Parsley.Fold
Description : The "folding" combinators: chains and iterators
License     : BSD-3-Clause
Maintainer  : Jamie Willis
Stability   : stable

This module contains the combinator concerned with some form of iteration or input folding. Notably,
this includes the traditional `many` and `some` combinators.

@since 0.1.0.0
-}
module Parsley.Fold (
    many, some, manyN,
    skipMany, skipSome, skipManyN, --loop,
    sepBy, sepBy1, endBy, endBy1, sepEndBy, sepEndBy1,
    chainl1, chainr1, chainl, chainr,
    infixl1, infixr1, prefix, postfix,
    manyr, manyl,
    somer, somel
  ) where

import Prelude hiding           (pure, (<*>), (<$>), (*>), (<*))
import Parsley.Alternative      ((<|>), option)
import Parsley.Applicative      (pure, (<*>), (<$>), (*>), (<*), (<:>), (<**>), void)
import Parsley.Defunctionalized (Defunc(FLIP, ID, COMPOSE, EMPTY, CONS, CONST), pattern FLIP_H, pattern UNIT)
import Parsley.Internal         (Parser)
import Parsley.ParserOps        (ParserOps)
import Parsley.Register         (get, modify, newRegister)

import qualified Parsley.Internal as Internal (loop)

{-|
The combinator @loop body exit@ parses @body@ zero or more times until it fails. If the final @body@
failed having not consumed input, @exit@ is performed, otherwise the combinator fails:

> loop body exit = let go = body *> go <|> exit in go

@since 2.0.0.0
-}
loop :: Parser () -> Parser a -> Parser a
loop :: forall a. Parser () -> Parser a -> Parser a
loop = forall a. Parser () -> Parser a -> Parser a
Internal.loop

{-|
This combinator parses repeated applications of an operator to a single final operand. This is
primarily used to parse prefix operators in expressions.

@since 2.0.0.0
-}
prefix :: Parser (a -> a) -> Parser a -> Parser a
prefix :: forall a. Parser (a -> a) -> Parser a -> Parser a
prefix Parser (a -> a)
op Parser a
p = forall a. Parser a -> Parser (a -> a) -> Parser a
postfix (forall (rep :: Type -> Type) a. ParserOps rep => rep a -> Parser a
pure forall a1. Defunc (a1 -> a1)
ID) (forall y x a b c.
((x -> y) ~ ((a -> b -> c) -> b -> a -> c)) =>
Defunc x -> Defunc y
FLIP_H forall b c a1. Defunc ((b -> c) -> (a1 -> b) -> a1 -> c)
COMPOSE forall (rep :: Type -> Type) a b.
ParserOps rep =>
rep (a -> b) -> Parser a -> Parser b
<$> Parser (a -> a)
op) forall a b. Parser (a -> b) -> Parser a -> Parser b
<*> Parser a
p

{-|
This combinator parses repeated applications of an operator to a single initial operand. This is
primarily used to parse postfix operators in expressions.

@since 2.0.0.0
-}
postfix :: Parser a -> Parser (a -> a) -> Parser a
postfix :: forall a. Parser a -> Parser (a -> a) -> Parser a
postfix Parser a
p Parser (a -> a)
op =
  forall a b. Parser a -> (forall r. Reg r a -> Parser b) -> Parser b
newRegister Parser a
p forall a b. (a -> b) -> a -> b
$ \Reg r a
r ->
    forall a. Parser () -> Parser a -> Parser a
loop (forall r a. Reg r a -> Parser (a -> a) -> Parser ()
modify Reg r a
r Parser (a -> a)
op)
         (forall r a. Reg r a -> Parser a
get Reg r a
r)

-- Parser Folds
{-|
@manyr f k p@ parses __zero__ or more @p@s and combines the results using the function @f@. When @p@
fails without consuming input, the terminal result @k@ is returned.

> many = manyr CONS EMPTY

@since 2.0.0.0
-}
manyr :: (ParserOps repf, ParserOps repk) => repf (a -> b -> b) -> repk b -> Parser a -> Parser b
manyr :: forall (repf :: Type -> Type) (repk :: Type -> Type) a b.
(ParserOps repf, ParserOps repk) =>
repf (a -> b -> b) -> repk b -> Parser a -> Parser b
manyr repf (a -> b -> b)
f repk b
k Parser a
p = forall a. Parser (a -> a) -> Parser a -> Parser a
prefix (repf (a -> b -> b)
f forall (rep :: Type -> Type) a b.
ParserOps rep =>
rep (a -> b) -> Parser a -> Parser b
<$> Parser a
p) (forall (rep :: Type -> Type) a. ParserOps rep => rep a -> Parser a
pure repk b
k)

{-|
@somer f k p@ parses __one__ or more @p@s and combines the results using the function @f@. When @p@
fails without consuming input, the terminal result @k@ is returned.

> some = somer CONS EMPTY

@since 2.0.0.0
-}
somer :: (ParserOps repf, ParserOps repk) => repf (a -> b -> b) -> repk b -> Parser a -> Parser b
somer :: forall (repf :: Type -> Type) (repk :: Type -> Type) a b.
(ParserOps repf, ParserOps repk) =>
repf (a -> b -> b) -> repk b -> Parser a -> Parser b
somer repf (a -> b -> b)
f repk b
k Parser a
p = repf (a -> b -> b)
f forall (rep :: Type -> Type) a b.
ParserOps rep =>
rep (a -> b) -> Parser a -> Parser b
<$> Parser a
p forall a b. Parser (a -> b) -> Parser a -> Parser b
<*> forall (repf :: Type -> Type) (repk :: Type -> Type) a b.
(ParserOps repf, ParserOps repk) =>
repf (a -> b -> b) -> repk b -> Parser a -> Parser b
manyr repf (a -> b -> b)
f repk b
k Parser a
p

{-|
@manyl f k p@ parses __zero__ or more @p@s and combines the results using the function @f@. The
accumulator is initialised with the value @k@.

@since 2.0.0.0
-}
manyl :: (ParserOps repf, ParserOps repk) => repf (b -> a -> b) -> repk b -> Parser a -> Parser b
manyl :: forall (repf :: Type -> Type) (repk :: Type -> Type) b a.
(ParserOps repf, ParserOps repk) =>
repf (b -> a -> b) -> repk b -> Parser a -> Parser b
manyl repf (b -> a -> b)
f repk b
k Parser a
p = forall a. Parser a -> Parser (a -> a) -> Parser a
postfix (forall (rep :: Type -> Type) a. ParserOps rep => rep a -> Parser a
pure repk b
k) ((forall a1 b c. Defunc ((a1 -> b -> c) -> b -> a1 -> c)
FLIP forall (rep :: Type -> Type) a b.
ParserOps rep =>
rep (a -> b) -> Parser a -> Parser b
<$> forall (rep :: Type -> Type) a. ParserOps rep => rep a -> Parser a
pure repf (b -> a -> b)
f) forall a b. Parser (a -> b) -> Parser a -> Parser b
<*> Parser a
p)

{-|
@somel f k p@ parses __one__ or more @p@s and combines the results using the function @f@. The
accumulator is initialised with the value @k@.

@since 2.0.0.0
-}
somel :: (ParserOps repf, ParserOps repk) => repf (b -> a -> b) -> repk b -> Parser a -> Parser b
somel :: forall (repf :: Type -> Type) (repk :: Type -> Type) b a.
(ParserOps repf, ParserOps repk) =>
repf (b -> a -> b) -> repk b -> Parser a -> Parser b
somel repf (b -> a -> b)
f repk b
k Parser a
p = forall a. Parser a -> Parser (a -> a) -> Parser a
postfix (repf (b -> a -> b)
f forall (rep :: Type -> Type) a b.
ParserOps rep =>
rep (a -> b) -> Parser a -> Parser b
<$> forall (rep :: Type -> Type) a. ParserOps rep => rep a -> Parser a
pure repk b
k forall a b. Parser (a -> b) -> Parser a -> Parser b
<*> Parser a
p) ((forall a1 b c. Defunc ((a1 -> b -> c) -> b -> a1 -> c)
FLIP forall (rep :: Type -> Type) a b.
ParserOps rep =>
rep (a -> b) -> Parser a -> Parser b
<$> forall (rep :: Type -> Type) a. ParserOps rep => rep a -> Parser a
pure repf (b -> a -> b)
f) forall a b. Parser (a -> b) -> Parser a -> Parser b
<*> Parser a
p)

-- Chain Combinators
{-|
@infixl1 wrap p op @ parses one or more occurrences of @p@, separated by @op@. Returns a value obtained
by a /left/ associative application of all functions returned by @op@ to the values returned by @p@.
The function @wrap@ is used to transform the initial value from @p@ into the correct form.

@since 2.0.0.0
-}
infixl1 :: ParserOps rep => rep (a -> b) -> Parser a -> Parser (b -> a -> b) -> Parser b
infixl1 :: forall (rep :: Type -> Type) a b.
ParserOps rep =>
rep (a -> b) -> Parser a -> Parser (b -> a -> b) -> Parser b
infixl1 rep (a -> b)
wrap Parser a
p Parser (b -> a -> b)
op = forall a. Parser a -> Parser (a -> a) -> Parser a
postfix (rep (a -> b)
wrap forall (rep :: Type -> Type) a b.
ParserOps rep =>
rep (a -> b) -> Parser a -> Parser b
<$> Parser a
p) (forall a1 b c. Defunc ((a1 -> b -> c) -> b -> a1 -> c)
FLIP forall (rep :: Type -> Type) a b.
ParserOps rep =>
rep (a -> b) -> Parser a -> Parser b
<$> Parser (b -> a -> b)
op forall a b. Parser (a -> b) -> Parser a -> Parser b
<*> Parser a
p)

{-|
The classic version of the left-associative chain combinator. See 'infixl1'.

> chainl1 p op = infixl1 ID p op

@since 0.1.0.0
-}
chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
chainl1 :: forall a. Parser a -> Parser (a -> a -> a) -> Parser a
chainl1 = forall (rep :: Type -> Type) a b.
ParserOps rep =>
rep (a -> b) -> Parser a -> Parser (b -> a -> b) -> Parser b
infixl1 forall a1. Defunc (a1 -> a1)
ID

{-|
@infixr1 wrap p op @ parses one or more occurrences of @p@, separated by @op@. Returns a value obtained
by a /right/ associative application of all functions returned by @op@ to the values returned by @p@.
The function @wrap@ is used to transform the final value from @p@ into the correct form.

@since 2.0.0.0
-}
infixr1 :: ParserOps rep => rep (a -> b) -> Parser a -> Parser (a -> b -> b) -> Parser b
infixr1 :: forall (rep :: Type -> Type) a b.
ParserOps rep =>
rep (a -> b) -> Parser a -> Parser (a -> b -> b) -> Parser b
infixr1 rep (a -> b)
wrap Parser a
p Parser (a -> b -> b)
op = let go :: Parser b
go = Parser a
p forall a b. Parser a -> Parser (a -> b) -> Parser b
<**> (forall a1 b c. Defunc ((a1 -> b -> c) -> b -> a1 -> c)
FLIP forall (rep :: Type -> Type) a b.
ParserOps rep =>
rep (a -> b) -> Parser a -> Parser b
<$> Parser (a -> b -> b)
op forall a b. Parser (a -> b) -> Parser a -> Parser b
<*> Parser b
go forall a. Parser a -> Parser a -> Parser a
<|> forall (rep :: Type -> Type) a. ParserOps rep => rep a -> Parser a
pure rep (a -> b)
wrap) in Parser b
go

{-|
The classic version of the right-associative chain combinator. See 'infixr1'.

> chainr1 p op = infixr1 ID p op

@since 0.1.0.0
-}
chainr1 :: Parser a -> Parser (a -> a -> a) -> Parser a
chainr1 :: forall a. Parser a -> Parser (a -> a -> a) -> Parser a
chainr1 = forall (rep :: Type -> Type) a b.
ParserOps rep =>
rep (a -> b) -> Parser a -> Parser (a -> b -> b) -> Parser b
infixr1 forall a1. Defunc (a1 -> a1)
ID

{-|
Like `chainr1`, but may parse zero occurences of @p@ in which case the value is returned.

@since 0.1.0.0
-}
chainr :: ParserOps rep => Parser a -> Parser (a -> a -> a) -> rep a -> Parser a
chainr :: forall (rep :: Type -> Type) a.
ParserOps rep =>
Parser a -> Parser (a -> a -> a) -> rep a -> Parser a
chainr Parser a
p Parser (a -> a -> a)
op rep a
x = forall (rep :: Type -> Type) a.
ParserOps rep =>
rep a -> Parser a -> Parser a
option rep a
x (forall a. Parser a -> Parser (a -> a -> a) -> Parser a
chainr1 Parser a
p Parser (a -> a -> a)
op)

{-|
Like `chainl1`, but may parse zero occurences of @p@ in which case the value is returned.

@since 0.1.0.0
-}
chainl :: ParserOps rep => Parser a -> Parser (a -> a -> a) -> rep a -> Parser a
chainl :: forall (rep :: Type -> Type) a.
ParserOps rep =>
Parser a -> Parser (a -> a -> a) -> rep a -> Parser a
chainl Parser a
p Parser (a -> a -> a)
op rep a
x = forall (rep :: Type -> Type) a.
ParserOps rep =>
rep a -> Parser a -> Parser a
option rep a
x (forall a. Parser a -> Parser (a -> a -> a) -> Parser a
chainl1 Parser a
p Parser (a -> a -> a)
op)

-- Derived Combinators
{-|
Attempts to parse the given parser __zero__ or more times, collecting all of the successful results
into a list. Same as @manyN 0@

@since 0.1.0.0
-}
many :: Parser a -> Parser [a]
many :: forall a. Parser a -> Parser [a]
many = forall (repf :: Type -> Type) (repk :: Type -> Type) a b.
(ParserOps repf, ParserOps repk) =>
repf (a -> b -> b) -> repk b -> Parser a -> Parser b
manyr forall a1. Defunc (a1 -> [a1] -> [a1])
CONS forall a1. Defunc [a1]
EMPTY

{-|
Attempts to parse the given parser __n__ or more times, collecting all of the successful results
into a list.

@since 0.1.0.0
-}
manyN :: Int -> Parser a -> Parser [a]
manyN :: forall a. Int -> Parser a -> Parser [a]
manyN Int
n Parser a
p = forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b. a -> b -> a
const (Parser a
p forall a. Parser a -> Parser [a] -> Parser [a]
<:>)) (forall a. Parser a -> Parser [a]
many Parser a
p) [Int
1..Int
n]

{-|
Attempts to parse the given parser __one__ or more times, collecting all of the successful results
into a list. Same as @manyN 1@

@since 0.1.0.0
-}
some :: Parser a -> Parser [a]
some :: forall a. Parser a -> Parser [a]
some = forall a. Int -> Parser a -> Parser [a]
manyN Int
1

{-|
Like `many`, excepts discards its results.

@since 0.1.0.0
-}
skipMany :: Parser a -> Parser ()
--skipMany p = loop (void p) unit
skipMany :: forall a. Parser a -> Parser ()
skipMany = forall a. Parser a -> Parser ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (repf :: Type -> Type) (repk :: Type -> Type) b a.
(ParserOps repf, ParserOps repk) =>
repf (b -> a -> b) -> repk b -> Parser a -> Parser b
manyl forall a1 b. Defunc (a1 -> b -> a1)
CONST Defunc ()
UNIT -- This is still faster, the above generates better code, but GHC starts doing weird things!

{-|
Like `manyN`, excepts discards its results.

@since 0.1.0.0
-}
skipManyN :: Int -> Parser a -> Parser ()
skipManyN :: forall a. Int -> Parser a -> Parser ()
skipManyN Int
n Parser a
p = forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a b. a -> b -> a
const (Parser a
p forall a b. Parser a -> Parser b -> Parser b
*>)) (forall a. Parser a -> Parser ()
skipMany Parser a
p) [Int
1..Int
n]

{-|
Like `some`, excepts discards its results.

@since 0.1.0.0
-}
skipSome :: Parser a -> Parser ()
skipSome :: forall a. Parser a -> Parser ()
skipSome = forall a. Int -> Parser a -> Parser ()
skipManyN Int
1

{-|
@sepBy p sep@ parses __zero__ or more occurrences of @p@, separated by @sep@.
Returns a list of values returned by @p@.

@since 0.1.0.0
-}
sepBy :: Parser a -> Parser b -> Parser [a]
sepBy :: forall a b. Parser a -> Parser b -> Parser [a]
sepBy Parser a
p Parser b
sep = forall (rep :: Type -> Type) a.
ParserOps rep =>
rep a -> Parser a -> Parser a
option forall a1. Defunc [a1]
EMPTY (forall a b. Parser a -> Parser b -> Parser [a]
sepBy1 Parser a
p Parser b
sep)

{-|
@sepBy1 p sep@ parses __one__ or more occurrences of @p@, separated by @sep@.
Returns a list of values returned by @p@.

@since 0.1.0.0
-}
sepBy1 :: Parser a -> Parser b -> Parser [a]
sepBy1 :: forall a b. Parser a -> Parser b -> Parser [a]
sepBy1 Parser a
p Parser b
sep = Parser a
p forall a. Parser a -> Parser [a] -> Parser [a]
<:> forall a. Parser a -> Parser [a]
many (Parser b
sep forall a b. Parser a -> Parser b -> Parser b
*> Parser a
p)

{-|
@endBy p sep@ parses __zero__ or more occurrences of @p@, separated and ended by @sep@.
Returns a list of values returned by @p@.

@since 0.1.0.0
-}
endBy :: Parser a -> Parser b -> Parser [a]
endBy :: forall a b. Parser a -> Parser b -> Parser [a]
endBy Parser a
p Parser b
sep = forall a. Parser a -> Parser [a]
many (Parser a
p forall a b. Parser a -> Parser b -> Parser a
<* Parser b
sep)

{-|
@endBy1 p sep@ parses __one__ or more occurrences of @p@, separated and ended by @sep@.
Returns a list of values returned by @p@.

@since 0.1.0.0
-}
endBy1 :: Parser a -> Parser b -> Parser [a]
endBy1 :: forall a b. Parser a -> Parser b -> Parser [a]
endBy1 Parser a
p Parser b
sep = forall a. Parser a -> Parser [a]
some (Parser a
p forall a b. Parser a -> Parser b -> Parser a
<* Parser b
sep)

{-|
@sepEndBy p sep@ parses __zero__ or more occurrences of @p@, separated and /optionally/ ended by @sep@.
Returns a list of values returned by @p@.

@since 0.1.0.0
-}
sepEndBy :: Parser a -> Parser b -> Parser [a]
sepEndBy :: forall a b. Parser a -> Parser b -> Parser [a]
sepEndBy Parser a
p Parser b
sep = forall (rep :: Type -> Type) a.
ParserOps rep =>
rep a -> Parser a -> Parser a
option forall a1. Defunc [a1]
EMPTY (forall a b. Parser a -> Parser b -> Parser [a]
sepEndBy1 Parser a
p Parser b
sep)

{-|
@sepEndBy1 p sep@ parses __one__ or more occurrences of @p@, separated and /optionally/ ended by @sep@.
Returns a list of values returned by @p@.

@since 0.1.0.0
-}
sepEndBy1 :: Parser a -> Parser b -> Parser [a]
sepEndBy1 :: forall a b. Parser a -> Parser b -> Parser [a]
sepEndBy1 Parser a
p Parser b
sep =
  let seb1 :: Parser [a]
seb1 = Parser a
p forall a. Parser a -> Parser [a] -> Parser [a]
<:> forall (rep :: Type -> Type) a.
ParserOps rep =>
rep a -> Parser a -> Parser a
option forall a1. Defunc [a1]
EMPTY (Parser b
sep forall a b. Parser a -> Parser b -> Parser b
*> forall (rep :: Type -> Type) a.
ParserOps rep =>
rep a -> Parser a -> Parser a
option forall a1. Defunc [a1]
EMPTY Parser [a]
seb1)
  in Parser [a]
seb1