{-# LANGUAGE ApplicativeDo,
             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.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        :: Defunc (Char -> Bool) -> 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 -> k 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
  ChainPre       :: k (a -> a) -> k a -> Combinator k a
  ChainPost      :: k a -> k (a -> 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 ()
  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

{-|
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
  Cut         :: MetaCombinator
  RequiresCut :: 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 Defunc (Char -> Bool)
p)          = Defunc (Char -> Bool) -> Combinator b Char
forall (k :: Type -> Type).
Defunc (Char -> Bool) -> Combinator k Char
Satisfy Defunc (Char -> Bool)
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
f (Let Bool
r MVar i
v a i
p)          = Bool -> MVar i -> b i -> Combinator b i
forall a (k :: Type -> Type).
Bool -> MVar a -> k a -> Combinator k a
Let Bool
r MVar i
v (a i -> b i
forall j. a j -> b j
f a i
p)
  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 (ChainPre a (i -> i)
op a i
p)      = b (i -> i) -> b i -> Combinator b i
forall (k :: Type -> Type) a. k (a -> a) -> k a -> Combinator k a
ChainPre (a (i -> i) -> b (i -> i)
forall j. a j -> b j
f a (i -> i)
op) (a i -> b i
forall j. a j -> b j
f a i
p)
  imap forall j. a j -> b j
f (ChainPost a i
p a (i -> i)
op)     = b i -> b (i -> i) -> Combinator b i
forall (k :: Type -> Type) a. k a -> k (a -> a) -> Combinator k a
ChainPost (a i -> b i
forall j. a j -> b j
f a i
p) (a (i -> i) -> b (i -> i)
forall j. a j -> b j
f a (i -> i)
op)
  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
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 a.
(IsString (a -> a), IsString (a -> String),
 IsString (String -> a)) =>
Combinator (Const1 (a -> a)) a -> a -> a
alg)
    where
      alg :: Combinator (Const1 (a -> a)) a -> a -> a
alg (Pure Defunc a
x)                                  = String -> a
"(pure " (String -> a) -> (a -> String) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Defunc a -> ShowS
forall a. Show a => a -> ShowS
shows Defunc a
x ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
")"
      alg (Satisfy Defunc (Char -> Bool)
f)                               = String -> a
"(satisfy " (String -> a) -> (a -> String) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Defunc (Char -> Bool) -> ShowS
forall a. Show a => a -> ShowS
shows Defunc (Char -> Bool)
f ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
")"
      alg (Const1 pf :<*>: Const1 px)               = a -> a
"(" (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
pf (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
" <*> " (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  a -> a
px (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
")"
      alg (Const1 p :*>: Const1 q)                  = a -> a
"(" (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
p (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
" *> " (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
q (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
")"
      alg (Const1 p :<*: Const1 q)                  = a -> a
"(" (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
p (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
" <* " (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
q (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
")"
      alg (Const1 a -> a
p :<|>: Const1 a -> a
q)                 = a -> a
"(" (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
p (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
" <|> " (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
q (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
")"
      alg Combinator (Const1 (a -> a)) a
Empty                                     = a -> a
"empty"
      alg (Try (Const1 a -> a
p))                          = a -> a
"(try " (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
p (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
")"
      alg (LookAhead (Const1 a -> a
p))                    = a -> a
"(lookAhead " (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
p (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
")"
      alg (Let Bool
False MVar a
v Const1 (a -> a) a
_)                           = String -> a
"(let-bound " (String -> a) -> (a -> String) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar a -> ShowS
forall a. Show a => a -> ShowS
shows MVar a
v ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
")"
      alg (Let Bool
True MVar a
v Const1 (a -> a) a
_)                            = String -> a
"(rec " (String -> a) -> (a -> String) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar a -> ShowS
forall a. Show a => a -> ShowS
shows MVar a
v ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
")"
      alg (NotFollowedBy (Const1 a -> a
p))                = a -> a
"(notFollowedBy " (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
p (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
")"
      alg (Branch (Const1 a -> a
b) (Const1 a -> a
p) (Const1 a -> a
q)) = a -> a
"(branch " (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
b (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
" " (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
p (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
" " (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
q (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
")"
      alg (Match (Const1 a -> a
p) [Defunc (a -> Bool)]
fs [Const1 (a -> a) a]
qs (Const1 a -> a
def))     = a -> a
"(match " (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
p (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
" " (String -> a) -> (a -> String) -> a -> a
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 -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
" [" (a -> String) -> (a -> a) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> [a -> a] -> a -> a
forall a. (a -> a) -> [a -> a] -> a -> a
intercalateDiff a -> a
", " ((Const1 (a -> a) a -> a -> a) -> [Const1 (a -> a) a] -> [a -> a]
forall a b. (a -> b) -> [a] -> [b]
map Const1 (a -> a) a -> a -> a
forall a k1 (k2 :: k1). Const1 a k2 -> a
getConst1 [Const1 (a -> a) a]
qs) (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
"] "  (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
def (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
")"
      alg (ChainPre (Const1 a -> a
op) (Const1 a -> a
p))         = a -> a
"(chainPre " (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
op (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
" " (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
p (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
")"
      alg (ChainPost (Const1 a -> a
p) (Const1 a -> a
op))        = a -> a
"(chainPost " (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
p (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
" " (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
op (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
")"
      alg (MakeRegister ΣVar a
σ (Const1 a -> a
p) (Const1 a -> a
q))    = String -> a
"(make " (String -> a) -> (a -> String) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ΣVar a -> ShowS
forall a. Show a => a -> ShowS
shows ΣVar a
σ ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
" " (a -> String) -> (a -> a) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
p (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
" " (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
q (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
")"
      alg (GetRegister ΣVar a
σ)                           = String -> a
"(get " (String -> a) -> (a -> String) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ΣVar a -> ShowS
forall a. Show a => a -> ShowS
shows ΣVar a
σ ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
")"
      alg (PutRegister ΣVar a
σ (Const1 a -> a
p))                = String -> a
"(put " (String -> a) -> (a -> String) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ΣVar a -> ShowS
forall a. Show a => a -> ShowS
shows ΣVar a
σ ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
" " (a -> String) -> (a -> a) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
p (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
")"
      alg (Debug String
_ (Const1 a -> a
p))                      = a -> a
p
      alg (MetaCombinator MetaCombinator
m (Const1 a -> a
p))             = a -> a
p (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
" [" (String -> a) -> (a -> String) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaCombinator -> ShowS
forall a. Show a => a -> ShowS
shows MetaCombinator
m ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
"]"

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"

{-# 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)        = do k (a -> a)
pf' <- f (a -> a) -> m (k (a -> a))
forall a. f a -> m (k a)
expose f (a -> a)
pf; k a
px' <- f a -> m (k a)
forall a. f a -> m (k a)
expose f a
px; pure (k (a -> a)
pf' k (a -> a) -> k a -> Combinator k a
forall (k :: Type -> Type) a b. k (a -> b) -> k a -> Combinator k b
:<*>: k a
px')
traverseCombinator forall a. f a -> m (k a)
expose (f a
p :*>: f a
q)           = do k a
p' <- f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p; k a
q' <- f a -> m (k a)
forall a. f a -> m (k a)
expose f a
q; pure (k a
p' k a -> k a -> Combinator k a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k b
:*>: k a
q')
traverseCombinator forall a. f a -> m (k a)
expose (f a
p :<*: f b
q)           = do k a
p' <- f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p; k b
q' <- f b -> m (k b)
forall a. f a -> m (k a)
expose f b
q; pure (k a
p' k a -> k b -> Combinator k a
forall (k :: Type -> Type) a b. k a -> k b -> Combinator k a
:<*: k b
q')
traverseCombinator forall a. f a -> m (k a)
expose (f a
p :<|>: f a
q)          = do k a
p' <- f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p; k a
q' <- f a -> m (k a)
forall a. f a -> m (k a)
expose f a
q; pure (k a
p' k a -> k a -> Combinator k a
forall (k :: Type -> Type) a. k a -> k a -> Combinator k a
:<|>: k a
q')
traverseCombinator forall a. f a -> m (k a)
_      Combinator f a
Empty                = do 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)              = do k a
p' <- f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p; pure (k a -> Combinator k a
forall (k :: Type -> Type) a. k a -> Combinator k a
Try k a
p')
traverseCombinator forall a. f a -> m (k a)
expose (LookAhead f a
p)        = do k a
p' <- f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p; pure (k a -> Combinator k a
forall (k :: Type -> Type) a. k a -> Combinator k a
LookAhead k a
p')
traverseCombinator forall a. f a -> m (k a)
expose (NotFollowedBy f a
p)    = do k a
p' <- f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p; pure (k a -> Combinator k ()
forall (k :: Type -> Type) a. k a -> Combinator k ()
NotFollowedBy k 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)       = do k (Either a b)
b' <- f (Either a b) -> m (k (Either a b))
forall a. f a -> m (k a)
expose f (Either a b)
b; k (a -> a)
p' <- f (a -> a) -> m (k (a -> a))
forall a. f a -> m (k a)
expose f (a -> a)
p; k (b -> a)
q' <- f (b -> a) -> m (k (b -> a))
forall a. f a -> m (k a)
expose f (b -> a)
q; pure (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)
b' k (a -> a)
p' k (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)    = do k a
p' <- f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p; [k a]
qs' <- (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; k a
d' <- f a -> m (k a)
forall a. f a -> m (k a)
expose f a
d; pure (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
p' [Defunc (a -> Bool)]
fs [k a]
qs' k a
d')
traverseCombinator forall a. f a -> m (k a)
expose (ChainPre f (a -> a)
op f a
p)      = do k (a -> a)
op' <- f (a -> a) -> m (k (a -> a))
forall a. f a -> m (k a)
expose f (a -> a)
op; k a
p' <- f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p; pure (k (a -> a) -> k a -> Combinator k a
forall (k :: Type -> Type) a. k (a -> a) -> k a -> Combinator k a
ChainPre k (a -> a)
op' k a
p')
traverseCombinator forall a. f a -> m (k a)
expose (ChainPost f a
p f (a -> a)
op)     = do k a
p' <- f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p; k (a -> a)
op' <- f (a -> a) -> m (k (a -> a))
forall a. f a -> m (k a)
expose f (a -> a)
op; pure (k a -> k (a -> a) -> Combinator k a
forall (k :: Type -> Type) a. k a -> k (a -> a) -> Combinator k a
ChainPost k a
p' k (a -> a)
op')
traverseCombinator forall a. f a -> m (k a)
expose (MakeRegister ΣVar a
σ f a
p f a
q) = do k a
p' <- f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p; k a
q' <- f a -> m (k a)
forall a. f a -> m (k a)
expose f a
q; pure (Σ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
p' k a
q')
traverseCombinator forall a. f a -> m (k a)
_      (GetRegister ΣVar a
σ)      = do 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)    = do k a
p' <- f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p; pure (ΣVar a -> k a -> Combinator k ()
forall a (k :: Type -> Type). ΣVar a -> k a -> Combinator k ()
PutRegister ΣVar a
σ k a
p')
traverseCombinator forall a. f a -> m (k a)
expose (Debug String
name f a
p)       = do k a
p' <- f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p; pure (String -> k a -> Combinator k a
forall (k :: Type -> Type) a. String -> k a -> Combinator k a
Debug String
name k a
p')
traverseCombinator forall a. f a -> m (k a)
_      (Pure Defunc a
x)             = do 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 Defunc (Char -> Bool)
f)          = do Combinator k Char -> m (Combinator k Char)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Defunc (Char -> Bool) -> Combinator k Char
forall (k :: Type -> Type).
Defunc (Char -> Bool) -> Combinator k Char
Satisfy Defunc (Char -> Bool)
f)
traverseCombinator forall a. f a -> m (k a)
expose (Let Bool
r MVar a
v f a
p)          = do k a
p' <- f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p; pure (Bool -> MVar a -> k a -> Combinator k a
forall a (k :: Type -> Type).
Bool -> MVar a -> k a -> Combinator k a
Let Bool
r MVar a
v k a
p')
traverseCombinator forall a. f a -> m (k a)
expose (MetaCombinator MetaCombinator
m f a
p) = do k a
p' <- f a -> m (k a)
forall a. f a -> m (k a)
expose f a
p; pure (MetaCombinator -> k a -> Combinator k a
forall (k :: Type -> Type) a.
MetaCombinator -> k a -> Combinator k a
MetaCombinator MetaCombinator
m k a
p')