{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
{-|
Module      : Parsley.Combinator
Description : The parsing combinators
License     : BSD-3-Clause
Maintainer  : Jamie Willis
Stability   : stable

This module contains the classic parser combinator operations specific to parsers themselves.
This means any combinators that deal with input consumption at a primitive level.

@since 0.1.0.0
-}
module Parsley.Combinator (
    satisfy, char, item,
    string, token,
    oneOf, noneOf,
    eof, more,
    someTill,
    try,
    lookAhead, notFollowedBy
  ) where

import Prelude hiding      (traverse, (*>))
import Data.List           (sort)
import Parsley.Alternative (manyTill)
import Parsley.Applicative (($>), void, traverse, (<:>), (*>))
import Parsley.Internal    (Code, Quapplicative(..), Parser, Defunc(LIFTED, EQ_H, CONST, LAM_S), pattern APP_H, pattern COMPOSE_H, satisfy, lookAhead, try, notFollowedBy)

{-|
This combinator will attempt match a given string. If the parser fails midway through, this
combinator will fail having consumed input. On success, the string itself is returned and input
will be consumed.

@since 0.1.0.0
-}
string :: String -> Parser String
string :: String -> Parser String
string = (Char -> Parser Char) -> String -> Parser String
forall a b. (a -> Parser b) -> [a] -> Parser [b]
traverse Char -> Parser Char
char

{-|
This combinator will attempt to match any one of the provided list of characters. If one of those
characters is found, it will be returned and the input consumed. If not, the combinator will fail
having consumed no input.

@since 0.1.0.0
-}
oneOf :: [Char] -> Parser Char
oneOf :: String -> Parser Char
oneOf = Defunc (Char -> Bool) -> Parser Char
forall (rep :: Type -> Type).
ParserOps rep =>
rep (Char -> Bool) -> Parser Char
satisfy (Defunc (Char -> Bool) -> Parser Char)
-> (String -> Defunc (Char -> Bool)) -> String -> Parser Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Defunc (Char -> Bool)
elem'

{-|
This combinator will attempt to not match any one of the provided list of characters. If one of those
characters is found, the combinator will fail having consumed no input. If not, it will return
the character that was not an element of the provided list.

@since 0.1.0.0
-}
noneOf :: [Char] -> Parser Char
noneOf :: String -> Parser Char
noneOf = Defunc (Char -> Bool) -> Parser Char
forall (rep :: Type -> Type).
ParserOps rep =>
rep (Char -> Bool) -> Parser Char
satisfy (Defunc (Char -> Bool) -> Parser Char)
-> (String -> Defunc (Char -> Bool)) -> String -> Parser Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Defunc (Bool -> Bool)
-> Defunc (Char -> Bool) -> Defunc (Char -> Bool)
forall z x y b c a.
((x -> y -> z) ~ ((b -> c) -> (a -> b) -> a -> c)) =>
Defunc x -> Defunc y -> Defunc z
COMPOSE_H ((Bool -> Bool) -> Code (Bool -> Bool) -> Defunc (Bool -> Bool)
forall (q :: Type -> Type) a. Quapplicative q => a -> Code a -> q a
makeQ Bool -> Bool
not [||not||]) (Defunc (Char -> Bool) -> Defunc (Char -> Bool))
-> (String -> Defunc (Char -> Bool))
-> String
-> Defunc (Char -> Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Defunc (Char -> Bool)
elem'

elem' :: [Char] -> Defunc (Char -> Bool)
elem' :: String -> Defunc (Char -> Bool)
elem' String
cs = (Defunc Char -> Defunc Bool) -> Defunc (Char -> Bool)
forall a1 b. (Defunc a1 -> Defunc b) -> Defunc (a1 -> b)
LAM_S (\Defunc Char
c -> Bool -> Code Bool -> Defunc Bool
forall (q :: Type -> Type) a. Quapplicative q => a -> Code a -> q a
makeQ (Char -> String -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
elem (Defunc Char -> Char
forall (q :: Type -> Type) a. Quapplicative q => q a -> a
_val Defunc Char
c) String
cs) (String -> Code Char -> Code Bool
ofChars String
cs (Defunc Char -> Code Char
forall (q :: Type -> Type) a. Quapplicative q => q a -> Code a
_code Defunc Char
c)))

ofChars :: [Char] -> Code Char -> Code Bool
ofChars :: String -> Code Char -> Code Bool
ofChars [] Code Char
_ = [||False||]
ofChars String
cs Code Char
qc = (Code Bool -> Code Bool -> Code Bool) -> [Code Bool] -> Code Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> a -> a) -> t a -> a
foldr1 (\Code Bool
p Code Bool
q -> [|| $$p || $$q ||]) (((Char, Char) -> Code Bool) -> [(Char, Char)] -> [Code Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Code Char -> (Char, Char) -> Code Bool
makePred Code Char
qc) (String -> [(Char, Char)]
ranges String
cs))

makePred :: Code Char -> (Char, Char) -> Code Bool
makePred :: Code Char -> (Char, Char) -> Code Bool
makePred Code Char
qc (Char
c, Char
c')
  | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c' = [|| c == $$qc ||]
  | Bool
otherwise = [|| c <= $$qc && $$qc <= c' ||]

ranges :: [Char] -> [(Char, Char)]
ranges :: String -> [(Char, Char)]
ranges (String -> String
forall a. Ord a => [a] -> [a]
sort -> Char
c:String
cs) = Char -> Int -> String -> [(Char, Char)]
go Char
c (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c) String
cs
  where
    go :: Char -> Int -> [Char] -> [(Char, Char)]
    go :: Char -> Int -> String -> [(Char, Char)]
go Char
lower Int
prev [] = [(Char
lower, Int -> Char
forall a. Enum a => Int -> a
toEnum Int
prev)]
    go Char
lower Int
prev (Char
c:String
cs)
      | Int
i <- Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
prev Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 = Char -> Int -> String -> [(Char, Char)]
go Char
lower Int
i String
cs
      | Bool
otherwise = (Char
lower, Int -> Char
forall a. Enum a => Int -> a
toEnum Int
prev) (Char, Char) -> [(Char, Char)] -> [(Char, Char)]
forall a. a -> [a] -> [a]
: Char -> Int -> String -> [(Char, Char)]
go Char
c (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c) String
cs

{-|
Like `string`, excepts parses the given string atomically using `try`. Never consumes input on
failure.

@since 0.1.0.0
-}
token :: String -> Parser String
token :: String -> Parser String
token = Parser String -> Parser String
forall a. Parser a -> Parser a
try (Parser String -> Parser String)
-> (String -> Parser String) -> String -> Parser String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parser String
string

{-|
This parser succeeds only if there is no input left to consume, and fails without consuming input
otherwise.

@since 0.1.0.0
-}
eof :: Parser ()
eof :: Parser ()
eof = Parser Char -> Parser ()
forall a. Parser a -> Parser ()
notFollowedBy Parser Char
item

{-|
This parser succeeds if there is still input left to consume, and fails otherwise.

@since 0.1.0.0
-}
more :: Parser ()
more :: Parser ()
more = Parser () -> Parser ()
forall a. Parser a -> Parser a
lookAhead (Parser Char -> Parser ()
forall a. Parser a -> Parser ()
void Parser Char
item)

-- Parsing Primitives
{-|
This combinator will attempt to match a given character. If that character is the next input token,
the parser succeeds and the character is returned. Otherwise, the combinator will fail having not
consumed any input.

@since 0.1.0.0
-}
char :: Char -> Parser Char
char :: Char -> Parser Char
char Char
c = Defunc (Char -> Bool) -> Parser Char
forall (rep :: Type -> Type).
ParserOps rep =>
rep (Char -> Bool) -> Parser Char
satisfy (Defunc Char -> Defunc (Char -> Bool)
forall a1. Eq a1 => Defunc a1 -> Defunc (a1 -> Bool)
EQ_H (Char -> Defunc Char
forall a. (Show a, Lift a) => a -> Defunc a
LIFTED Char
c)) Parser Char -> Defunc Char -> Parser Char
forall (rep :: Type -> Type) a b.
ParserOps rep =>
Parser a -> rep b -> Parser b
$> Char -> Defunc Char
forall a. (Show a, Lift a) => a -> Defunc a
LIFTED Char
c

{-|
Reads any single character. This combinator will only fail if there is no more input remaining.
The parsed character is returned.

@since 0.1.0.0
-}
item :: Parser Char
item :: Parser Char
item = Defunc (Char -> Bool) -> Parser Char
forall (rep :: Type -> Type).
ParserOps rep =>
rep (Char -> Bool) -> Parser Char
satisfy (Defunc (Bool -> Char -> Bool)
-> Defunc Bool -> Defunc (Char -> Bool)
forall a1 a. Defunc (a1 -> a) -> Defunc a1 -> Defunc a
APP_H Defunc (Bool -> Char -> Bool)
forall a1 b. Defunc (a1 -> b -> a1)
CONST (Bool -> Defunc Bool
forall a. (Show a, Lift a) => a -> Defunc a
LIFTED Bool
True))

-- Composite Combinators
{-|
The combinator @someTill p end@ will try and parse @p@ as many times as possible (but at least once)
so long as @end@ cannot be successfully parsed. It will return the results from the successful parses of @p@.

@since 0.1.0.0
-}
someTill :: Parser a -> Parser b -> Parser [a]
someTill :: Parser a -> Parser b -> Parser [a]
someTill Parser a
p Parser b
end = Parser b -> Parser ()
forall a. Parser a -> Parser ()
notFollowedBy Parser b
end Parser () -> Parser [a] -> Parser [a]
forall a b. Parser a -> Parser b -> Parser b
*> (Parser a
p Parser a -> Parser [a] -> Parser [a]
forall a. Parser a -> Parser [a] -> Parser [a]
<:> Parser a -> Parser b -> Parser [a]
forall a b. Parser a -> Parser b -> Parser [a]
manyTill Parser a
p Parser b
end)