{-# LANGUAGE OverloadedStrings #-}
module Parsley.Internal.Core.CombinatorAST (module Parsley.Internal.Core.CombinatorAST) where

import Data.Kind                         (Type)
import Parsley.Internal.Common           (IFunctor(..), Fix, Const1(..), cata, intercalateDiff, (:+:))
import Parsley.Internal.Core.Identifiers (MVar, ΣVar)
import Parsley.Internal.Core.CharPred    (CharPred)
import Parsley.Internal.Core.Defunc      (Defunc)

{-|
The opaque datatype that represents parsers.

@since 0.1.0.0
-}
newtype Parser a = Parser {Parser a -> Fix (Combinator :+: ScopeRegister) a
unParser :: Fix (Combinator :+: ScopeRegister) a}

-- Core datatype
data Combinator (k :: Type -> Type) (a :: Type) where
  Pure           :: Defunc a -> Combinator k a
  Satisfy        :: CharPred -> Combinator k Char
  (:<*>:)        :: k (a -> b) -> k a -> Combinator k b
  (:*>:)         :: k a -> k b -> Combinator k b
  (:<*:)         :: k a -> k b -> Combinator k a
  (:<|>:)        :: k a -> k a -> Combinator k a
  Empty          :: Combinator k a
  Try            :: k a -> Combinator k a
  LookAhead      :: k a -> Combinator k a
  Let            :: Bool -> MVar a -> Combinator k a
  NotFollowedBy  :: k a -> Combinator k ()
  Branch         :: k (Either a b) -> k (a -> c) -> k (b -> c) -> Combinator k c
  Match          :: k a -> [Defunc (a -> Bool)] -> [k b] -> k b -> Combinator k b
  Loop           :: k () -> k a -> Combinator k a
  MakeRegister   :: ΣVar a -> k a -> k b -> Combinator k b
  GetRegister    :: ΣVar a -> Combinator k a
  PutRegister    :: ΣVar a -> k a -> Combinator k ()
  Position       :: PosSelector -> Combinator k Int
  Debug          :: String -> k a -> Combinator k a
  MetaCombinator :: MetaCombinator -> k a -> Combinator k a

data ScopeRegister (k :: Type -> Type) (a :: Type) where
  ScopeRegister :: k a -> (forall r. Reg r a -> k b) -> ScopeRegister k b

data PosSelector where
  Line :: PosSelector
  Col  :: PosSelector

{-|
This is an opaque representation of a parsing register. It cannot be manipulated as a user, and the
type parameter @r@ is used to ensure that it cannot leak out of the scope it has been created in.
It is the abstracted representation of a runtime storage location.

@since 0.1.0.0
-}
newtype Reg (r :: Type) a = Reg (ΣVar a)

data MetaCombinator where
  -- | After this combinator exits, a cut has happened
  Cut         :: MetaCombinator
  -- | This combinator requires a cut from below to respect parsec semantics
  RequiresCut :: MetaCombinator
  -- | This combinator denotes that within its scope, cut semantics are not enforced
  --
  -- @since 1.6.0.0
  CutImmune   :: MetaCombinator

-- Instances
instance IFunctor Combinator where
  imap :: (forall j. a j -> b j) -> Combinator a i -> Combinator b i
imap forall j. a j -> b j
_ (Pure Defunc i
x)             = Defunc i -> Combinator b i
forall a (k :: Type -> Type). Defunc a -> Combinator k a
Pure Defunc i
x
  imap forall j. a j -> b j
_ (Satisfy CharPred
p)          = CharPred -> Combinator b Char
forall (k :: Type -> Type). CharPred -> Combinator k Char
Satisfy CharPred
p
  imap forall j. a j -> b j
f (a (a -> i)
p :<*>: a a
q)          = a (a -> i) -> b (a -> i)
forall j. a j -> b j
f a (a -> i)
p b (a -> i) -> b a -> Combinator b i
forall (k :: Type -> Type) a b. k (a -> b) -> k a -> Combinator k b
:<*>: a a -> b a
forall j. a j -> b j
f a a
q
  imap forall j. a j -> b j
f (a a
p :*>: a i
q)           = a a -> b a
forall j. a j -> b j
f a a
p b a -> b i -> Combinator b i
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k b
:*>: a i -> b i
forall j. a j -> b j
f a i
q
  imap forall j. a j -> b j
f (a i
p :<*: a b
q)           = a i -> b i
forall j. a j -> b j
f a i
p b i -> b b -> Combinator b i
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k a
:<*: a b -> b b
forall j. a j -> b j
f a b
q
  imap forall j. a j -> b j
f (a i
p :<|>: a i
q)          = a i -> b i
forall j. a j -> b j
f a i
p b i -> b i -> Combinator b i
forall (k :: Type -> Type) a. k a -> k a -> Combinator k a
:<|>: a i -> b i
forall j. a j -> b j
f a i
q
  imap forall j. a j -> b j
_ Combinator a i
Empty                = Combinator b i
forall (k :: Type -> Type) a. Combinator k a
Empty
  imap forall j. a j -> b j
f (Try a i
p)              = b i -> Combinator b i
forall (k :: Type -> Type) a. k a -> Combinator k a
Try (a i -> b i
forall j. a j -> b j
f a i
p)
  imap forall j. a j -> b j
f (LookAhead a i
p)        = b i -> Combinator b i
forall (k :: Type -> Type) a. k a -> Combinator k a
LookAhead (a i -> b i
forall j. a j -> b j
f a i
p)
  imap forall j. a j -> b j
_ (Let Bool
r MVar i
v)            = Bool -> MVar i -> Combinator b i
forall a (k :: Type -> Type). Bool -> MVar a -> Combinator k a
Let Bool
r MVar i
v
  imap forall j. a j -> b j
f (NotFollowedBy a a
p)    = b a -> Combinator b ()
forall (k :: Type -> Type) a. k a -> Combinator k ()
NotFollowedBy (a a -> b a
forall j. a j -> b j
f a a
p)
  imap forall j. a j -> b j
f (Branch a (Either a b)
b a (a -> i)
p a (b -> i)
q)       = b (Either a b) -> b (a -> i) -> b (b -> i) -> Combinator b i
forall (k :: Type -> Type) a b c.
k (Either a b) -> k (a -> c) -> k (b -> c) -> Combinator k c
Branch (a (Either a b) -> b (Either a b)
forall j. a j -> b j
f a (Either a b)
b) (a (a -> i) -> b (a -> i)
forall j. a j -> b j
f a (a -> i)
p) (a (b -> i) -> b (b -> i)
forall j. a j -> b j
f a (b -> i)
q)
  imap forall j. a j -> b j
f (Match a a
p [Defunc (a -> Bool)]
fs [a i]
qs a i
d)    = b a -> [Defunc (a -> Bool)] -> [b i] -> b i -> Combinator b i
forall (k :: Type -> Type) a b.
k a -> [Defunc (a -> Bool)] -> [k b] -> k b -> Combinator k b
Match (a a -> b a
forall j. a j -> b j
f a a
p) [Defunc (a -> Bool)]
fs ((a i -> b i) -> [a i] -> [b i]
forall a b. (a -> b) -> [a] -> [b]
map a i -> b i
forall j. a j -> b j
f [a i]
qs) (a i -> b i
forall j. a j -> b j
f a i
d)
  imap forall j. a j -> b j
f (Loop a ()
body a i
exit)     = b () -> b i -> Combinator b i
forall (k :: Type -> Type) a. k () -> k a -> Combinator k a
Loop (a () -> b ()
forall j. a j -> b j
f a ()
body) (a i -> b i
forall j. a j -> b j
f a i
exit)
  imap forall j. a j -> b j
f (MakeRegister ΣVar a
σ a a
p a i
q) = ΣVar a -> b a -> b i -> Combinator b i
forall a (k :: Type -> Type) b.
ΣVar a -> k a -> k b -> Combinator k b
MakeRegister ΣVar a
σ (a a -> b a
forall j. a j -> b j
f a a
p) (a i -> b i
forall j. a j -> b j
f a i
q)
  imap forall j. a j -> b j
_ (GetRegister ΣVar i
σ)      = ΣVar i -> Combinator b i
forall a (k :: Type -> Type). ΣVar a -> Combinator k a
GetRegister ΣVar i
σ
  imap forall j. a j -> b j
f (PutRegister ΣVar a
σ a a
p)    = ΣVar a -> b a -> Combinator b ()
forall a (k :: Type -> Type). ΣVar a -> k a -> Combinator k ()
PutRegister ΣVar a
σ (a a -> b a
forall j. a j -> b j
f a a
p)
  imap forall j. a j -> b j
_ (Position PosSelector
sel)       = PosSelector -> Combinator b Int
forall (k :: Type -> Type). PosSelector -> Combinator k Int
Position PosSelector
sel
  imap forall j. a j -> b j
f (Debug String
name a i
p)       = String -> b i -> Combinator b i
forall (k :: Type -> Type) a. String -> k a -> Combinator k a
Debug String
name (a i -> b i
forall j. a j -> b j
f a i
p)
  imap forall j. a j -> b j
f (MetaCombinator MetaCombinator
m a i
p) = MetaCombinator -> b i -> Combinator b i
forall (k :: Type -> Type) a.
MetaCombinator -> k a -> Combinator k a
MetaCombinator MetaCombinator
m (a i -> b i
forall j. a j -> b j
f a i
p)

instance Show (Fix Combinator a) where
  show :: Fix Combinator a -> String
show = (ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"") (ShowS -> String)
-> (Fix Combinator a -> ShowS) -> Fix Combinator a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const1 ShowS a -> ShowS
forall a k1 (k2 :: k1). Const1 a k2 -> a
getConst1 (Const1 ShowS a -> ShowS)
-> (Fix Combinator a -> Const1 ShowS a)
-> Fix Combinator a
-> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall j. Combinator (Const1 ShowS) j -> Const1 ShowS j)
-> Fix Combinator a -> Const1 ShowS a
forall (f :: (Type -> Type) -> Type -> Type) (a :: Type -> Type) i.
IFunctor f =>
(forall j. f a j -> a j) -> Fix f i -> a i
cata (ShowS -> Const1 ShowS j
forall k1 a (k2 :: k1). a -> Const1 a k2
Const1 (ShowS -> Const1 ShowS j)
-> (Combinator (Const1 ShowS) j -> ShowS)
-> Combinator (Const1 ShowS) j
-> Const1 ShowS j
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Combinator (Const1 ShowS) j -> ShowS
forall a. Combinator (Const1 ShowS) a -> ShowS
alg)
    where
      alg :: Combinator (Const1 ShowS) a -> ShowS
alg (Pure Defunc a
x)                                  = ShowS
"pure " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Defunc a -> ShowS
forall a. Show a => a -> ShowS
shows Defunc a
x
      alg (Satisfy CharPred
f)                               = ShowS
"satisfy " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharPred -> ShowS
forall a. Show a => a -> ShowS
shows CharPred
f
      alg (Const1 pf :<*>: Const1 px)               = ShowS
"(" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
pf ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
" <*> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  ShowS
px ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
      alg (Const1 p :*>: Const1 q)                  = ShowS
"(" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
" *> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
q ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
      alg (Const1 p :<*: Const1 q)                  = ShowS
"(" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
" <* " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
q ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
      alg (Const1 ShowS
p :<|>: Const1 ShowS
q)                 = ShowS
"(" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
" <|> " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
q ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
      alg Combinator (Const1 ShowS) a
Empty                                     = ShowS
"empty"
      alg (Try (Const1 ShowS
p))                          = ShowS
"try ("ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
      alg (LookAhead (Const1 ShowS
p))                    = ShowS
"lookAhead (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
      alg (Let Bool
False MVar a
v)                             = ShowS
"let-bound " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar a -> ShowS
forall a. Show a => a -> ShowS
shows MVar a
v
      alg (Let Bool
True MVar a
v)                              = ShowS
"rec " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar a -> ShowS
forall a. Show a => a -> ShowS
shows MVar a
v
      alg (NotFollowedBy (Const1 ShowS
p))                = ShowS
"notFollowedBy (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
      alg (Branch (Const1 ShowS
b) (Const1 ShowS
p) (Const1 ShowS
q)) = ShowS
"branch (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
b ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
") (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
") (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
q ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
      alg (Match (Const1 ShowS
p) [Defunc (a -> Bool)]
fs [Const1 ShowS a]
qs (Const1 ShowS
def))     = ShowS
"match (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
") " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Defunc (a -> Bool)] -> ShowS
forall a. Show a => a -> ShowS
shows [Defunc (a -> Bool)]
fs ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
" [" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [ShowS] -> ShowS
forall a. (a -> a) -> [a -> a] -> a -> a
intercalateDiff ShowS
", " ((Const1 ShowS a -> ShowS) -> [Const1 ShowS a] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map Const1 ShowS a -> ShowS
forall a k1 (k2 :: k1). Const1 a k2 -> a
getConst1 [Const1 ShowS a]
qs) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
"] ("  ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
def ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
      alg (Loop (Const1 ShowS
body) (Const1 ShowS
exit))        = ShowS
"loop (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
body ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
") (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
exit ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
      alg (MakeRegister ΣVar a
σ (Const1 ShowS
p) (Const1 ShowS
q))    = ShowS
"make " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ΣVar a -> ShowS
forall a. Show a => a -> ShowS
shows ΣVar a
σ ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
" (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
") (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
q ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
      alg (GetRegister ΣVar a
σ)                           = ShowS
"get " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ΣVar a -> ShowS
forall a. Show a => a -> ShowS
shows ΣVar a
σ
      alg (PutRegister ΣVar a
σ (Const1 ShowS
p))                = ShowS
"put " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ΣVar a -> ShowS
forall a. Show a => a -> ShowS
shows ΣVar a
σ ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
" (" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"
      alg (Position PosSelector
Line)                           = ShowS
"line"
      alg (Position PosSelector
Col)                            = ShowS
"col"
      alg (Debug String
_ (Const1 ShowS
p))                      = ShowS
p
      alg (MetaCombinator MetaCombinator
m (Const1 ShowS
p))             = ShowS
p ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
" [" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaCombinator -> ShowS
forall a. Show a => a -> ShowS
shows MetaCombinator
m ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
"]"

instance IFunctor ScopeRegister where
  imap :: (forall j. a j -> b j) -> ScopeRegister a i -> ScopeRegister b i
imap forall j. a j -> b j
f (ScopeRegister a a
p forall r. Reg r a -> a i
g) = b a -> (forall r. Reg r a -> b i) -> ScopeRegister b i
forall (k :: Type -> Type) a b.
k a -> (forall r. Reg r a -> k b) -> ScopeRegister k b
ScopeRegister (a a -> b a
forall j. a j -> b j
f a a
p) (a i -> b i
forall j. a j -> b j
f (a i -> b i) -> (Reg r a -> a i) -> Reg r a -> b i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reg r a -> a i
forall r. Reg r a -> a i
g)

instance Show MetaCombinator where
  show :: MetaCombinator -> String
show MetaCombinator
Cut = String
"coins after"
  show MetaCombinator
RequiresCut = String
"requires cut"
  show MetaCombinator
CutImmune = String
"immune to cuts"

{-# INLINE traverseCombinator #-}
traverseCombinator :: Applicative m => (forall a. f a -> m (k a)) -> Combinator f a -> m (Combinator k a)
traverseCombinator :: (forall a. f a -> m (k a)) -> Combinator f a -> m (Combinator k a)
traverseCombinator forall a. f a -> m (k a)
expose (f (a -> a)
pf :<*>: f a
px)        = k (a -> a) -> k a -> Combinator k a
forall (k :: Type -> Type) a b. k (a -> b) -> k a -> Combinator k b
(:<*>:) (k (a -> a) -> k a -> Combinator k a)
-> m (k (a -> a)) -> m (k a -> Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a -> a) -> m (k (a -> a))
forall a. f a -> m (k a)
expose f (a -> a)
pf m (k a -> Combinator k a) -> m (k a) -> m (Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
px
traverseCombinator forall a. f a -> m (k a)
expose (f a
p :*>: f a
q)           = k a -> k a -> Combinator k a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k b
(:*>:) (k a -> k a -> Combinator k a)
-> m (k a) -> m (k a -> Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p m (k a -> Combinator k a) -> m (k a) -> m (Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
q
traverseCombinator forall a. f a -> m (k a)
expose (f a
p :<*: f b
q)           = k a -> k b -> Combinator k a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k a
(:<*:) (k a -> k b -> Combinator k a)
-> m (k a) -> m (k b -> Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p m (k b -> Combinator k a) -> m (k b) -> m (Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f b -> m (k b)
forall a. f a -> m (k a)
expose f b
q
traverseCombinator forall a. f a -> m (k a)
expose (f a
p :<|>: f a
q)          = k a -> k a -> Combinator k a
forall (k :: Type -> Type) a. k a -> k a -> Combinator k a
(:<|>:) (k a -> k a -> Combinator k a)
-> m (k a) -> m (k a -> Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p m (k a -> Combinator k a) -> m (k a) -> m (Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
q
traverseCombinator forall a. f a -> m (k a)
_      Combinator f a
Empty                = Combinator k a -> m (Combinator k a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Combinator k a
forall (k :: Type -> Type) a. Combinator k a
Empty
traverseCombinator forall a. f a -> m (k a)
expose (Try f a
p)              = k a -> Combinator k a
forall (k :: Type -> Type) a. k a -> Combinator k a
Try (k a -> Combinator k a) -> m (k a) -> m (Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p
traverseCombinator forall a. f a -> m (k a)
expose (LookAhead f a
p)        = k a -> Combinator k a
forall (k :: Type -> Type) a. k a -> Combinator k a
LookAhead (k a -> Combinator k a) -> m (k a) -> m (Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p
traverseCombinator forall a. f a -> m (k a)
expose (NotFollowedBy f a
p)    = k a -> Combinator k ()
forall (k :: Type -> Type) a. k a -> Combinator k ()
NotFollowedBy (k a -> Combinator k ()) -> m (k a) -> m (Combinator k ())
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p
traverseCombinator forall a. f a -> m (k a)
expose (Branch f (Either a b)
b f (a -> a)
p f (b -> a)
q)       = k (Either a b) -> k (a -> a) -> k (b -> a) -> Combinator k a
forall (k :: Type -> Type) a b c.
k (Either a b) -> k (a -> c) -> k (b -> c) -> Combinator k c
Branch (k (Either a b) -> k (a -> a) -> k (b -> a) -> Combinator k a)
-> m (k (Either a b))
-> m (k (a -> a) -> k (b -> a) -> Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Either a b) -> m (k (Either a b))
forall a. f a -> m (k a)
expose f (Either a b)
b m (k (a -> a) -> k (b -> a) -> Combinator k a)
-> m (k (a -> a)) -> m (k (b -> a) -> Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f (a -> a) -> m (k (a -> a))
forall a. f a -> m (k a)
expose f (a -> a)
p m (k (b -> a) -> Combinator k a)
-> m (k (b -> a)) -> m (Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f (b -> a) -> m (k (b -> a))
forall a. f a -> m (k a)
expose f (b -> a)
q
traverseCombinator forall a. f a -> m (k a)
expose (Match f a
p [Defunc (a -> Bool)]
fs [f a]
qs f a
d)    = k a -> [Defunc (a -> Bool)] -> [k a] -> k a -> Combinator k a
forall (k :: Type -> Type) a b.
k a -> [Defunc (a -> Bool)] -> [k b] -> k b -> Combinator k b
Match (k a -> [Defunc (a -> Bool)] -> [k a] -> k a -> Combinator k a)
-> m (k a)
-> m ([Defunc (a -> Bool)] -> [k a] -> k a -> Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p m ([Defunc (a -> Bool)] -> [k a] -> k a -> Combinator k a)
-> m [Defunc (a -> Bool)] -> m ([k a] -> k a -> Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> [Defunc (a -> Bool)] -> m [Defunc (a -> Bool)]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [Defunc (a -> Bool)]
fs m ([k a] -> k a -> Combinator k a)
-> m [k a] -> m (k a -> Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (f a -> m (k a)) -> [f a] -> m [k a]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse f a -> m (k a)
forall a. f a -> m (k a)
expose [f a]
qs m (k a -> Combinator k a) -> m (k a) -> m (Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
d
traverseCombinator forall a. f a -> m (k a)
expose (Loop f ()
body f a
exit)     = k () -> k a -> Combinator k a
forall (k :: Type -> Type) a. k () -> k a -> Combinator k a
Loop (k () -> k a -> Combinator k a)
-> m (k ()) -> m (k a -> Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f () -> m (k ())
forall a. f a -> m (k a)
expose f ()
body m (k a -> Combinator k a) -> m (k a) -> m (Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
exit
traverseCombinator forall a. f a -> m (k a)
expose (MakeRegister ΣVar a
σ f a
p f a
q) = ΣVar a -> k a -> k a -> Combinator k a
forall a (k :: Type -> Type) b.
ΣVar a -> k a -> k b -> Combinator k b
MakeRegister ΣVar a
σ (k a -> k a -> Combinator k a)
-> m (k a) -> m (k a -> Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p m (k a -> Combinator k a) -> m (k a) -> m (Combinator k a)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
q
traverseCombinator forall a. f a -> m (k a)
_      (GetRegister ΣVar a
σ)      = Combinator k a -> m (Combinator k a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ΣVar a -> Combinator k a
forall a (k :: Type -> Type). ΣVar a -> Combinator k a
GetRegister ΣVar a
σ)
traverseCombinator forall a. f a -> m (k a)
expose (PutRegister ΣVar a
σ f a
p)    = ΣVar a -> k a -> Combinator k ()
forall a (k :: Type -> Type). ΣVar a -> k a -> Combinator k ()
PutRegister ΣVar a
σ (k a -> Combinator k ()) -> m (k a) -> m (Combinator k ())
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p
traverseCombinator forall a. f a -> m (k a)
_      (Position PosSelector
sel)       = Combinator k Int -> m (Combinator k Int)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (PosSelector -> Combinator k Int
forall (k :: Type -> Type). PosSelector -> Combinator k Int
Position PosSelector
sel)
traverseCombinator forall a. f a -> m (k a)
expose (Debug String
name f a
p)       = String -> k a -> Combinator k a
forall (k :: Type -> Type) a. String -> k a -> Combinator k a
Debug String
name (k a -> Combinator k a) -> m (k a) -> m (Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p
traverseCombinator forall a. f a -> m (k a)
_      (Pure Defunc a
x)             = Combinator k a -> m (Combinator k a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Defunc a -> Combinator k a
forall a (k :: Type -> Type). Defunc a -> Combinator k a
Pure Defunc a
x)
traverseCombinator forall a. f a -> m (k a)
_      (Satisfy CharPred
f)          = Combinator k Char -> m (Combinator k Char)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (CharPred -> Combinator k Char
forall (k :: Type -> Type). CharPred -> Combinator k Char
Satisfy CharPred
f)
traverseCombinator forall a. f a -> m (k a)
_      (Let Bool
r MVar a
v)            = Combinator k a -> m (Combinator k a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Bool -> MVar a -> Combinator k a
forall a (k :: Type -> Type). Bool -> MVar a -> Combinator k a
Let Bool
r MVar a
v)
traverseCombinator forall a. f a -> m (k a)
expose (MetaCombinator MetaCombinator
m f a
p) = MetaCombinator -> k a -> Combinator k a
forall (k :: Type -> Type) a.
MetaCombinator -> k a -> Combinator k a
MetaCombinator MetaCombinator
m (k a -> Combinator k a) -> m (k a) -> m (Combinator k a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p