module ParseLib.Simple.Derived
  (
    module ParseLib.Simple.Core,
    -- * Derived combinators
    (<$),
    (<*),
    (*>),
    epsilon,
    symbol,
    token,
    pack,
    sequence,
    choice,
    -- * EBNF parser combinators 
    option,
    optional,
    many,
    some, many1,
    listOf,
    -- * Chain expression combinators
    chainr,
    chainl,
    -- * Greedy parsers
    greedy,
    greedy1,
    -- * End of input
    eof
  )
  where

import Data.List (stripPrefix)
import Prelude hiding ((>>=), (<$), (<*), (*>), (<*>), (<$>), sequence)
import ParseLib.Simple.Core

infixl 4 <$
infixl 4 <*
infixl 4 *>

-- | Variant of '<$>' that ignores the result of the parser.
--
-- > f <$ p = const f <$> p
--
(<$) :: b -> Parser s a -> Parser s b
b
f <$ :: forall b s a. b -> Parser s a -> Parser s b
<$ Parser s a
p = b -> a -> b
forall a b. a -> b -> a
const b
f (a -> b) -> Parser s a -> Parser s b
forall a b s. (a -> b) -> Parser s a -> Parser s b
<$> Parser s a
p

-- | Variant of '<*>' that ignores the result of the right
-- argument.
--
-- > f <* p = const <$> p <*> q
--
(<*) :: Parser s a -> Parser s b -> Parser s a
Parser s a
p <* :: forall s a b. Parser s a -> Parser s b -> Parser s a
<* Parser s b
q = a -> b -> a
forall a b. a -> b -> a
const (a -> b -> a) -> Parser s a -> Parser s (b -> a)
forall a b s. (a -> b) -> Parser s a -> Parser s b
<$> Parser s a
p Parser s (b -> a) -> Parser s b -> Parser s a
forall s b a. Parser s (b -> a) -> Parser s b -> Parser s a
<*> Parser s b
q

-- | Variant of '*>' that ignores the result of the left
-- argument.
--
-- > f *> p = flip const <$> p <*> q
--
(*>) :: Parser s a -> Parser s b -> Parser s b
Parser s a
p *> :: forall s a b. Parser s a -> Parser s b -> Parser s b
*> Parser s b
q = (b -> a -> b) -> a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> a -> b
forall a b. a -> b -> a
const (a -> b -> b) -> Parser s a -> Parser s (b -> b)
forall a b s. (a -> b) -> Parser s a -> Parser s b
<$> Parser s a
p Parser s (b -> b) -> Parser s b -> Parser s b
forall s b a. Parser s (b -> a) -> Parser s b -> Parser s a
<*> Parser s b
q

-- | Parser for epsilon that does return '()'.
epsilon :: Parser s ()
epsilon :: forall s. Parser s ()
epsilon = () -> Parser s ()
forall a s. a -> Parser s a
succeed ()

-- | Parses a specific given symbol.
symbol :: Eq s  => s -> Parser s s
symbol :: forall s. Eq s => s -> Parser s s
symbol s
s (s
x:[s]
xs) | s
s s -> s -> Bool
forall a. Eq a => a -> a -> Bool
== s
x = ([(s
x,[s]
xs)], DifferenceList (ParseError [s])
forall a. Monoid a => a
mempty)
symbol s
s [s]
input = [s] -> Parser s s
forall s a. [s] -> Parser s a
expected [s
s] [s]
input

-- | Parses a specific given sequence of symbols.
token :: Eq s => [s] -> Parser s [s]
token :: forall s. Eq s => [s] -> Parser s [s]
token [s]
t [s]
input =
  case [s] -> [s] -> Maybe [s]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [s]
t [s]
input of
    Maybe [s]
Nothing -> [s] -> Parser s [s]
forall s a. [s] -> Parser s a
expected [s]
t [s]
input
    Just [s]
rest -> ([([s]
t, [s]
rest)], DifferenceList (ParseError [s])
forall a. Monoid a => a
mempty)

-- | Takes three parsers: a delimiter, the parser for the
-- content, and another delimiter. Constructs a sequence of
-- the three, but returns only the result of the enclosed
-- parser.
pack :: Parser s a -> Parser s b -> Parser s c -> Parser s b
pack :: forall s a b c.
Parser s a -> Parser s b -> Parser s c -> Parser s b
pack Parser s a
p Parser s b
r Parser s c
q  =  Parser s a
p Parser s a -> Parser s b -> Parser s b
forall s a b. Parser s a -> Parser s b -> Parser s b
*> Parser s b
r Parser s b -> Parser s c -> Parser s b
forall s a b. Parser s a -> Parser s b -> Parser s a
<* Parser s c
q

-- | Takes a list of parsers and combines them in
-- sequence, returning a list of results.
sequence :: [Parser s a] -> Parser s [a]
sequence :: forall s a. [Parser s a] -> Parser s [a]
sequence []      =  [a] -> Parser s [a]
forall a s. a -> Parser s a
succeed []
sequence (Parser s a
p:[Parser s a]
ps)  =  (:) (a -> [a] -> [a]) -> Parser s a -> Parser s ([a] -> [a])
forall a b s. (a -> b) -> Parser s a -> Parser s b
<$> Parser s a
p Parser s ([a] -> [a]) -> Parser s [a] -> Parser s [a]
forall s b a. Parser s (b -> a) -> Parser s b -> Parser s a
<*> [Parser s a] -> Parser s [a]
forall s a. [Parser s a] -> Parser s [a]
sequence [Parser s a]
ps

-- | Takes a list of parsers and combines them using
-- choice.
choice :: [Parser s a] -> Parser s a
choice :: forall s a. [Parser s a] -> Parser s a
choice = (Parser s a -> Parser s a -> Parser s a)
-> Parser s a -> [Parser s a] -> Parser s a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Parser s a -> Parser s a -> Parser s a
forall s a. Parser s a -> Parser s a -> Parser s a
(<|>) Parser s a
forall s a. Parser s a
empty

-- | Parses an optional element. Takes the default value
-- as its second argument.
option :: Parser s a -> a -> Parser s a
option :: forall s a. Parser s a -> a -> Parser s a
option Parser s a
p a
d = Parser s a
p Parser s a -> Parser s a -> Parser s a
forall s a. Parser s a -> Parser s a -> Parser s a
<|> a -> Parser s a
forall a s. a -> Parser s a
succeed a
d

-- | Variant of 'option' that returns a 'Maybe',
-- provided for compatibility with the applicative interface.
optional :: Parser s a -> Parser s (Maybe a)
optional :: forall s a. Parser s a -> Parser s (Maybe a)
optional Parser s a
p = Parser s (Maybe a) -> Maybe a -> Parser s (Maybe a)
forall s a. Parser s a -> a -> Parser s a
option (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Parser s a -> Parser s (Maybe a)
forall a b s. (a -> b) -> Parser s a -> Parser s b
<$> Parser s a
p) Maybe a
forall a. Maybe a
Nothing

-- | Parses many, i.e., zero or more, occurrences of
-- a given parser.
many :: Parser s a  -> Parser s [a]
many :: forall s a. Parser s a -> Parser s [a]
many Parser s a
p  =  (:) (a -> [a] -> [a]) -> Parser s a -> Parser s ([a] -> [a])
forall a b s. (a -> b) -> Parser s a -> Parser s b
<$> Parser s a
p Parser s ([a] -> [a]) -> Parser s [a] -> Parser s [a]
forall s b a. Parser s (b -> a) -> Parser s b -> Parser s a
<*> Parser s a -> Parser s [a]
forall s a. Parser s a -> Parser s [a]
many Parser s a
p Parser s [a] -> Parser s [a] -> Parser s [a]
forall s a. Parser s a -> Parser s a -> Parser s a
<|> [a] -> Parser s [a]
forall a s. a -> Parser s a
succeed []

-- | Parser some, i.e., one or more, occurrences of
-- a given parser.
some :: Parser s a -> Parser s [a]
some :: forall s a. Parser s a -> Parser s [a]
some Parser s a
p = (:) (a -> [a] -> [a]) -> Parser s a -> Parser s ([a] -> [a])
forall a b s. (a -> b) -> Parser s a -> Parser s b
<$> Parser s a
p Parser s ([a] -> [a]) -> Parser s [a] -> Parser s [a]
forall s b a. Parser s (b -> a) -> Parser s b -> Parser s a
<*> Parser s a -> Parser s [a]
forall s a. Parser s a -> Parser s [a]
many Parser s a
p

-- | Same as 'some'. Provided for compatibility with
-- the lecture notes.
many1 :: Parser s a -> Parser s [a]
many1 :: forall s a. Parser s a -> Parser s [a]
many1 = Parser s a -> Parser s [a]
forall s a. Parser s a -> Parser s [a]
some

-- | Takes a parser @p@ and a separator parser @s@. Parses
-- a sequence of @p@s that is separated by @s@s.
listOf :: Parser s a -> Parser s b -> Parser s [a]
listOf :: forall s a b. Parser s a -> Parser s b -> Parser s [a]
listOf Parser s a
p Parser s b
s = (:) (a -> [a] -> [a]) -> Parser s a -> Parser s ([a] -> [a])
forall a b s. (a -> b) -> Parser s a -> Parser s b
<$> Parser s a
p Parser s ([a] -> [a]) -> Parser s [a] -> Parser s [a]
forall s b a. Parser s (b -> a) -> Parser s b -> Parser s a
<*> Parser s a -> Parser s [a]
forall s a. Parser s a -> Parser s [a]
many (Parser s b
s Parser s b -> Parser s a -> Parser s a
forall s a b. Parser s a -> Parser s b -> Parser s b
*> Parser s a
p)

-- | Takes a parser @pe@ and an operator parser @po@. Parses
-- a sequence of @pe@s separated by @po@s. The results are
-- combined using the operator associated with @po@ in a
-- right-associative way.
chainr  ::  Parser s a -> Parser s (a -> a -> a) -> Parser s a
chainr :: forall s a. Parser s a -> Parser s (a -> a -> a) -> Parser s a
chainr Parser s a
pe Parser s (a -> a -> a)
po  =  [a -> a] -> a -> a
forall {t :: * -> *} {b}. Foldable t => t (b -> b) -> b -> b
h ([a -> a] -> a -> a) -> Parser s [a -> a] -> Parser s (a -> a)
forall a b s. (a -> b) -> Parser s a -> Parser s b
<$> Parser s (a -> a) -> Parser s [a -> a]
forall s a. Parser s a -> Parser s [a]
many (a -> (a -> a -> a) -> a -> a
forall {t} {a} {b}. t -> (t -> a -> b) -> a -> b
j (a -> (a -> a -> a) -> a -> a)
-> Parser s a -> Parser s ((a -> a -> a) -> a -> a)
forall a b s. (a -> b) -> Parser s a -> Parser s b
<$> Parser s a
pe Parser s ((a -> a -> a) -> a -> a)
-> Parser s (a -> a -> a) -> Parser s (a -> a)
forall s b a. Parser s (b -> a) -> Parser s b -> Parser s a
<*> Parser s (a -> a -> a)
po) Parser s (a -> a) -> Parser s a -> Parser s a
forall s b a. Parser s (b -> a) -> Parser s b -> Parser s a
<*> Parser s a
pe
  where j :: t -> (t -> a -> b) -> a -> b
j t
x t -> a -> b
op  =  (t
x t -> a -> b
`op`)
        h :: t (b -> b) -> b -> b
h t (b -> b)
fs b
x  =  ((b -> b) -> b -> b) -> b -> t (b -> b) -> b
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
($) b
x t (b -> b)
fs

-- | Takes a parser @pe@ and an operator parser @po@. Parses
-- a sequence of @pe@s separated by @po@s. The results are
-- combined using the operator associated with @po@ in a
-- left-associative way.
chainl  ::  Parser s a -> Parser s (a -> a -> a) -> Parser s a
chainl :: forall s a. Parser s a -> Parser s (a -> a -> a) -> Parser s a
chainl Parser s a
pe Parser s (a -> a -> a)
po  =  a -> [a -> a] -> a
forall {t :: * -> *} {b}. Foldable t => b -> t (b -> b) -> b
h (a -> [a -> a] -> a) -> Parser s a -> Parser s ([a -> a] -> a)
forall a b s. (a -> b) -> Parser s a -> Parser s b
<$> Parser s a
pe Parser s ([a -> a] -> a) -> Parser s [a -> a] -> Parser s a
forall s b a. Parser s (b -> a) -> Parser s b -> Parser s a
<*> Parser s (a -> a) -> Parser s [a -> a]
forall s a. Parser s a -> Parser s [a]
many ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
j ((a -> a -> a) -> a -> a -> a)
-> Parser s (a -> a -> a) -> Parser s (a -> a -> a)
forall a b s. (a -> b) -> Parser s a -> Parser s b
<$> Parser s (a -> a -> a)
po Parser s (a -> a -> a) -> Parser s a -> Parser s (a -> a)
forall s b a. Parser s (b -> a) -> Parser s b -> Parser s a
<*> Parser s a
pe)
  where j :: (a -> p -> c) -> p -> a -> c
j a -> p -> c
op p
x  =  (a -> p -> c
`op` p
x)
        h :: b -> t (b -> b) -> b
h b
x t (b -> b)
fs  =  (b -> (b -> b) -> b) -> b -> t (b -> b) -> b
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((b -> b) -> b -> b) -> b -> (b -> b) -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
($)) b
x t (b -> b)
fs

-- | Greedy variant of 'many'.
greedy :: Parser s b -> Parser s [b]
greedy :: forall s a. Parser s a -> Parser s [a]
greedy Parser s b
p  =  (:) (b -> [b] -> [b]) -> Parser s b -> Parser s ([b] -> [b])
forall a b s. (a -> b) -> Parser s a -> Parser s b
<$> Parser s b
p Parser s ([b] -> [b]) -> Parser s [b] -> Parser s [b]
forall s b a. Parser s (b -> a) -> Parser s b -> Parser s a
<*> Parser s b -> Parser s [b]
forall s a. Parser s a -> Parser s [a]
greedy Parser s b
p Parser s [b] -> Parser s [b] -> Parser s [b]
forall s a. Parser s a -> Parser s a -> Parser s a
<<|> [b] -> Parser s [b]
forall a s. a -> Parser s a
succeed []

-- | Greedy variant of 'many1'.
greedy1 :: Parser s b -> Parser s [b]
greedy1 :: forall s a. Parser s a -> Parser s [a]
greedy1 Parser s b
p = (:) (b -> [b] -> [b]) -> Parser s b -> Parser s ([b] -> [b])
forall a b s. (a -> b) -> Parser s a -> Parser s b
<$> Parser s b
p Parser s ([b] -> [b]) -> Parser s [b] -> Parser s [b]
forall s b a. Parser s (b -> a) -> Parser s b -> Parser s a
<*> Parser s b -> Parser s [b]
forall s a. Parser s a -> Parser s [a]
greedy Parser s b
p

-- | Succeeds only on the end of the input.
eof :: Parser s ()
eof :: forall s. Parser s ()
eof [s]
xs = if [s] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [s]
xs then ([((), [s]
xs)], DifferenceList (ParseError [s])
forall a. Monoid a => a
mempty) else [s] -> Parser s ()
forall s a. [s] -> Parser s a
expected [] [s]
xs