-- The default type signature of type class methods are changed
-- to introduce a Liftable constraint and the same type class but on the 'Output' repr,
-- this setup avoids to define the method with boilerplate code when its default
-- definition with lift* and 'trans' does what is expected by an instance
-- of the type class. This is almost as explained in:
-- https://ro-che.info/articles/2016-02-03-finally-tagless-boilerplate
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveLift #-} -- For TH.Lift (ErrorItem tok)
{-# LANGUAGE StandaloneDeriving #-} -- For Show (ErrorItem (InputToken inp))
{-# LANGUAGE TemplateHaskell #-}
module Symantic.Parser.Grammar.Combinators where

import Data.Bool (Bool(..), not, (||))
import Data.Char (Char)
import Data.Either (Either(..))
import Data.Eq (Eq(..))
import Data.Function ((.), flip, const)
import Data.Int (Int)
import Data.Maybe (Maybe(..))
import Data.Ord (Ord)
import Data.String (String)
import Language.Haskell.TH (CodeQ)
import Text.Show (Show(..))
import qualified Data.Functor as Functor
import qualified Data.List as List
import qualified Language.Haskell.TH.Syntax as TH

import qualified Symantic.Univariant.Trans as Sym
import qualified Symantic.Parser.Haskell as H

-- * Class 'Applicable'
-- | This is like the usual 'Functor' and 'Applicative' type classes
-- from the @base@ package, but using @('H.Haskell' a)@ instead of just @(a)@
-- to be able to use and pattern match on some usual terms of type @(a)@ (like
-- 'H.id') and thus apply some optimizations.
-- @(repr)@ , for "representation", is the usual tagless-final abstraction
-- over the many semantics that this syntax (formed by the methods
-- of type class like this one) will be interpreted.
class Applicable repr where
  -- | @(a2b '<$>' ra)@ parses like @(ra)@ but maps its returned value with @(a2b)@.
  (<$>) :: H.Haskell (a -> b) -> repr a -> repr b
  (<$>) Haskell (a -> b)
f = (Haskell (a -> b) -> repr (a -> b)
forall (repr :: * -> *) a. Applicable repr => Haskell a -> repr a
pure Haskell (a -> b)
f repr (a -> b) -> repr a -> repr b
forall (repr :: * -> *) a b.
Applicable repr =>
repr (a -> b) -> repr a -> repr b
<*>)

  -- | Like '<$>' but with its arguments 'flip'-ped.
  (<&>) :: repr a -> H.Haskell (a -> b) -> repr b
  (<&>) = (Haskell (a -> b) -> repr a -> repr b)
-> repr a -> Haskell (a -> b) -> repr b
forall a b c. (a -> b -> c) -> b -> a -> c
flip Haskell (a -> b) -> repr a -> repr b
forall (repr :: * -> *) a b.
Applicable repr =>
Haskell (a -> b) -> repr a -> repr b
(<$>)

  -- | @(a '<$' rb)@ parses like @(rb)@ but discards its returned value by replacing it with @(a)@.
  (<$) :: H.Haskell a -> repr b -> repr a
  (<$) Haskell a
x = (Haskell a -> repr a
forall (repr :: * -> *) a. Applicable repr => Haskell a -> repr a
pure Haskell a
x repr a -> repr b -> repr a
forall (repr :: * -> *) a b.
Applicable repr =>
repr a -> repr b -> repr a
<*)

  -- | @(ra '$>' b)@ parses like @(ra)@ but discards its returned value by replacing it with @(b)@.
  ($>) :: repr a -> H.Haskell b -> repr b
  ($>) = (Haskell b -> repr a -> repr b) -> repr a -> Haskell b -> repr b
forall a b c. (a -> b -> c) -> b -> a -> c
flip Haskell b -> repr a -> repr b
forall (repr :: * -> *) a b.
Applicable repr =>
Haskell a -> repr b -> repr a
(<$)

  -- | @('pure' a)@ parses the empty string, always succeeding in returning @(a)@.
  pure :: H.Haskell a -> repr a
  default pure ::
    Sym.Liftable repr => Applicable (Sym.Output repr) =>
    H.Haskell a -> repr a
  pure = Output repr a -> repr a
forall (repr :: * -> *) a. Liftable repr => Output repr a -> repr a
Sym.lift (Output repr a -> repr a)
-> (Haskell a -> Output repr a) -> Haskell a -> repr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Haskell a -> Output repr a
forall (repr :: * -> *) a. Applicable repr => Haskell a -> repr a
pure

  -- | @(ra2b '<*>' ra)@ parses sequentially @(ra2b)@ and then @(ra)@,
  -- and returns the application of the function returned by @(ra2b)@
  -- to the value returned by @(ra)@.
  (<*>) :: repr (a -> b) -> repr a -> repr b
  default (<*>) ::
    Sym.Liftable2 repr => Applicable (Sym.Output repr) =>
    repr (a -> b) -> repr a -> repr b
  (<*>) = (Output repr (a -> b) -> Output repr a -> Output repr b)
-> repr (a -> b) -> repr a -> repr b
forall (repr :: * -> *) a b c.
Liftable2 repr =>
(Output repr a -> Output repr b -> Output repr c)
-> repr a -> repr b -> repr c
Sym.lift2 Output repr (a -> b) -> Output repr a -> Output repr b
forall (repr :: * -> *) a b.
Applicable repr =>
repr (a -> b) -> repr a -> repr b
(<*>)

  -- | @('liftA2' a2b2c ra rb)@ parses sequentially @(ra)@ and then @(rb)@,
  -- and returns the application of @(a2b2c)@ to the values returned by those parsers.
  liftA2 :: H.Haskell (a -> b -> c) -> repr a -> repr b -> repr c
  liftA2 Haskell (a -> b -> c)
f repr a
x = repr (b -> c) -> repr b -> repr c
forall (repr :: * -> *) a b.
Applicable repr =>
repr (a -> b) -> repr a -> repr b
(<*>) (Haskell (a -> b -> c)
f Haskell (a -> b -> c) -> repr a -> repr (b -> c)
forall (repr :: * -> *) a b.
Applicable repr =>
Haskell (a -> b) -> repr a -> repr b
<$> repr a
x)

  -- | @(ra '<*' rb)@ parses sequentially @(ra)@ and then @(rb)@,
  -- and returns like @(ra)@, discarding the return value of @(rb)@.
  (<*) :: repr a -> repr b -> repr a
  (<*) = Haskell (a -> b -> a) -> repr a -> repr b -> repr a
forall (repr :: * -> *) a b c.
Applicable repr =>
Haskell (a -> b -> c) -> repr a -> repr b -> repr c
liftA2 Haskell (a -> b -> a)
forall (repr :: * -> *) a b. Haskellable repr => repr (a -> b -> a)
H.const

  -- | @(ra '*>' rb)@ parses sequentially @(ra)@ and then @(rb)@,
  -- and returns like @(rb)@, discarding the return value of @(ra)@.
  (*>) :: repr a -> repr b -> repr b
  repr a
x *> repr b
y = (Haskell (b -> b)
forall (repr :: * -> *) a. Haskellable repr => repr (a -> a)
H.id Haskell (b -> b) -> repr a -> repr (b -> b)
forall (repr :: * -> *) a b.
Applicable repr =>
Haskell a -> repr b -> repr a
<$ repr a
x) repr (b -> b) -> repr b -> repr b
forall (repr :: * -> *) a b.
Applicable repr =>
repr (a -> b) -> repr a -> repr b
<*> repr b
y

  -- | Like '<*>' but with its arguments 'flip'-ped.
  (<**>) :: repr a -> repr (a -> b) -> repr b
  (<**>) = Haskell (a -> (a -> b) -> b) -> repr a -> repr (a -> b) -> repr b
forall (repr :: * -> *) a b c.
Applicable repr =>
Haskell (a -> b -> c) -> repr a -> repr b -> repr c
liftA2 (Haskell (((a -> b) -> a -> b) -> a -> (a -> b) -> b)
forall (repr :: * -> *) a b c.
Haskellable repr =>
repr ((a -> b -> c) -> b -> a -> c)
H.flip Haskell (((a -> b) -> a -> b) -> a -> (a -> b) -> b)
-> Haskell ((a -> b) -> a -> b) -> Haskell (a -> (a -> b) -> b)
forall (repr :: * -> *) a b.
Haskellable repr =>
repr (a -> b) -> repr a -> repr b
H..@ Haskell ((a -> b) -> a -> b)
forall (repr :: * -> *) a b.
Haskellable repr =>
repr ((a -> b) -> a -> b)
(H.$))
  {-
  (<**>) :: repr a -> repr (a -> b) -> repr b
  (<**>) = liftA2 (\a f -> f a)
  -}
infixl 4 <$>, <&>, <$, $>, <*>, <*, *>, <**>

-- * Class 'Alternable'
class Alternable repr where
  -- | @(rl '<|>' rr)@ parses @(rl)@ and return its return value or,
  -- if it fails, parses @(rr)@ from where @(rl)@ has left the input stream,
  -- and returns its return value.
  (<|>) :: repr a -> repr a -> repr a
  -- | @(empty)@ parses nothing, always failing to return a value.
  empty :: repr a
  -- | @('try' ra)@ records the input stream position,
  -- then parses like @(ra)@ and either returns its value it it succeeds or fails
  -- if it fails but with a reset of the input stream to the recorded position.
  -- Generally used on the first alternative: @('try' rl '<|>' rr)@.
  try :: repr a -> repr a
  default (<|>) ::
    Sym.Liftable2 repr => Alternable (Sym.Output repr) =>
    repr a -> repr a -> repr a
  default empty ::
    Sym.Liftable repr => Alternable (Sym.Output repr) =>
    repr a
  default try ::
    Sym.Liftable1 repr => Alternable (Sym.Output repr) =>
    repr a -> repr a
  (<|>) = (Output repr a -> Output repr a -> Output repr a)
-> repr a -> repr a -> repr a
forall (repr :: * -> *) a b c.
Liftable2 repr =>
(Output repr a -> Output repr b -> Output repr c)
-> repr a -> repr b -> repr c
Sym.lift2 Output repr a -> Output repr a -> Output repr a
forall (repr :: * -> *) a.
Alternable repr =>
repr a -> repr a -> repr a
(<|>)
  empty = Output repr a -> repr a
forall (repr :: * -> *) a. Liftable repr => Output repr a -> repr a
Sym.lift Output repr a
forall (repr :: * -> *) a. Alternable repr => repr a
empty
  try = (Output repr a -> Output repr a) -> repr a -> repr a
forall (repr :: * -> *) a b.
Liftable1 repr =>
(Output repr a -> Output repr b) -> repr a -> repr b
Sym.lift1 Output repr a -> Output repr a
forall (repr :: * -> *) a. Alternable repr => repr a -> repr a
try
  -- | Like @('<|>')@ but with different returning types for the alternatives,
  -- and a return value wrapped in an 'Either' accordingly.
  (<+>) :: Applicable repr => Alternable repr => repr a -> repr b -> repr (Either a b)
  repr a
p <+> repr b
q = Haskell (a -> Either a b)
forall (repr :: * -> *) l r.
Haskellable repr =>
repr (l -> Either l r)
H.left Haskell (a -> Either a b) -> repr a -> repr (Either a b)
forall (repr :: * -> *) a b.
Applicable repr =>
Haskell (a -> b) -> repr a -> repr b
<$> repr a
p repr (Either a b) -> repr (Either a b) -> repr (Either a b)
forall (repr :: * -> *) a.
Alternable repr =>
repr a -> repr a -> repr a
<|> Haskell (b -> Either a b)
forall (repr :: * -> *) r l.
Haskellable repr =>
repr (r -> Either l r)
H.right Haskell (b -> Either a b) -> repr b -> repr (Either a b)
forall (repr :: * -> *) a b.
Applicable repr =>
Haskell (a -> b) -> repr a -> repr b
<$> repr b
q
infixl 3 <|>, <+>

optionally :: Applicable repr => Alternable repr => repr a -> H.Haskell b -> repr b
optionally :: forall (repr :: * -> *) a b.
(Applicable repr, Alternable repr) =>
repr a -> Haskell b -> repr b
optionally repr a
p Haskell b
x = repr a
p repr a -> Haskell b -> repr b
forall (repr :: * -> *) a b.
Applicable repr =>
repr a -> Haskell b -> repr b
$> Haskell b
x repr b -> repr b -> repr b
forall (repr :: * -> *) a.
Alternable repr =>
repr a -> repr a -> repr a
<|> Haskell b -> repr b
forall (repr :: * -> *) a. Applicable repr => Haskell a -> repr a
pure Haskell b
x

optional :: Applicable repr => Alternable repr => repr a -> repr ()
optional :: forall (repr :: * -> *) a.
(Applicable repr, Alternable repr) =>
repr a -> repr ()
optional = (repr a -> Haskell () -> repr ())
-> Haskell () -> repr a -> repr ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip repr a -> Haskell () -> repr ()
forall (repr :: * -> *) a b.
(Applicable repr, Alternable repr) =>
repr a -> Haskell b -> repr b
optionally Haskell ()
forall (repr :: * -> *). Haskellable repr => repr ()
H.unit

option :: Applicable repr => Alternable repr => H.Haskell a -> repr a -> repr a
option :: forall (repr :: * -> *) a.
(Applicable repr, Alternable repr) =>
Haskell a -> repr a -> repr a
option Haskell a
x repr a
p = repr a
p repr a -> repr a -> repr a
forall (repr :: * -> *) a.
Alternable repr =>
repr a -> repr a -> repr a
<|> Haskell a -> repr a
forall (repr :: * -> *) a. Applicable repr => Haskell a -> repr a
pure Haskell a
x

choice :: Alternable repr => [repr a] -> repr a
choice :: forall (repr :: * -> *) a. Alternable repr => [repr a] -> repr a
choice = (repr a -> repr a -> repr a) -> repr a -> [repr a] -> repr a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr repr a -> repr a -> repr a
forall (repr :: * -> *) a.
Alternable repr =>
repr a -> repr a -> repr a
(<|>) repr a
forall (repr :: * -> *) a. Alternable repr => repr a
empty
 -- FIXME: Here hlint suggests to use Data.Foldable.asum,
 -- but at this point there is no asum for our own (<|>)

maybeP :: Applicable repr => Alternable repr => repr a -> repr (Maybe a)
maybeP :: forall (repr :: * -> *) a.
(Applicable repr, Alternable repr) =>
repr a -> repr (Maybe a)
maybeP repr a
p = Haskell (Maybe a) -> repr (Maybe a) -> repr (Maybe a)
forall (repr :: * -> *) a.
(Applicable repr, Alternable repr) =>
Haskell a -> repr a -> repr a
option Haskell (Maybe a)
forall (repr :: * -> *) a. Haskellable repr => repr (Maybe a)
H.nothing (Haskell (a -> Maybe a)
forall (repr :: * -> *) a. Haskellable repr => repr (a -> Maybe a)
H.just Haskell (a -> Maybe a) -> repr a -> repr (Maybe a)
forall (repr :: * -> *) a b.
Applicable repr =>
Haskell (a -> b) -> repr a -> repr b
<$> repr a
p)

manyTill :: Applicable repr => Alternable repr => repr a -> repr b -> repr [a]
manyTill :: forall (repr :: * -> *) a b.
(Applicable repr, Alternable repr) =>
repr a -> repr b -> repr [a]
manyTill repr a
p repr b
end = let go :: repr [a]
go = repr b
end repr b -> Haskell [a] -> repr [a]
forall (repr :: * -> *) a b.
Applicable repr =>
repr a -> Haskell b -> repr b
$> Haskell [a]
forall (repr :: * -> *) a. Haskellable repr => repr [a]
H.nil repr [a] -> repr [a] -> repr [a]
forall (repr :: * -> *) a.
Alternable repr =>
repr a -> repr a -> repr a
<|> repr a
p repr a -> repr [a] -> repr [a]
forall (repr :: * -> *) a.
Applicable repr =>
repr a -> repr [a] -> repr [a]
<:> repr [a]
go in repr [a]
go

-- * Class 'Selectable'
class Selectable repr where
  branch :: repr (Either a b) -> repr (a -> c) -> repr (b -> c) -> repr c
  default branch ::
    Sym.Liftable3 repr => Selectable (Sym.Output repr) =>
    repr (Either a b) -> repr (a -> c) -> repr (b -> c) -> repr c
  branch = (Output repr (Either a b)
 -> Output repr (a -> c) -> Output repr (b -> c) -> Output repr c)
-> repr (Either a b) -> repr (a -> c) -> repr (b -> c) -> repr c
forall (repr :: * -> *) a b c d.
Liftable3 repr =>
(Output repr a -> Output repr b -> Output repr c -> Output repr d)
-> repr a -> repr b -> repr c -> repr d
Sym.lift3 Output repr (Either a b)
-> Output repr (a -> c) -> Output repr (b -> c) -> Output repr c
forall (repr :: * -> *) a b c.
Selectable repr =>
repr (Either a b) -> repr (a -> c) -> repr (b -> c) -> repr c
branch

-- * Class 'Matchable'
class Matchable repr where
  conditional ::
    Eq a => [H.Haskell (a -> Bool)] -> [repr b] -> repr a -> repr b -> repr b
  default conditional ::
    Sym.Unliftable repr => Sym.Liftable2 repr => Matchable (Sym.Output repr) =>
    Eq a => [H.Haskell (a -> Bool)] -> [repr b] -> repr a -> repr b -> repr b
  conditional [Haskell (a -> Bool)]
cs [repr b]
bs = (Output repr a -> Output repr b -> Output repr b)
-> repr a -> repr b -> repr b
forall (repr :: * -> *) a b c.
Liftable2 repr =>
(Output repr a -> Output repr b -> Output repr c)
-> repr a -> repr b -> repr c
Sym.lift2 ([Haskell (a -> Bool)]
-> [Output repr b]
-> Output repr a
-> Output repr b
-> Output repr b
forall (repr :: * -> *) a b.
(Matchable repr, Eq a) =>
[Haskell (a -> Bool)] -> [repr b] -> repr a -> repr b -> repr b
conditional [Haskell (a -> Bool)]
cs (repr b -> Output repr b
forall (from :: * -> *) (to :: * -> *) a.
Trans from to =>
from a -> to a
Sym.trans (repr b -> Output repr b) -> [repr b] -> [Output repr b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Functor.<$> [repr b]
bs))

  match :: Eq a => [H.Haskell a] -> repr a -> (H.Haskell a -> repr b) -> repr b -> repr b
  match [Haskell a]
as repr a
a Haskell a -> repr b
a2b = [Haskell (a -> Bool)] -> [repr b] -> repr a -> repr b -> repr b
forall (repr :: * -> *) a b.
(Matchable repr, Eq a) =>
[Haskell (a -> Bool)] -> [repr b] -> repr a -> repr b -> repr b
conditional (Haskell a -> Haskell (a -> Bool)
forall (repr :: * -> *) a.
(Haskellable repr, Eq a) =>
repr a -> repr (a -> Bool)
H.eq (Haskell a -> Haskell (a -> Bool))
-> [Haskell a] -> [Haskell (a -> Bool)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Functor.<$> [Haskell a]
as) (Haskell a -> repr b
a2b (Haskell a -> repr b) -> [Haskell a] -> [repr b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Functor.<$> [Haskell a]
as) repr a
a

-- * Class 'Foldable'
class Foldable repr where
  chainPre :: repr (a -> a) -> repr a -> repr a
  chainPost :: repr a -> repr (a -> a) -> repr a
  {-
  default chainPre ::
    Sym.Liftable2 repr => Foldable (Sym.Output repr) =>
    repr (a -> a) -> repr a -> repr a
  default chainPost ::
    Sym.Liftable2 repr => Foldable (Sym.Output repr) =>
    repr a -> repr (a -> a) -> repr a
  chainPre = Sym.lift2 chainPre
  chainPost = Sym.lift2 chainPost
  -}
  default chainPre ::
    Applicable repr =>
    Alternable repr =>
    repr (a -> a) -> repr a -> repr a
  default chainPost ::
    Applicable repr =>
    Alternable repr =>
    repr a -> repr (a -> a) -> repr a
  chainPre repr (a -> a)
op repr a
p = repr (a -> a)
go repr (a -> a) -> repr a -> repr a
forall (repr :: * -> *) a b.
Applicable repr =>
repr (a -> b) -> repr a -> repr b
<*> repr a
p
    where go :: repr (a -> a)
go = Haskell ((a -> a) -> (a -> a) -> a -> a)
forall (repr :: * -> *) b c a.
Haskellable repr =>
repr ((b -> c) -> (a -> b) -> a -> c)
(H..) Haskell ((a -> a) -> (a -> a) -> a -> a)
-> repr (a -> a) -> repr ((a -> a) -> a -> a)
forall (repr :: * -> *) a b.
Applicable repr =>
Haskell (a -> b) -> repr a -> repr b
<$> repr (a -> a)
op repr ((a -> a) -> a -> a) -> repr (a -> a) -> repr (a -> a)
forall (repr :: * -> *) a b.
Applicable repr =>
repr (a -> b) -> repr a -> repr b
<*> repr (a -> a)
go repr (a -> a) -> repr (a -> a) -> repr (a -> a)
forall (repr :: * -> *) a.
Alternable repr =>
repr a -> repr a -> repr a
<|> Haskell (a -> a) -> repr (a -> a)
forall (repr :: * -> *) a. Applicable repr => Haskell a -> repr a
pure Haskell (a -> a)
forall (repr :: * -> *) a. Haskellable repr => repr (a -> a)
H.id
  chainPost repr a
p repr (a -> a)
op = repr a
p repr a -> repr (a -> a) -> repr a
forall (repr :: * -> *) a b.
Applicable repr =>
repr a -> repr (a -> b) -> repr b
<**> repr (a -> a)
go
    where go :: repr (a -> a)
go = Haskell ((a -> a) -> (a -> a) -> a -> a)
forall (repr :: * -> *) b c a.
Haskellable repr =>
repr ((b -> c) -> (a -> b) -> a -> c)
(H..) Haskell ((a -> a) -> (a -> a) -> a -> a)
-> repr (a -> a) -> repr ((a -> a) -> a -> a)
forall (repr :: * -> *) a b.
Applicable repr =>
Haskell (a -> b) -> repr a -> repr b
<$> repr (a -> a)
op repr ((a -> a) -> a -> a) -> repr (a -> a) -> repr (a -> a)
forall (repr :: * -> *) a b.
Applicable repr =>
repr (a -> b) -> repr a -> repr b
<*> repr (a -> a)
go repr (a -> a) -> repr (a -> a) -> repr (a -> a)
forall (repr :: * -> *) a.
Alternable repr =>
repr a -> repr a -> repr a
<|> Haskell (a -> a) -> repr (a -> a)
forall (repr :: * -> *) a. Applicable repr => Haskell a -> repr a
pure Haskell (a -> a)
forall (repr :: * -> *) a. Haskellable repr => repr (a -> a)
H.id

{-
conditional :: Selectable repr => [(H.Haskell (a -> Bool), repr b)] -> repr a -> repr b -> repr b
conditional cs p def = match p fs qs def
  where (fs, qs) = List.unzip cs
-}

-- * Class 'Satisfiable'
class Satisfiable repr tok where
  satisfy :: [ErrorItem tok] -> H.Haskell (tok -> Bool) -> repr tok
  default satisfy ::
    Sym.Liftable repr => Satisfiable (Sym.Output repr) tok =>
    [ErrorItem tok] ->
    H.Haskell (tok -> Bool) -> repr tok
  satisfy [ErrorItem tok]
es = Output repr tok -> repr tok
forall (repr :: * -> *) a. Liftable repr => Output repr a -> repr a
Sym.lift (Output repr tok -> repr tok)
-> (Haskell (tok -> Bool) -> Output repr tok)
-> Haskell (tok -> Bool)
-> repr tok
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ErrorItem tok] -> Haskell (tok -> Bool) -> Output repr tok
forall (repr :: * -> *) tok.
Satisfiable repr tok =>
[ErrorItem tok] -> Haskell (tok -> Bool) -> repr tok
satisfy [ErrorItem tok]
es

-- ** Type 'ErrorItem'
data ErrorItem tok
  =  ErrorItemToken tok
  |  ErrorItemLabel String
  |  ErrorItemEnd
deriving instance Eq tok => Eq (ErrorItem tok)
deriving instance Ord tok => Ord (ErrorItem tok)
deriving instance Show tok => Show (ErrorItem tok)
deriving instance TH.Lift tok => TH.Lift (ErrorItem tok)

-- * Class 'Lookable'
class Lookable repr where
  look :: repr a -> repr a
  negLook :: repr a -> repr ()
  default look :: Sym.Liftable1 repr => Lookable (Sym.Output repr) => repr a -> repr a
  default negLook :: Sym.Liftable1 repr => Lookable (Sym.Output repr) => repr a -> repr ()
  look = (Output repr a -> Output repr a) -> repr a -> repr a
forall (repr :: * -> *) a b.
Liftable1 repr =>
(Output repr a -> Output repr b) -> repr a -> repr b
Sym.lift1 Output repr a -> Output repr a
forall (repr :: * -> *) a. Lookable repr => repr a -> repr a
look
  negLook = (Output repr a -> Output repr ()) -> repr a -> repr ()
forall (repr :: * -> *) a b.
Liftable1 repr =>
(Output repr a -> Output repr b) -> repr a -> repr b
Sym.lift1 Output repr a -> Output repr ()
forall (repr :: * -> *) a. Lookable repr => repr a -> repr ()
negLook

  eof :: repr ()
  eof = Output repr () -> repr ()
forall (repr :: * -> *) a. Liftable repr => Output repr a -> repr a
Sym.lift Output repr ()
forall (repr :: * -> *). Lookable repr => repr ()
eof
  default eof :: Sym.Liftable repr => Lookable (Sym.Output repr) => repr ()
  -- eof = negLook (satisfy @_ @Char [ErrorItemAny] (H.const H..@ H.bool True))
             -- (item @_ @Char)

{-# INLINE (<:>) #-}
infixl 4 <:>
(<:>) :: Applicable repr => repr a -> repr [a] -> repr [a]
<:> :: forall (repr :: * -> *) a.
Applicable repr =>
repr a -> repr [a] -> repr [a]
(<:>) = Haskell (a -> [a] -> [a]) -> repr a -> repr [a] -> repr [a]
forall (repr :: * -> *) a b c.
Applicable repr =>
Haskell (a -> b -> c) -> repr a -> repr b -> repr c
liftA2 Haskell (a -> [a] -> [a])
forall (repr :: * -> *) a.
Haskellable repr =>
repr (a -> [a] -> [a])
H.cons

sequence :: Applicable repr => [repr a] -> repr [a]
sequence :: forall (repr :: * -> *) a. Applicable repr => [repr a] -> repr [a]
sequence = (repr a -> repr [a] -> repr [a])
-> repr [a] -> [repr a] -> repr [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr repr a -> repr [a] -> repr [a]
forall (repr :: * -> *) a.
Applicable repr =>
repr a -> repr [a] -> repr [a]
(<:>) (Haskell [a] -> repr [a]
forall (repr :: * -> *) a. Applicable repr => Haskell a -> repr a
pure Haskell [a]
forall (repr :: * -> *) a. Haskellable repr => repr [a]
H.nil)

traverse :: Applicable repr => (a -> repr b) -> [a] -> repr [b]
traverse :: forall (repr :: * -> *) a b.
Applicable repr =>
(a -> repr b) -> [a] -> repr [b]
traverse a -> repr b
f = [repr b] -> repr [b]
forall (repr :: * -> *) a. Applicable repr => [repr a] -> repr [a]
sequence ([repr b] -> repr [b]) -> ([a] -> [repr b]) -> [a] -> repr [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> repr b) -> [a] -> [repr b]
forall a b. (a -> b) -> [a] -> [b]
List.map a -> repr b
f
 -- FIXME: Here hlint suggests to use Control.Monad.mapM,
 -- but at this point there is no mapM for our own sequence

repeat :: Applicable repr => Int -> repr a -> repr [a]
repeat :: forall (repr :: * -> *) a.
Applicable repr =>
Int -> repr a -> repr [a]
repeat Int
n repr a
p = (Int -> repr a) -> [Int] -> repr [a]
forall (repr :: * -> *) a b.
Applicable repr =>
(a -> repr b) -> [a] -> repr [b]
traverse (repr a -> Int -> repr a
forall a b. a -> b -> a
const repr a
p) [Int
1..Int
n]

between :: Applicable repr => repr o -> repr c -> repr a -> repr a
between :: forall (repr :: * -> *) o c a.
Applicable repr =>
repr o -> repr c -> repr a -> repr a
between repr o
open repr c
close repr a
p = repr o
open repr o -> repr a -> repr a
forall (repr :: * -> *) a b.
Applicable repr =>
repr a -> repr b -> repr b
*> repr a
p repr a -> repr c -> repr a
forall (repr :: * -> *) a b.
Applicable repr =>
repr a -> repr b -> repr a
<* repr c
close

string :: Applicable repr => Satisfiable repr Char => [Char] -> repr [Char]
string :: forall (repr :: * -> *).
(Applicable repr, Satisfiable repr Char) =>
String -> repr String
string = (Char -> repr Char) -> String -> repr String
forall (repr :: * -> *) a b.
Applicable repr =>
(a -> repr b) -> [a] -> repr [b]
traverse Char -> repr Char
forall (repr :: * -> *).
(Applicable repr, Satisfiable repr Char) =>
Char -> repr Char
char

-- oneOf :: [Char] -> repr Char
-- oneOf cs = satisfy [] (makeQ (flip elem cs) [||\c -> $$(ofChars cs [||c||])||])

noneOf :: TH.Lift tok => Eq tok => Satisfiable repr tok => [tok] -> repr tok
noneOf :: forall tok (repr :: * -> *).
(Lift tok, Eq tok, Satisfiable repr tok) =>
[tok] -> repr tok
noneOf [tok]
cs = [ErrorItem tok] -> Haskell (tok -> Bool) -> repr tok
forall (repr :: * -> *) tok.
Satisfiable repr tok =>
[ErrorItem tok] -> Haskell (tok -> Bool) -> repr tok
satisfy (tok -> ErrorItem tok
forall tok. tok -> ErrorItem tok
ErrorItemToken (tok -> ErrorItem tok) -> [tok] -> [ErrorItem tok]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Functor.<$> [tok]
cs) (ValueCode (tok -> Bool) -> Haskell (tok -> Bool)
forall a. ValueCode a -> Haskell a
H.Haskell ValueCode :: forall a. Value a -> CodeQ a -> ValueCode a
H.ValueCode{Code Q (tok -> Bool)
Value (tok -> Bool)
code :: Code Q (tok -> Bool)
value :: Value (tok -> Bool)
code :: Code Q (tok -> Bool)
value :: Value (tok -> Bool)
..})
  where
  value :: Value (tok -> Bool)
value = (tok -> Bool) -> Value (tok -> Bool)
forall a. a -> Value a
H.Value (Bool -> Bool
not (Bool -> Bool) -> (tok -> Bool) -> tok -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (tok -> [tok] -> Bool) -> [tok] -> tok -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip tok -> [tok] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
List.elem [tok]
cs)
  code :: Code Q (tok -> Bool)
code = [||\c -> not $$(ofChars cs [||c||])||]

ofChars :: TH.Lift tok => Eq tok => [tok] -> CodeQ tok -> CodeQ Bool
ofChars :: forall tok. (Lift tok, Eq tok) => [tok] -> CodeQ tok -> CodeQ Bool
ofChars = (tok -> (Code Q tok -> CodeQ Bool) -> Code Q tok -> CodeQ Bool)
-> (Code Q tok -> CodeQ Bool) -> [tok] -> Code Q tok -> CodeQ Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr (\tok
c Code Q tok -> CodeQ Bool
rest Code Q tok
qc -> [|| c == $$qc || $$(rest qc) ||]) (CodeQ Bool -> Code Q tok -> CodeQ Bool
forall a b. a -> b -> a
const [||False||])

more :: Applicable repr => Satisfiable repr Char => Lookable repr => repr ()
more :: forall (repr :: * -> *).
(Applicable repr, Satisfiable repr Char, Lookable repr) =>
repr ()
more = repr () -> repr ()
forall (repr :: * -> *) a. Lookable repr => repr a -> repr a
look (repr Char -> repr ()
forall (repr :: * -> *) a. Applicable repr => repr a -> repr ()
void (forall (repr :: * -> *) tok. Satisfiable repr tok => repr tok
item @_ @Char))

char :: Applicable repr => Satisfiable repr Char => Char -> repr Char
char :: forall (repr :: * -> *).
(Applicable repr, Satisfiable repr Char) =>
Char -> repr Char
char Char
c = [ErrorItem Char] -> Haskell (Char -> Bool) -> repr Char
forall (repr :: * -> *) tok.
Satisfiable repr tok =>
[ErrorItem tok] -> Haskell (tok -> Bool) -> repr tok
satisfy [Char -> ErrorItem Char
forall tok. tok -> ErrorItem tok
ErrorItemToken Char
c] (Haskell Char -> Haskell (Char -> Bool)
forall (repr :: * -> *) a.
(Haskellable repr, Eq a) =>
repr a -> repr (a -> Bool)
H.eq (Char -> Haskell Char
forall (repr :: * -> *) tok.
(Haskellable repr, Lift tok) =>
tok -> repr tok
H.char Char
c)) repr Char -> Haskell Char -> repr Char
forall (repr :: * -> *) a b.
Applicable repr =>
repr a -> Haskell b -> repr b
$> Char -> Haskell Char
forall (repr :: * -> *) tok.
(Haskellable repr, Lift tok) =>
tok -> repr tok
H.char Char
c

anyChar :: Satisfiable repr Char => repr Char
anyChar :: forall (repr :: * -> *). Satisfiable repr Char => repr Char
anyChar = [ErrorItem Char] -> Haskell (Char -> Bool) -> repr Char
forall (repr :: * -> *) tok.
Satisfiable repr tok =>
[ErrorItem tok] -> Haskell (tok -> Bool) -> repr tok
satisfy [] (Haskell (Bool -> Char -> Bool)
forall (repr :: * -> *) a b. Haskellable repr => repr (a -> b -> a)
H.const Haskell (Bool -> Char -> Bool)
-> Haskell Bool -> Haskell (Char -> Bool)
forall (repr :: * -> *) a b.
Haskellable repr =>
repr (a -> b) -> repr a -> repr b
H..@ Bool -> Haskell Bool
forall (repr :: * -> *). Haskellable repr => Bool -> repr Bool
H.bool Bool
True)

token ::
  TH.Lift tok => Eq tok => Applicable repr =>
  Satisfiable repr tok => tok -> repr tok
token :: forall tok (repr :: * -> *).
(Lift tok, Eq tok, Applicable repr, Satisfiable repr tok) =>
tok -> repr tok
token tok
tok = [ErrorItem tok] -> Haskell (tok -> Bool) -> repr tok
forall (repr :: * -> *) tok.
Satisfiable repr tok =>
[ErrorItem tok] -> Haskell (tok -> Bool) -> repr tok
satisfy [tok -> ErrorItem tok
forall tok. tok -> ErrorItem tok
ErrorItemToken tok
tok] (Haskell tok -> Haskell (tok -> Bool)
forall (repr :: * -> *) a.
(Haskellable repr, Eq a) =>
repr a -> repr (a -> Bool)
H.eq (tok -> Haskell tok
forall (repr :: * -> *) tok.
(Haskellable repr, Lift tok) =>
tok -> repr tok
H.char tok
tok)) repr tok -> Haskell tok -> repr tok
forall (repr :: * -> *) a b.
Applicable repr =>
repr a -> Haskell b -> repr b
$> tok -> Haskell tok
forall (repr :: * -> *) tok.
(Haskellable repr, Lift tok) =>
tok -> repr tok
H.char tok
tok

tokens ::
  TH.Lift tok => Eq tok => Applicable repr => Alternable repr =>
  Satisfiable repr tok => [tok] -> repr [tok]
tokens :: forall tok (repr :: * -> *).
(Lift tok, Eq tok, Applicable repr, Alternable repr,
 Satisfiable repr tok) =>
[tok] -> repr [tok]
tokens = repr [tok] -> repr [tok]
forall (repr :: * -> *) a. Alternable repr => repr a -> repr a
try (repr [tok] -> repr [tok])
-> ([tok] -> repr [tok]) -> [tok] -> repr [tok]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (tok -> repr tok) -> [tok] -> repr [tok]
forall (repr :: * -> *) a b.
Applicable repr =>
(a -> repr b) -> [a] -> repr [b]
traverse tok -> repr tok
forall tok (repr :: * -> *).
(Lift tok, Eq tok, Applicable repr, Satisfiable repr tok) =>
tok -> repr tok
token

item :: Satisfiable repr tok => repr tok
item :: forall (repr :: * -> *) tok. Satisfiable repr tok => repr tok
item = [ErrorItem tok] -> Haskell (tok -> Bool) -> repr tok
forall (repr :: * -> *) tok.
Satisfiable repr tok =>
[ErrorItem tok] -> Haskell (tok -> Bool) -> repr tok
satisfy [] (Haskell (Bool -> tok -> Bool)
forall (repr :: * -> *) a b. Haskellable repr => repr (a -> b -> a)
H.const Haskell (Bool -> tok -> Bool)
-> Haskell Bool -> Haskell (tok -> Bool)
forall (repr :: * -> *) a b.
Haskellable repr =>
repr (a -> b) -> repr a -> repr b
H..@ Bool -> Haskell Bool
forall (repr :: * -> *). Haskellable repr => Bool -> repr Bool
H.bool Bool
True)

-- Composite Combinators
-- someTill :: repr a -> repr b -> repr [a]
-- someTill p end = negLook end *> (p <:> manyTill p end)

void :: Applicable repr => repr a -> repr ()
void :: forall (repr :: * -> *) a. Applicable repr => repr a -> repr ()
void repr a
p = repr a
p repr a -> repr () -> repr ()
forall (repr :: * -> *) a b.
Applicable repr =>
repr a -> repr b -> repr b
*> repr ()
forall (repr :: * -> *). Applicable repr => repr ()
unit

unit :: Applicable repr => repr ()
unit :: forall (repr :: * -> *). Applicable repr => repr ()
unit = Haskell () -> repr ()
forall (repr :: * -> *) a. Applicable repr => Haskell a -> repr a
pure Haskell ()
forall (repr :: * -> *). Haskellable repr => repr ()
H.unit

{-
constp :: Applicable repr => repr a -> repr (b -> a)
constp = (H.const <$>)


-- Alias Operations
infixl 1 >>
(>>) :: Applicable repr => repr a -> repr b -> repr b
(>>) = (*>)

-- Monoidal Operations

infixl 4 <~>
(<~>) :: Applicable repr => repr a -> repr b -> repr (a, b)
(<~>) = liftA2 (H.runtime (,))

infixl 4 <~
(<~) :: Applicable repr => repr a -> repr b -> repr a
(<~) = (<*)

infixl 4 ~>
(~>) :: Applicable repr => repr a -> repr b -> repr b
(~>) = (*>)

-- Lift Operations
liftA2 ::
 Applicable repr =>
 H.Haskell (a -> b -> c) -> repr a -> repr b -> repr c
liftA2 f x = (<*>) (fmap f x)

liftA3 ::
 Applicable repr =>
 H.Haskell (a -> b -> c -> d) -> repr a -> repr b -> repr c -> repr d
liftA3 f a b c = liftA2 f a b <*> c

-}

-- Parser Folds
pfoldr ::
 Applicable repr => Foldable repr =>
 H.Haskell (a -> b -> b) -> H.Haskell b -> repr a -> repr b
pfoldr :: forall (repr :: * -> *) a b.
(Applicable repr, Foldable repr) =>
Haskell (a -> b -> b) -> Haskell b -> repr a -> repr b
pfoldr Haskell (a -> b -> b)
f Haskell b
k repr a
p = repr (b -> b) -> repr b -> repr b
forall (repr :: * -> *) a.
Foldable repr =>
repr (a -> a) -> repr a -> repr a
chainPre (Haskell (a -> b -> b)
f Haskell (a -> b -> b) -> repr a -> repr (b -> b)
forall (repr :: * -> *) a b.
Applicable repr =>
Haskell (a -> b) -> repr a -> repr b
<$> repr a
p) (Haskell b -> repr b
forall (repr :: * -> *) a. Applicable repr => Haskell a -> repr a
pure Haskell b
k)

pfoldr1 ::
 Applicable repr => Foldable repr =>
 H.Haskell (a -> b -> b) -> H.Haskell b -> repr a -> repr b
pfoldr1 :: forall (repr :: * -> *) a b.
(Applicable repr, Foldable repr) =>
Haskell (a -> b -> b) -> Haskell b -> repr a -> repr b
pfoldr1 Haskell (a -> b -> b)
f Haskell b
k repr a
p = Haskell (a -> b -> b)
f Haskell (a -> b -> b) -> repr a -> repr (b -> b)
forall (repr :: * -> *) a b.
Applicable repr =>
Haskell (a -> b) -> repr a -> repr b
<$> repr a
p repr (b -> b) -> repr b -> repr b
forall (repr :: * -> *) a b.
Applicable repr =>
repr (a -> b) -> repr a -> repr b
<*> Haskell (a -> b -> b) -> Haskell b -> repr a -> repr b
forall (repr :: * -> *) a b.
(Applicable repr, Foldable repr) =>
Haskell (a -> b -> b) -> Haskell b -> repr a -> repr b
pfoldr Haskell (a -> b -> b)
f Haskell b
k repr a
p

pfoldl ::
 Applicable repr => Foldable repr =>
 H.Haskell (b -> a -> b) -> H.Haskell b -> repr a -> repr b
pfoldl :: forall (repr :: * -> *) b a.
(Applicable repr, Foldable repr) =>
Haskell (b -> a -> b) -> Haskell b -> repr a -> repr b
pfoldl Haskell (b -> a -> b)
f Haskell b
k repr a
p = repr b -> repr (b -> b) -> repr b
forall (repr :: * -> *) a.
Foldable repr =>
repr a -> repr (a -> a) -> repr a
chainPost (Haskell b -> repr b
forall (repr :: * -> *) a. Applicable repr => Haskell a -> repr a
pure Haskell b
k) ((Haskell ((b -> a -> b) -> a -> b -> b)
forall (repr :: * -> *) a b c.
Haskellable repr =>
repr ((a -> b -> c) -> b -> a -> c)
H.flip Haskell ((b -> a -> b) -> a -> b -> b)
-> repr (b -> a -> b) -> repr (a -> b -> b)
forall (repr :: * -> *) a b.
Applicable repr =>
Haskell (a -> b) -> repr a -> repr b
<$> Haskell (b -> a -> b) -> repr (b -> a -> b)
forall (repr :: * -> *) a. Applicable repr => Haskell a -> repr a
pure Haskell (b -> a -> b)
f) repr (a -> b -> b) -> repr a -> repr (b -> b)
forall (repr :: * -> *) a b.
Applicable repr =>
repr (a -> b) -> repr a -> repr b
<*> repr a
p)

pfoldl1 ::
 Applicable repr => Foldable repr =>
 H.Haskell (b -> a -> b) -> H.Haskell b -> repr a -> repr b
pfoldl1 :: forall (repr :: * -> *) b a.
(Applicable repr, Foldable repr) =>
Haskell (b -> a -> b) -> Haskell b -> repr a -> repr b
pfoldl1 Haskell (b -> a -> b)
f Haskell b
k repr a
p = repr b -> repr (b -> b) -> repr b
forall (repr :: * -> *) a.
Foldable repr =>
repr a -> repr (a -> a) -> repr a
chainPost (Haskell (b -> a -> b)
f Haskell (b -> a -> b) -> repr b -> repr (a -> b)
forall (repr :: * -> *) a b.
Applicable repr =>
Haskell (a -> b) -> repr a -> repr b
<$> Haskell b -> repr b
forall (repr :: * -> *) a. Applicable repr => Haskell a -> repr a
pure Haskell b
k repr (a -> b) -> repr a -> repr b
forall (repr :: * -> *) a b.
Applicable repr =>
repr (a -> b) -> repr a -> repr b
<*> repr a
p) ((Haskell ((b -> a -> b) -> a -> b -> b)
forall (repr :: * -> *) a b c.
Haskellable repr =>
repr ((a -> b -> c) -> b -> a -> c)
H.flip Haskell ((b -> a -> b) -> a -> b -> b)
-> repr (b -> a -> b) -> repr (a -> b -> b)
forall (repr :: * -> *) a b.
Applicable repr =>
Haskell (a -> b) -> repr a -> repr b
<$> Haskell (b -> a -> b) -> repr (b -> a -> b)
forall (repr :: * -> *) a. Applicable repr => Haskell a -> repr a
pure Haskell (b -> a -> b)
f) repr (a -> b -> b) -> repr a -> repr (b -> b)
forall (repr :: * -> *) a b.
Applicable repr =>
repr (a -> b) -> repr a -> repr b
<*> repr a
p)

-- Chain Combinators
chainl1' ::
 Applicable repr => Foldable repr =>
 H.Haskell (a -> b) -> repr a -> repr (b -> a -> b) -> repr b
chainl1' :: forall (repr :: * -> *) a b.
(Applicable repr, Foldable repr) =>
Haskell (a -> b) -> repr a -> repr (b -> a -> b) -> repr b
chainl1' Haskell (a -> b)
f repr a
p repr (b -> a -> b)
op = repr b -> repr (b -> b) -> repr b
forall (repr :: * -> *) a.
Foldable repr =>
repr a -> repr (a -> a) -> repr a
chainPost (Haskell (a -> b)
f Haskell (a -> b) -> repr a -> repr b
forall (repr :: * -> *) a b.
Applicable repr =>
Haskell (a -> b) -> repr a -> repr b
<$> repr a
p) (Haskell ((b -> a -> b) -> a -> b -> b)
forall (repr :: * -> *) a b c.
Haskellable repr =>
repr ((a -> b -> c) -> b -> a -> c)
H.flip Haskell ((b -> a -> b) -> a -> b -> b)
-> repr (b -> a -> b) -> repr (a -> b -> b)
forall (repr :: * -> *) a b.
Applicable repr =>
Haskell (a -> b) -> repr a -> repr b
<$> repr (b -> a -> b)
op repr (a -> b -> b) -> repr a -> repr (b -> b)
forall (repr :: * -> *) a b.
Applicable repr =>
repr (a -> b) -> repr a -> repr b
<*> repr a
p)

chainl1 ::
 Applicable repr => Foldable repr =>
 repr a -> repr (a -> a -> a) -> repr a
chainl1 :: forall (repr :: * -> *) a.
(Applicable repr, Foldable repr) =>
repr a -> repr (a -> a -> a) -> repr a
chainl1 = Haskell (a -> a) -> repr a -> repr (a -> a -> a) -> repr a
forall (repr :: * -> *) a b.
(Applicable repr, Foldable repr) =>
Haskell (a -> b) -> repr a -> repr (b -> a -> b) -> repr b
chainl1' Haskell (a -> a)
forall (repr :: * -> *) a. Haskellable repr => repr (a -> a)
H.id

{-
chainr1' :: ParserOps rep => rep (a -> b) -> repr a -> repr (a -> b -> b) -> repr b
chainr1' f p op = newRegister_ H.id $ \acc ->
  let go = bind p $ \x ->
           modify acc (H.flip (H..@) <$> (op <*> x)) *> go
       <|> f <$> x
  in go <**> get acc

chainr1 :: repr a -> repr (a -> a -> a) -> repr a
chainr1 = chainr1' H.id

chainr :: repr a -> repr (a -> a -> a) -> H.Haskell a -> repr a
chainr p op x = option x (chainr1 p op)
-}

chainl ::
 Applicable repr => Alternable repr => Foldable repr =>
 repr a -> repr (a -> a -> a) -> H.Haskell a -> repr a
chainl :: forall (repr :: * -> *) a.
(Applicable repr, Alternable repr, Foldable repr) =>
repr a -> repr (a -> a -> a) -> Haskell a -> repr a
chainl repr a
p repr (a -> a -> a)
op Haskell a
x = Haskell a -> repr a -> repr a
forall (repr :: * -> *) a.
(Applicable repr, Alternable repr) =>
Haskell a -> repr a -> repr a
option Haskell a
x (repr a -> repr (a -> a -> a) -> repr a
forall (repr :: * -> *) a.
(Applicable repr, Foldable repr) =>
repr a -> repr (a -> a -> a) -> repr a
chainl1 repr a
p repr (a -> a -> a)
op)

-- Derived Combinators
many ::
 Applicable repr => Foldable repr =>
 repr a -> repr [a]
many :: forall (repr :: * -> *) a.
(Applicable repr, Foldable repr) =>
repr a -> repr [a]
many = Haskell (a -> [a] -> [a]) -> Haskell [a] -> repr a -> repr [a]
forall (repr :: * -> *) a b.
(Applicable repr, Foldable repr) =>
Haskell (a -> b -> b) -> Haskell b -> repr a -> repr b
pfoldr Haskell (a -> [a] -> [a])
forall (repr :: * -> *) a.
Haskellable repr =>
repr (a -> [a] -> [a])
H.cons Haskell [a]
forall (repr :: * -> *) a. Haskellable repr => repr [a]
H.nil

manyN ::
 Applicable repr => Foldable repr =>
 Int -> repr a -> repr [a]
manyN :: forall (repr :: * -> *) a.
(Applicable repr, Foldable repr) =>
Int -> repr a -> repr [a]
manyN Int
n repr a
p = (Int -> repr [a] -> repr [a]) -> repr [a] -> [Int] -> repr [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr ((repr [a] -> repr [a]) -> Int -> repr [a] -> repr [a]
forall a b. a -> b -> a
const (repr a
p repr a -> repr [a] -> repr [a]
forall (repr :: * -> *) a.
Applicable repr =>
repr a -> repr [a] -> repr [a]
<:>)) (repr a -> repr [a]
forall (repr :: * -> *) a.
(Applicable repr, Foldable repr) =>
repr a -> repr [a]
many repr a
p) [Int
1..Int
n]

some ::
 Applicable repr => Foldable repr =>
 repr a -> repr [a]
some :: forall (repr :: * -> *) a.
(Applicable repr, Foldable repr) =>
repr a -> repr [a]
some = Int -> repr a -> repr [a]
forall (repr :: * -> *) a.
(Applicable repr, Foldable repr) =>
Int -> repr a -> repr [a]
manyN Int
1

skipMany ::
 Applicable repr => Foldable repr =>
 repr a -> repr ()
--skipMany p = let skipManyp = p *> skipManyp <|> unit in skipManyp
skipMany :: forall (repr :: * -> *) a.
(Applicable repr, Foldable repr) =>
repr a -> repr ()
skipMany = repr () -> repr ()
forall (repr :: * -> *) a. Applicable repr => repr a -> repr ()
void (repr () -> repr ()) -> (repr a -> repr ()) -> repr a -> repr ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Haskell (() -> a -> ()) -> Haskell () -> repr a -> repr ()
forall (repr :: * -> *) b a.
(Applicable repr, Foldable repr) =>
Haskell (b -> a -> b) -> Haskell b -> repr a -> repr b
pfoldl Haskell (() -> a -> ())
forall (repr :: * -> *) a b. Haskellable repr => repr (a -> b -> a)
H.const Haskell ()
forall (repr :: * -> *). Haskellable repr => repr ()
H.unit -- the void here will encourage the optimiser to recognise that the register is unused

skipManyN ::
 Applicable repr => Foldable repr =>
 Int -> repr a -> repr ()
skipManyN :: forall (repr :: * -> *) a.
(Applicable repr, Foldable repr) =>
Int -> repr a -> repr ()
skipManyN Int
n repr a
p = (Int -> repr () -> repr ()) -> repr () -> [Int] -> repr ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr ((repr () -> repr ()) -> Int -> repr () -> repr ()
forall a b. a -> b -> a
const (repr a
p repr a -> repr () -> repr ()
forall (repr :: * -> *) a b.
Applicable repr =>
repr a -> repr b -> repr b
*>)) (repr a -> repr ()
forall (repr :: * -> *) a.
(Applicable repr, Foldable repr) =>
repr a -> repr ()
skipMany repr a
p) [Int
1..Int
n]

skipSome ::
 Applicable repr => Foldable repr =>
 repr a -> repr ()
skipSome :: forall (repr :: * -> *) a.
(Applicable repr, Foldable repr) =>
repr a -> repr ()
skipSome = Int -> repr a -> repr ()
forall (repr :: * -> *) a.
(Applicable repr, Foldable repr) =>
Int -> repr a -> repr ()
skipManyN Int
1

sepBy ::
 Applicable repr => Alternable repr => Foldable repr =>
 repr a -> repr b -> repr [a]
sepBy :: forall (repr :: * -> *) a b.
(Applicable repr, Alternable repr, Foldable repr) =>
repr a -> repr b -> repr [a]
sepBy repr a
p repr b
sep = Haskell [a] -> repr [a] -> repr [a]
forall (repr :: * -> *) a.
(Applicable repr, Alternable repr) =>
Haskell a -> repr a -> repr a
option Haskell [a]
forall (repr :: * -> *) a. Haskellable repr => repr [a]
H.nil (repr a -> repr b -> repr [a]
forall (repr :: * -> *) a b.
(Applicable repr, Alternable repr, Foldable repr) =>
repr a -> repr b -> repr [a]
sepBy1 repr a
p repr b
sep)

sepBy1 ::
 Applicable repr => Alternable repr => Foldable repr =>
 repr a -> repr b -> repr [a]
sepBy1 :: forall (repr :: * -> *) a b.
(Applicable repr, Alternable repr, Foldable repr) =>
repr a -> repr b -> repr [a]
sepBy1 repr a
p repr b
sep = repr a
p repr a -> repr [a] -> repr [a]
forall (repr :: * -> *) a.
Applicable repr =>
repr a -> repr [a] -> repr [a]
<:> repr a -> repr [a]
forall (repr :: * -> *) a.
(Applicable repr, Foldable repr) =>
repr a -> repr [a]
many (repr b
sep repr b -> repr a -> repr a
forall (repr :: * -> *) a b.
Applicable repr =>
repr a -> repr b -> repr b
*> repr a
p)

endBy ::
 Applicable repr => Alternable repr => Foldable repr =>
 repr a -> repr b -> repr [a]
endBy :: forall (repr :: * -> *) a b.
(Applicable repr, Alternable repr, Foldable repr) =>
repr a -> repr b -> repr [a]
endBy repr a
p repr b
sep = repr a -> repr [a]
forall (repr :: * -> *) a.
(Applicable repr, Foldable repr) =>
repr a -> repr [a]
many (repr a
p repr a -> repr b -> repr a
forall (repr :: * -> *) a b.
Applicable repr =>
repr a -> repr b -> repr a
<* repr b
sep)

endBy1 ::
 Applicable repr => Alternable repr => Foldable repr =>
 repr a -> repr b -> repr [a]
endBy1 :: forall (repr :: * -> *) a b.
(Applicable repr, Alternable repr, Foldable repr) =>
repr a -> repr b -> repr [a]
endBy1 repr a
p repr b
sep = repr a -> repr [a]
forall (repr :: * -> *) a.
(Applicable repr, Foldable repr) =>
repr a -> repr [a]
some (repr a
p repr a -> repr b -> repr a
forall (repr :: * -> *) a b.
Applicable repr =>
repr a -> repr b -> repr a
<* repr b
sep)

sepEndBy ::
 Applicable repr => Alternable repr => Foldable repr =>
 repr a -> repr b -> repr [a]
sepEndBy :: forall (repr :: * -> *) a b.
(Applicable repr, Alternable repr, Foldable repr) =>
repr a -> repr b -> repr [a]
sepEndBy repr a
p repr b
sep = Haskell [a] -> repr [a] -> repr [a]
forall (repr :: * -> *) a.
(Applicable repr, Alternable repr) =>
Haskell a -> repr a -> repr a
option Haskell [a]
forall (repr :: * -> *) a. Haskellable repr => repr [a]
H.nil (repr a -> repr b -> repr [a]
forall (repr :: * -> *) a b.
(Applicable repr, Alternable repr, Foldable repr) =>
repr a -> repr b -> repr [a]
sepEndBy1 repr a
p repr b
sep)

sepEndBy1 ::
 Applicable repr => Alternable repr => Foldable repr =>
 repr a -> repr b -> repr [a]
sepEndBy1 :: forall (repr :: * -> *) a b.
(Applicable repr, Alternable repr, Foldable repr) =>
repr a -> repr b -> repr [a]
sepEndBy1 repr a
p repr b
sep =
  let seb1 :: repr [a]
seb1 = repr a
p repr a -> repr (a -> [a]) -> repr [a]
forall (repr :: * -> *) a b.
Applicable repr =>
repr a -> repr (a -> b) -> repr b
<**> (repr b
sep repr b -> repr (a -> [a]) -> repr (a -> [a])
forall (repr :: * -> *) a b.
Applicable repr =>
repr a -> repr b -> repr b
*> (Haskell ((a -> [a] -> [a]) -> [a] -> a -> [a])
forall (repr :: * -> *) a b c.
Haskellable repr =>
repr ((a -> b -> c) -> b -> a -> c)
H.flip Haskell ((a -> [a] -> [a]) -> [a] -> a -> [a])
-> Haskell (a -> [a] -> [a]) -> Haskell ([a] -> a -> [a])
forall (repr :: * -> *) a b.
Haskellable repr =>
repr (a -> b) -> repr a -> repr b
H..@ Haskell (a -> [a] -> [a])
forall (repr :: * -> *) a.
Haskellable repr =>
repr (a -> [a] -> [a])
H.cons Haskell ([a] -> a -> [a]) -> repr [a] -> repr (a -> [a])
forall (repr :: * -> *) a b.
Applicable repr =>
Haskell (a -> b) -> repr a -> repr b
<$> Haskell [a] -> repr [a] -> repr [a]
forall (repr :: * -> *) a.
(Applicable repr, Alternable repr) =>
Haskell a -> repr a -> repr a
option Haskell [a]
forall (repr :: * -> *) a. Haskellable repr => repr [a]
H.nil repr [a]
seb1)
                 repr (a -> [a]) -> repr (a -> [a]) -> repr (a -> [a])
forall (repr :: * -> *) a.
Alternable repr =>
repr a -> repr a -> repr a
<|> Haskell (a -> [a]) -> repr (a -> [a])
forall (repr :: * -> *) a. Applicable repr => Haskell a -> repr a
pure (Haskell ((a -> [a] -> [a]) -> [a] -> a -> [a])
forall (repr :: * -> *) a b c.
Haskellable repr =>
repr ((a -> b -> c) -> b -> a -> c)
H.flip Haskell ((a -> [a] -> [a]) -> [a] -> a -> [a])
-> Haskell (a -> [a] -> [a]) -> Haskell ([a] -> a -> [a])
forall (repr :: * -> *) a b.
Haskellable repr =>
repr (a -> b) -> repr a -> repr b
H..@ Haskell (a -> [a] -> [a])
forall (repr :: * -> *) a.
Haskellable repr =>
repr (a -> [a] -> [a])
H.cons Haskell ([a] -> a -> [a]) -> Haskell [a] -> Haskell (a -> [a])
forall (repr :: * -> *) a b.
Haskellable repr =>
repr (a -> b) -> repr a -> repr b
H..@ Haskell [a]
forall (repr :: * -> *) a. Haskellable repr => repr [a]
H.nil))
  in repr [a]
seb1

{-
sepEndBy1 :: repr a -> repr b -> repr [a]
sepEndBy1 p sep = newRegister_ H.id $ \acc ->
  let go = modify acc ((H.flip (H..)) H..@ H.cons <$> p)
         *> (sep *> (go <|> get acc) <|> get acc)
  in go <*> pure H.nil
-}

{-
-- Combinators interpreters for 'Sym.Any'.
instance Applicable repr => Applicable (Sym.Any repr)
instance Satisfiable repr => Satisfiable (Sym.Any repr)
instance Alternable repr => Alternable (Sym.Any repr)
instance Selectable repr => Selectable (Sym.Any repr)
instance Matchable repr => Matchable (Sym.Any repr)
instance Lookable repr => Lookable (Sym.Any repr)
instance Foldable repr => Foldable (Sym.Any repr)
-}