{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE DeriveTraversable #-}
module Predicate.Data.Lifted (
FMap
, type (<$>)
, type (<&>)
, type (<*>)
, LiftA2
, FPair
, type (<:>)
, type (<$)
, type (<*)
, type (*>)
, FFish
, type (>>=)
, Sequence
, Traverse
, Join
, type (<|>)
, type BiMap
, Extract
, Duplicate
, type ($$)
, type ($&)
, Skip
, type (|>)
, type (>|)
, type (>|>)
, Flip
, Dot
, RDot
, K
, Lift
, Catch
, Catch'
, ELR(..)
) where
import Predicate.Core
import Predicate.Misc
import Predicate.Util
import qualified GHC.TypeLits as GL
import Control.Applicative
import Control.Monad (join)
import Data.Kind (Type)
import Control.Comonad (Comonad(duplicate, extract))
import Control.Lens
import Data.Tree (Tree)
import Data.Proxy (Proxy(..))
import Data.Bitraversable
import Data.Bifoldable
data p <$ q deriving Int -> (p <$ q) -> ShowS
[p <$ q] -> ShowS
(p <$ q) -> String
(Int -> (p <$ q) -> ShowS)
-> ((p <$ q) -> String) -> ([p <$ q] -> ShowS) -> Show (p <$ q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p <$ q) -> ShowS
forall k (p :: k) k (q :: k). [p <$ q] -> ShowS
forall k (p :: k) k (q :: k). (p <$ q) -> String
showList :: [p <$ q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p <$ q] -> ShowS
show :: (p <$ q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p <$ q) -> String
showsPrec :: Int -> (p <$ q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p <$ q) -> ShowS
Show
infixl 4 <$
instance ( P p x
, P q x
, Show (PP p x)
, Functor t
, PP q x ~ t c
, ApplyConstT (PP q x) (PP p x) ~ t (PP p x)
) => P (p <$ q) x where
type PP (p <$ q) x = ApplyConstT (PP q x) (PP p x)
eval :: proxy (p <$ q) -> POpts -> x -> m (TT (PP (p <$ q) x))
eval proxy (p <$ q)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"(<$)"
Either (TT (t (PP p x))) (PP p x, t c, TT (PP p x), TT (t c))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either
(TT (t (PP p x))) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
(proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x []
TT (t (PP p x)) -> m (TT (t (PP p x)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (t (PP p x)) -> m (TT (t (PP p x))))
-> TT (t (PP p x)) -> m (TT (t (PP p x)))
forall a b. (a -> b) -> a -> b
$ case Either (TT (t (PP p x))) (PP p x, t c, TT (PP p x), TT (t c))
lr of
Left TT (t (PP p x))
e -> TT (t (PP p x))
e
Right (PP p x
p,t c
q,TT (PP p x)
pp,TT (t c)
qq) ->
let d :: t (PP p x)
d = PP p x
p PP p x -> t c -> t (PP p x)
forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ t c
q
in POpts -> Val (t (PP p x)) -> String -> [Tree PE] -> TT (t (PP p x))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (t (PP p x) -> Val (t (PP p x))
forall a. a -> Val a
Val t (PP p x)
d) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP p x -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp, TT (t c) -> Tree PE
forall a. TT a -> Tree PE
hh TT (t c)
qq]
data p <* q deriving Int -> (p <* q) -> ShowS
[p <* q] -> ShowS
(p <* q) -> String
(Int -> (p <* q) -> ShowS)
-> ((p <* q) -> String) -> ([p <* q] -> ShowS) -> Show (p <* q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p <* q) -> ShowS
forall k (p :: k) k (q :: k). [p <* q] -> ShowS
forall k (p :: k) k (q :: k). (p <* q) -> String
showList :: [p <* q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p <* q] -> ShowS
show :: (p <* q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p <* q) -> String
showsPrec :: Int -> (p <* q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p <* q) -> ShowS
Show
infixl 4 <*
instance ( P p x
, P q x
, Show (t b)
, Show (t c)
, Applicative t
, PP p x ~ t b
, PP q x ~ t c
) => P (p <* q) x where
type PP (p <* q) x = PP p x
eval :: proxy (p <* q) -> POpts -> x -> m (TT (PP (p <* q) x))
eval proxy (p <* q)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"(<*)"
Either (TT (t b)) (t b, t c, TT (t b), TT (t c))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT (t b)) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
(proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x []
TT (t b) -> m (TT (t b))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (t b) -> m (TT (t b))) -> TT (t b) -> m (TT (t b))
forall a b. (a -> b) -> a -> b
$ case Either (TT (t b)) (t b, t c, TT (t b), TT (t c))
lr of
Left TT (t b)
e -> TT (t b)
e
Right (t b
p,t c
q,TT (t b)
pp,TT (t c)
qq) ->
let d :: t b
d = t b
p t b -> t c -> t b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* t c
q
in POpts -> Val (t b) -> String -> [Tree PE] -> TT (t b)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (t b -> Val (t b)
forall a. a -> Val a
Val t b
d) (POpts -> String -> t b -> String -> t b -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 t b
p String
"p=" t b
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> t c -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | q=" t c
q) [TT (t b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (t b)
pp, TT (t c) -> Tree PE
forall a. TT a -> Tree PE
hh TT (t c)
qq]
data p *> q deriving Int -> (p *> q) -> ShowS
[p *> q] -> ShowS
(p *> q) -> String
(Int -> (p *> q) -> ShowS)
-> ((p *> q) -> String) -> ([p *> q] -> ShowS) -> Show (p *> q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p *> q) -> ShowS
forall k (p :: k) k (q :: k). [p *> q] -> ShowS
forall k (p :: k) k (q :: k). (p *> q) -> String
showList :: [p *> q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p *> q] -> ShowS
show :: (p *> q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p *> q) -> String
showsPrec :: Int -> (p *> q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p *> q) -> ShowS
Show
infixl 4 *>
instance ( P p x
, P q x
, Show (t b)
, Show (t c)
, Applicative t
, PP p x ~ t b
, PP q x ~ t c
) => P (p *> q) x where
type PP (p *> q) x = PP q x
eval :: proxy (p *> q) -> POpts -> x -> m (TT (PP (p *> q) x))
eval proxy (p *> q)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"(*>)"
Either (TT (t c)) (t b, t c, TT (t b), TT (t c))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT (t c)) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
(proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x []
TT (t c) -> m (TT (t c))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (t c) -> m (TT (t c))) -> TT (t c) -> m (TT (t c))
forall a b. (a -> b) -> a -> b
$ case Either (TT (t c)) (t b, t c, TT (t b), TT (t c))
lr of
Left TT (t c)
e -> TT (t c)
e
Right (t b
p,t c
q,TT (t b)
pp,TT (t c)
qq) ->
let d :: t c
d = t b
p t b -> t c -> t c
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> t c
q
in POpts -> Val (t c) -> String -> [Tree PE] -> TT (t c)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (t c -> Val (t c)
forall a. a -> Val a
Val t c
d) (POpts -> String -> t b -> String -> t b -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 t b
p String
"p=" t b
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> t c -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | q=" t c
q) [TT (t b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (t b)
pp, TT (t c) -> Tree PE
forall a. TT a -> Tree PE
hh TT (t c)
qq]
data p <|> q deriving Int -> (p <|> q) -> ShowS
[p <|> q] -> ShowS
(p <|> q) -> String
(Int -> (p <|> q) -> ShowS)
-> ((p <|> q) -> String) -> ([p <|> q] -> ShowS) -> Show (p <|> q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p <|> q) -> ShowS
forall k (p :: k) k (q :: k). [p <|> q] -> ShowS
forall k (p :: k) k (q :: k). (p <|> q) -> String
showList :: [p <|> q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p <|> q] -> ShowS
show :: (p <|> q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p <|> q) -> String
showsPrec :: Int -> (p <|> q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p <|> q) -> ShowS
Show
infixl 3 <|>
instance ( P p x
, P q x
, Show (t b)
, Alternative t
, t b ~ PP p x
, PP q x ~ t b
) => P (p <|> q) x where
type PP (p <|> q) x = PP p x
eval :: proxy (p <|> q) -> POpts -> x -> m (TT (PP (p <|> q) x))
eval proxy (p <|> q)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"(<|>)"
Either (TT (t b)) (t b, t b, TT (t b), TT (t b))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT (t b)) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
(proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x []
TT (t b) -> m (TT (t b))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (t b) -> m (TT (t b))) -> TT (t b) -> m (TT (t b))
forall a b. (a -> b) -> a -> b
$ case Either (TT (t b)) (t b, t b, TT (t b), TT (t b))
lr of
Left TT (t b)
e -> TT (t b)
e
Right (t b
p,t b
q,TT (t b)
pp,TT (t b)
qq) ->
let d :: t b
d = t b
p t b -> t b -> t b
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> t b
q
in POpts -> Val (t b) -> String -> [Tree PE] -> TT (t b)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (t b -> Val (t b)
forall a. a -> Val a
Val t b
d) (POpts -> String -> t b -> String -> t b -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 t b
d String
"p=" t b
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> t b -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | q=" t b
q) [TT (t b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (t b)
pp, TT (t b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (t b)
qq]
data deriving Int -> Extract -> ShowS
[Extract] -> ShowS
Extract -> String
(Int -> Extract -> ShowS)
-> (Extract -> String) -> ([Extract] -> ShowS) -> Show Extract
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Extract] -> ShowS
$cshowList :: [Extract] -> ShowS
show :: Extract -> String
$cshow :: Extract -> String
showsPrec :: Int -> Extract -> ShowS
$cshowsPrec :: Int -> Extract -> ShowS
Show
instance ( Show (t a)
, Show a
, Comonad t
) => P Extract (t a) where
type PP Extract (t a) = a
eval :: proxy Extract -> POpts -> t a -> m (TT (PP Extract (t a)))
eval proxy Extract
_ POpts
opts t a
ta =
let msg0 :: String
msg0 = String
"Extract"
d :: a
d = t a -> a
forall (w :: Type -> Type) a. Comonad w => w a -> a
extract t a
ta
in TT a -> m (TT a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT a -> m (TT a)) -> TT a -> m (TT a)
forall a b. (a -> b) -> a -> b
$ POpts -> Val a -> String -> [Tree PE] -> TT a
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (a -> Val a
forall a. a -> Val a
Val a
d) (POpts -> String -> a -> t a -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 a
d t a
ta) []
data Duplicate deriving Int -> Duplicate -> ShowS
[Duplicate] -> ShowS
Duplicate -> String
(Int -> Duplicate -> ShowS)
-> (Duplicate -> String)
-> ([Duplicate] -> ShowS)
-> Show Duplicate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Duplicate] -> ShowS
$cshowList :: [Duplicate] -> ShowS
show :: Duplicate -> String
$cshow :: Duplicate -> String
showsPrec :: Int -> Duplicate -> ShowS
$cshowsPrec :: Int -> Duplicate -> ShowS
Show
instance ( Show (t a)
, Show (t (t a))
, Comonad t
) => P Duplicate (t a) where
type PP Duplicate (t a) = t (t a)
eval :: proxy Duplicate -> POpts -> t a -> m (TT (PP Duplicate (t a)))
eval proxy Duplicate
_ POpts
opts t a
ta =
let msg0 :: String
msg0 = String
"Duplicate"
d :: t (t a)
d = t a -> t (t a)
forall (w :: Type -> Type) a. Comonad w => w a -> w (w a)
duplicate t a
ta
in TT (t (t a)) -> m (TT (t (t a)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (t (t a)) -> m (TT (t (t a))))
-> TT (t (t a)) -> m (TT (t (t a)))
forall a b. (a -> b) -> a -> b
$ POpts -> Val (t (t a)) -> String -> [Tree PE] -> TT (t (t a))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (t (t a) -> Val (t (t a))
forall a. a -> Val a
Val t (t a)
d) (POpts -> String -> t (t a) -> t a -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 t (t a)
d t a
ta) []
data Join deriving Int -> Join -> ShowS
[Join] -> ShowS
Join -> String
(Int -> Join -> ShowS)
-> (Join -> String) -> ([Join] -> ShowS) -> Show Join
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Join] -> ShowS
$cshowList :: [Join] -> ShowS
show :: Join -> String
$cshow :: Join -> String
showsPrec :: Int -> Join -> ShowS
$cshowsPrec :: Int -> Join -> ShowS
Show
instance ( Show (t (t a))
, Show (t a)
, Monad t
) => P Join (t (t a)) where
type PP Join (t (t a)) = t a
eval :: proxy Join -> POpts -> t (t a) -> m (TT (PP Join (t (t a))))
eval proxy Join
_ POpts
opts t (t a)
tta =
let msg0 :: String
msg0 = String
"Join"
d :: t a
d = t (t a) -> t a
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join t (t a)
tta
in TT (t a) -> m (TT (t a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (t a) -> m (TT (t a))) -> TT (t a) -> m (TT (t a))
forall a b. (a -> b) -> a -> b
$ POpts -> Val (t a) -> String -> [Tree PE] -> TT (t a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (t a -> Val (t a)
forall a. a -> Val a
Val t a
d) (POpts -> String -> t a -> t (t a) -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 t a
d t (t a)
tta) []
data p $$ q deriving Int -> (p $$ q) -> ShowS
[p $$ q] -> ShowS
(p $$ q) -> String
(Int -> (p $$ q) -> ShowS)
-> ((p $$ q) -> String) -> ([p $$ q] -> ShowS) -> Show (p $$ q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p $$ q) -> ShowS
forall k (p :: k) k (q :: k). [p $$ q] -> ShowS
forall k (p :: k) k (q :: k). (p $$ q) -> String
showList :: [p $$ q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p $$ q] -> ShowS
show :: (p $$ q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p $$ q) -> String
showsPrec :: Int -> (p $$ q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p $$ q) -> ShowS
Show
infixl 0 $$
instance ( P p x
, P q x
, PP p x ~ (a -> b)
, FnT (PP p x) ~ b
, PP q x ~ a
, Show a
, Show b
) => P (p $$ q) x where
type PP (p $$ q) x = FnT (PP p x)
eval :: proxy (p $$ q) -> POpts -> x -> m (TT (PP (p $$ q) x))
eval proxy (p $$ q)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"($$)"
Either (TT b) (a -> b, a, TT (a -> b), TT a)
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT b) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
(proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x []
TT b -> m (TT b)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT b -> m (TT b)) -> TT b -> m (TT b)
forall a b. (a -> b) -> a -> b
$ case Either (TT b) (a -> b, a, TT (a -> b), TT a)
lr of
Left TT b
e -> TT b
e
Right (a -> b
p,a
q,TT (a -> b)
pp,TT a
qq) ->
let d :: b
d = a -> b
p a
q
in POpts -> Val b -> String -> [Tree PE] -> TT b
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (b -> Val b
forall a. a -> Val a
Val b
d) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> b -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts b
d) [TT (a -> b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (a -> b)
pp, TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
qq]
data q $& p deriving Int -> (q $& p) -> ShowS
[q $& p] -> ShowS
(q $& p) -> String
(Int -> (q $& p) -> ShowS)
-> ((q $& p) -> String) -> ([q $& p] -> ShowS) -> Show (q $& p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (q :: k) k (p :: k). Int -> (q $& p) -> ShowS
forall k (q :: k) k (p :: k). [q $& p] -> ShowS
forall k (q :: k) k (p :: k). (q $& p) -> String
showList :: [q $& p] -> ShowS
$cshowList :: forall k (q :: k) k (p :: k). [q $& p] -> ShowS
show :: (q $& p) -> String
$cshow :: forall k (q :: k) k (p :: k). (q $& p) -> String
showsPrec :: Int -> (q $& p) -> ShowS
$cshowsPrec :: forall k (q :: k) k (p :: k). Int -> (q $& p) -> ShowS
Show
infixr 1 $&
instance ( P p x
, P q x
, PP p x ~ (a -> b)
, FnT (PP p x) ~ b
, PP q x ~ a
, Show a
, Show b
) => P (q $& p) x where
type PP (q $& p) x = FnT (PP p x)
eval :: proxy (q $& p) -> POpts -> x -> m (TT (PP (q $& p) x))
eval proxy (q $& p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"($&)"
Either (TT b) (a -> b, a, TT (a -> b), TT a)
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT b) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
(proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x []
TT b -> m (TT b)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT b -> m (TT b)) -> TT b -> m (TT b)
forall a b. (a -> b) -> a -> b
$ case Either (TT b) (a -> b, a, TT (a -> b), TT a)
lr of
Left TT b
e -> TT b
e
Right (a -> b
p,a
q,TT (a -> b)
pp,TT a
qq) ->
let d :: b
d = a -> b
p a
q
in POpts -> Val b -> String -> [Tree PE] -> TT b
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (b -> Val b
forall a. a -> Val a
Val b
d) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> b -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts b
d) [TT (a -> b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (a -> b)
pp, TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
qq]
data Sequence deriving Int -> Sequence -> ShowS
[Sequence] -> ShowS
Sequence -> String
(Int -> Sequence -> ShowS)
-> (Sequence -> String) -> ([Sequence] -> ShowS) -> Show Sequence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sequence] -> ShowS
$cshowList :: [Sequence] -> ShowS
show :: Sequence -> String
$cshow :: Sequence -> String
showsPrec :: Int -> Sequence -> ShowS
$cshowsPrec :: Int -> Sequence -> ShowS
Show
instance ( Show (f (t a))
, Show (t (f a))
, Traversable t
, Applicative f
) => P Sequence (t (f a)) where
type PP Sequence (t (f a)) = f (t a)
eval :: proxy Sequence
-> POpts -> t (f a) -> m (TT (PP Sequence (t (f a))))
eval proxy Sequence
_ POpts
opts t (f a)
tfa =
let msg :: String
msg = String
"Sequence"
d :: f (t a)
d = t (f a) -> f (t a)
forall (t :: Type -> Type) (f :: Type -> Type) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA t (f a)
tfa
in TT (f (t a)) -> m (TT (f (t a)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (f (t a)) -> m (TT (f (t a))))
-> TT (f (t a)) -> m (TT (f (t a)))
forall a b. (a -> b) -> a -> b
$ POpts -> Val (f (t a)) -> String -> [Tree PE] -> TT (f (t a))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (f (t a) -> Val (f (t a))
forall a. a -> Val a
Val f (t a)
d) (String
msg String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> f (t a) -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts f (t a)
d String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> t (f a) -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " t (f a)
tfa) []
data Traverse p deriving Int -> Traverse p -> ShowS
[Traverse p] -> ShowS
Traverse p -> String
(Int -> Traverse p -> ShowS)
-> (Traverse p -> String)
-> ([Traverse p] -> ShowS)
-> Show (Traverse p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> Traverse p -> ShowS
forall k (p :: k). [Traverse p] -> ShowS
forall k (p :: k). Traverse p -> String
showList :: [Traverse p] -> ShowS
$cshowList :: forall k (p :: k). [Traverse p] -> ShowS
show :: Traverse p -> String
$cshow :: forall k (p :: k). Traverse p -> String
showsPrec :: Int -> Traverse p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> Traverse p -> ShowS
Show
type TraverseT p = FMap p >> Sequence
instance P (TraverseT p) x => P (Traverse p) x where
type PP (Traverse p) x = PP (TraverseT p) x
eval :: proxy (Traverse p) -> POpts -> x -> m (TT (PP (Traverse p) x))
eval proxy (Traverse p)
_ = Proxy (TraverseT p) -> POpts -> x -> m (TT (PP (TraverseT p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (TraverseT p)
forall k (t :: k). Proxy t
Proxy @(TraverseT p))
data Skip p deriving Int -> Skip p -> ShowS
[Skip p] -> ShowS
Skip p -> String
(Int -> Skip p -> ShowS)
-> (Skip p -> String) -> ([Skip p] -> ShowS) -> Show (Skip p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> Skip p -> ShowS
forall k (p :: k). [Skip p] -> ShowS
forall k (p :: k). Skip p -> String
showList :: [Skip p] -> ShowS
$cshowList :: forall k (p :: k). [Skip p] -> ShowS
show :: Skip p -> String
$cshow :: forall k (p :: k). Skip p -> String
showsPrec :: Int -> Skip p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> Skip p -> ShowS
Show
instance ( Show (PP p a)
, P p a
) => P (Skip p) a where
type PP (Skip p) a = a
eval :: proxy (Skip p) -> POpts -> a -> m (TT (PP (Skip p) a))
eval proxy (Skip p)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"Skip"
TT (PP p a)
pp <- Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
a
TT a -> m (TT a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT a -> m (TT a)) -> TT a -> m (TT a)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p a)
-> [Tree PE]
-> Either (TT a) (PP p a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP p a)
pp [] of
Left TT a
e -> TT a
e
Right PP p a
p -> POpts -> Val a -> String -> [Tree PE] -> TT a
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (a -> Val a
forall a. a -> Val a
Val a
a) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP p a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP p a
p) [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp]
data p |> q deriving Int -> (p |> q) -> ShowS
[p |> q] -> ShowS
(p |> q) -> String
(Int -> (p |> q) -> ShowS)
-> ((p |> q) -> String) -> ([p |> q] -> ShowS) -> Show (p |> q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p |> q) -> ShowS
forall k (p :: k) k (q :: k). [p |> q] -> ShowS
forall k (p :: k) k (q :: k). (p |> q) -> String
showList :: [p |> q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p |> q] -> ShowS
show :: (p |> q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p |> q) -> String
showsPrec :: Int -> (p |> q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p |> q) -> ShowS
Show
type SkipLT p q = Skip p >> q
infixr 1 |>
instance P (SkipLT p q) x => P (p |> q) x where
type PP (p |> q) x = PP (SkipLT p q) x
eval :: proxy (p |> q) -> POpts -> x -> m (TT (PP (p |> q) x))
eval proxy (p |> q)
_ = Proxy (SkipLT p q) -> POpts -> x -> m (TT (PP (SkipLT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (SkipLT p q)
forall k (t :: k). Proxy t
Proxy @(SkipLT p q))
data p >| q deriving Int -> (p >| q) -> ShowS
[p >| q] -> ShowS
(p >| q) -> String
(Int -> (p >| q) -> ShowS)
-> ((p >| q) -> String) -> ([p >| q] -> ShowS) -> Show (p >| q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p >| q) -> ShowS
forall k (p :: k) k (q :: k). [p >| q] -> ShowS
forall k (p :: k) k (q :: k). (p >| q) -> String
showList :: [p >| q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p >| q] -> ShowS
show :: (p >| q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p >| q) -> String
showsPrec :: Int -> (p >| q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p >| q) -> ShowS
Show
type SkipRT p q = p >> Skip q
infixr 1 >|
instance P (SkipRT p q) x => P (p >| q) x where
type PP (p >| q) x = PP (SkipRT p q) x
eval :: proxy (p >| q) -> POpts -> x -> m (TT (PP (p >| q) x))
eval proxy (p >| q)
_ = Proxy (SkipRT p q) -> POpts -> x -> m (TT (PP (SkipRT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (SkipRT p q)
forall k (t :: k). Proxy t
Proxy @(SkipRT p q))
data p >|> q deriving Int -> (p >|> q) -> ShowS
[p >|> q] -> ShowS
(p >|> q) -> String
(Int -> (p >|> q) -> ShowS)
-> ((p >|> q) -> String) -> ([p >|> q] -> ShowS) -> Show (p >|> q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p >|> q) -> ShowS
forall k (p :: k) k (q :: k). [p >|> q] -> ShowS
forall k (p :: k) k (q :: k). (p >|> q) -> String
showList :: [p >|> q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p >|> q] -> ShowS
show :: (p >|> q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p >|> q) -> String
showsPrec :: Int -> (p >|> q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p >|> q) -> ShowS
Show
type SkipBothT p q = Skip p >> Skip q
infixr 1 >|>
instance P (SkipBothT p q) x => P (p >|> q) x where
type PP (p >|> q) x = PP (SkipBothT p q) x
eval :: proxy (p >|> q) -> POpts -> x -> m (TT (PP (p >|> q) x))
eval proxy (p >|> q)
_ = Proxy (SkipBothT p q)
-> POpts -> x -> m (TT (PP (SkipBothT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (SkipBothT p q)
forall k (t :: k). Proxy t
Proxy @(SkipBothT p q))
data Catch p q deriving Int -> Catch p q -> ShowS
[Catch p q] -> ShowS
Catch p q -> String
(Int -> Catch p q -> ShowS)
-> (Catch p q -> String)
-> ([Catch p q] -> ShowS)
-> Show (Catch p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Catch p q -> ShowS
forall k (p :: k) k (q :: k). [Catch p q] -> ShowS
forall k (p :: k) k (q :: k). Catch p q -> String
showList :: [Catch p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Catch p q] -> ShowS
show :: Catch p q -> String
$cshow :: forall k (p :: k) k (q :: k). Catch p q -> String
showsPrec :: Int -> Catch p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Catch p q -> ShowS
Show
data Catch' p s deriving Int -> Catch' p s -> ShowS
[Catch' p s] -> ShowS
Catch' p s -> String
(Int -> Catch' p s -> ShowS)
-> (Catch' p s -> String)
-> ([Catch' p s] -> ShowS)
-> Show (Catch' p s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (s :: k). Int -> Catch' p s -> ShowS
forall k (p :: k) k (s :: k). [Catch' p s] -> ShowS
forall k (p :: k) k (s :: k). Catch' p s -> String
showList :: [Catch' p s] -> ShowS
$cshowList :: forall k (p :: k) k (s :: k). [Catch' p s] -> ShowS
show :: Catch' p s -> String
$cshow :: forall k (p :: k) k (s :: k). Catch' p s -> String
showsPrec :: Int -> Catch' p s -> ShowS
$cshowsPrec :: forall k (p :: k) k (s :: k). Int -> Catch' p s -> ShowS
Show
type CatchT' p s = Catch p (FailCatchT s)
type FailCatchT s = Fail (Snd >> UnproxyT) (Fst >> s)
instance P (CatchT' p s) x => P (Catch' p s) x where
type PP (Catch' p s) x = PP (CatchT' p s) x
eval :: proxy (Catch' p s) -> POpts -> x -> m (TT (PP (Catch' p s) x))
eval proxy (Catch' p s)
_ = Proxy (CatchT' p s) -> POpts -> x -> m (TT (PP (CatchT' p s) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (CatchT' p s)
forall k (t :: k). Proxy t
Proxy @(CatchT' p s))
instance ( P p x
, P q ((String, x)
, Proxy (PP p x))
, PP p x ~ PP q ((String, x), Proxy (PP p x))
) => P (Catch p q) x where
type PP (Catch p q) x = PP p x
eval :: proxy (Catch p q) -> POpts -> x -> m (TT (PP (Catch p q) x))
eval proxy (Catch p q)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Catch"
TT (PP q ((String, x), Proxy (PP p x)))
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
case Inline
-> POpts
-> String
-> TT (PP q ((String, x), Proxy (PP p x)))
-> [Tree PE]
-> Either (TT Any) (PP q ((String, x), Proxy (PP p x)))
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP q ((String, x), Proxy (PP p x)))
pp [] of
Left TT Any
p -> do
let emsg :: String
emsg = TT Any
p TT Any -> Getting String (TT Any) String -> String
forall s a. s -> Getting a s a -> a
^. (Val Any -> Const String (Val Any))
-> TT Any -> Const String (TT Any)
forall a b. Lens (TT a) (TT b) (Val a) (Val b)
ttVal ((Val Any -> Const String (Val Any))
-> TT Any -> Const String (TT Any))
-> ((String -> Const String String)
-> Val Any -> Const String (Val Any))
-> Getting String (TT Any) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversing (->) (Const String) (Val Any) (Val Any) String String
-> (String -> Const String String)
-> Val Any
-> Const String (Val Any)
forall (p :: Type -> Type -> Type) (f :: Type -> Type) s t a.
(HasCallStack, Conjoined p, Functor f) =>
Traversing p f s t a a -> Over p f s t a a
singular Traversing (->) (Const String) (Val Any) (Val Any) String String
forall a. Prism' (Val a) String
_Fail
TT (PP q ((String, x), Proxy (PP p x)))
qq <- Proxy q
-> POpts
-> ((String, x), Proxy (PP q ((String, x), Proxy (PP p x))))
-> m (TT
(PP q ((String, x), Proxy (PP q ((String, x), Proxy (PP p x))))))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts ((String
emsg, x
x), Proxy (PP p x)
forall k (t :: k). Proxy t
Proxy @(PP p x))
TT (PP q ((String, x), Proxy (PP p x)))
-> m (TT (PP q ((String, x), Proxy (PP p x))))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q ((String, x), Proxy (PP p x)))
-> m (TT (PP q ((String, x), Proxy (PP p x)))))
-> TT (PP q ((String, x), Proxy (PP p x)))
-> m (TT (PP q ((String, x), Proxy (PP p x))))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP q ((String, x), Proxy (PP p x)))
-> [Tree PE]
-> Either
(TT (PP q ((String, x), Proxy (PP p x))))
(PP q ((String, x), Proxy (PP p x)))
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" default condition failed") TT (PP q ((String, x), Proxy (PP p x)))
qq [TT (PP q ((String, x), Proxy (PP p x))) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q ((String, x), Proxy (PP p x)))
pp] of
Left TT (PP q ((String, x), Proxy (PP p x)))
e1 -> TT (PP q ((String, x), Proxy (PP p x)))
e1
Right PP q ((String, x), Proxy (PP p x))
_ -> POpts
-> TT (PP q ((String, x), Proxy (PP p x)))
-> String
-> [Tree PE]
-> TT (PP q ((String, x), Proxy (PP p x)))
forall a. POpts -> TT a -> String -> [Tree PE] -> TT a
mkNodeCopy POpts
opts TT (PP q ((String, x), Proxy (PP p x)))
qq (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" caught exception[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
emsg String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]") [TT (PP q ((String, x), Proxy (PP p x))) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q ((String, x), Proxy (PP p x)))
pp, TT (PP q ((String, x), Proxy (PP p x))) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q ((String, x), Proxy (PP p x)))
qq]
Right PP q ((String, x), Proxy (PP p x))
_ -> TT (PP q ((String, x), Proxy (PP p x)))
-> m (TT (PP q ((String, x), Proxy (PP p x))))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q ((String, x), Proxy (PP p x)))
-> m (TT (PP q ((String, x), Proxy (PP p x)))))
-> TT (PP q ((String, x), Proxy (PP p x)))
-> m (TT (PP q ((String, x), Proxy (PP p x))))
forall a b. (a -> b) -> a -> b
$ POpts
-> TT (PP q ((String, x), Proxy (PP p x)))
-> String
-> [Tree PE]
-> TT (PP q ((String, x), Proxy (PP p x)))
forall a. POpts -> TT a -> String -> [Tree PE] -> TT a
mkNodeCopy POpts
opts TT (PP q ((String, x), Proxy (PP p x)))
pp (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" did not fire") [TT (PP q ((String, x), Proxy (PP p x))) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q ((String, x), Proxy (PP p x)))
pp]
data Dot (ps :: [Type -> Type]) (q :: Type) deriving Int -> Dot ps q -> ShowS
[Dot ps q] -> ShowS
Dot ps q -> String
(Int -> Dot ps q -> ShowS)
-> (Dot ps q -> String) -> ([Dot ps q] -> ShowS) -> Show (Dot ps q)
forall (ps :: [Type -> Type]) q. Int -> Dot ps q -> ShowS
forall (ps :: [Type -> Type]) q. [Dot ps q] -> ShowS
forall (ps :: [Type -> Type]) q. Dot ps q -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dot ps q] -> ShowS
$cshowList :: forall (ps :: [Type -> Type]) q. [Dot ps q] -> ShowS
show :: Dot ps q -> String
$cshow :: forall (ps :: [Type -> Type]) q. Dot ps q -> String
showsPrec :: Int -> Dot ps q -> ShowS
$cshowsPrec :: forall (ps :: [Type -> Type]) q. Int -> Dot ps q -> ShowS
Show
instance (P (DotExpandT ps q) a) => P (Dot ps q) a where
type PP (Dot ps q) a = PP (DotExpandT ps q) a
eval :: proxy (Dot ps q) -> POpts -> a -> m (TT (PP (Dot ps q) a))
eval proxy (Dot ps q)
_ = Proxy (DotExpandT ps q)
-> POpts -> a -> m (TT (PP (DotExpandT ps q) a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (DotExpandT ps q)
forall k (t :: k). Proxy t
Proxy @(DotExpandT ps q))
type family DotExpandT (ps :: [Type -> Type]) (q :: Type) :: Type where
DotExpandT '[] _ = GL.TypeError ('GL.Text "'[] invalid: requires at least one predicate in the list")
DotExpandT '[p] q = p $ q
DotExpandT (p ': p1 ': ps) q = p $ DotExpandT (p1 ': ps) q
data RDot (ps :: [Type -> Type]) (q :: Type) deriving Int -> RDot ps q -> ShowS
[RDot ps q] -> ShowS
RDot ps q -> String
(Int -> RDot ps q -> ShowS)
-> (RDot ps q -> String)
-> ([RDot ps q] -> ShowS)
-> Show (RDot ps q)
forall (ps :: [Type -> Type]) q. Int -> RDot ps q -> ShowS
forall (ps :: [Type -> Type]) q. [RDot ps q] -> ShowS
forall (ps :: [Type -> Type]) q. RDot ps q -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RDot ps q] -> ShowS
$cshowList :: forall (ps :: [Type -> Type]) q. [RDot ps q] -> ShowS
show :: RDot ps q -> String
$cshow :: forall (ps :: [Type -> Type]) q. RDot ps q -> String
showsPrec :: Int -> RDot ps q -> ShowS
$cshowsPrec :: forall (ps :: [Type -> Type]) q. Int -> RDot ps q -> ShowS
Show
instance P (RDotExpandT ps q) a => P (RDot ps q) a where
type PP (RDot ps q) a = PP (RDotExpandT ps q) a
eval :: proxy (RDot ps q) -> POpts -> a -> m (TT (PP (RDot ps q) a))
eval proxy (RDot ps q)
_ = Proxy (RDotExpandT ps q)
-> POpts -> a -> m (TT (PP (RDotExpandT ps q) a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (RDotExpandT ps q)
forall k (t :: k). Proxy t
Proxy @(RDotExpandT ps q))
type family RDotExpandT (ps :: [Type -> Type]) (q :: Type) :: Type where
RDotExpandT '[] _ = GL.TypeError ('GL.Text "'[] invalid: requires at least one predicate in the list")
RDotExpandT '[p] q = p $ q
RDotExpandT (p ': p1 ': ps) q = RDotExpandT (p1 ': ps) (p $ q)
data K (p :: k) (q :: k1) deriving Int -> K p q -> ShowS
[K p q] -> ShowS
K p q -> String
(Int -> K p q -> ShowS)
-> (K p q -> String) -> ([K p q] -> ShowS) -> Show (K p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k1 (q :: k1). Int -> K p q -> ShowS
forall k (p :: k) k1 (q :: k1). [K p q] -> ShowS
forall k (p :: k) k1 (q :: k1). K p q -> String
showList :: [K p q] -> ShowS
$cshowList :: forall k (p :: k) k1 (q :: k1). [K p q] -> ShowS
show :: K p q -> String
$cshow :: forall k (p :: k) k1 (q :: k1). K p q -> String
showsPrec :: Int -> K p q -> ShowS
$cshowsPrec :: forall k (p :: k) k1 (q :: k1). Int -> K p q -> ShowS
Show
instance P p a => P (K p q) a where
type PP (K p q) a = PP p a
eval :: proxy (K p q) -> POpts -> a -> m (TT (PP (K p q) a))
eval proxy (K p q)
_ = Proxy (MsgI "K " p) -> POpts -> a -> m (TT (PP (MsgI "K " p) a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (MsgI "K " p)
forall k (t :: k). Proxy t
Proxy @(MsgI "K " p))
data Lift p q deriving Int -> Lift p q -> ShowS
[Lift p q] -> ShowS
Lift p q -> String
(Int -> Lift p q -> ShowS)
-> (Lift p q -> String) -> ([Lift p q] -> ShowS) -> Show (Lift p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Lift p q -> ShowS
forall k (p :: k) k (q :: k). [Lift p q] -> ShowS
forall k (p :: k) k (q :: k). Lift p q -> String
showList :: [Lift p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Lift p q] -> ShowS
show :: Lift p q -> String
$cshow :: forall k (p :: k) k (q :: k). Lift p q -> String
showsPrec :: Int -> Lift p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Lift p q -> ShowS
Show
type LiftT p q = q >> p
instance P (LiftT p q) x => P (Lift p q) x where
type PP (Lift p q) x = PP (LiftT p q) x
eval :: proxy (Lift p q) -> POpts -> x -> m (TT (PP (Lift p q) x))
eval proxy (Lift p q)
_ = Proxy (LiftT p q) -> POpts -> x -> m (TT (PP (LiftT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (LiftT p q)
forall k (t :: k). Proxy t
Proxy @(LiftT p q))
data FMap p deriving Int -> FMap p -> ShowS
[FMap p] -> ShowS
FMap p -> String
(Int -> FMap p -> ShowS)
-> (FMap p -> String) -> ([FMap p] -> ShowS) -> Show (FMap p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> FMap p -> ShowS
forall k (p :: k). [FMap p] -> ShowS
forall k (p :: k). FMap p -> String
showList :: [FMap p] -> ShowS
$cshowList :: forall k (p :: k). [FMap p] -> ShowS
show :: FMap p -> String
$cshow :: forall k (p :: k). FMap p -> String
showsPrec :: Int -> FMap p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> FMap p -> ShowS
Show
instance ( Traversable n
, P p a
) => P (FMap p) (n a) where
type PP (FMap p) (n a) = n (PP p a)
eval :: proxy (FMap p) -> POpts -> n a -> m (TT (PP (FMap p) (n a)))
eval proxy (FMap p)
_ POpts
opts n a
na = do
let msg0 :: String
msg0 = String
"FMap"
POpts
-> Proxy p -> String -> [Tree PE] -> n a -> m (TT (n (PP p a)))
forall k (m :: Type -> Type) (n :: Type -> Type) (p :: k) a.
(P p a, Traversable n, MonadEval m) =>
POpts
-> Proxy p -> String -> [Tree PE] -> n a -> m (TT (n (PP p a)))
_fmapImpl POpts
opts (Proxy p
forall k (t :: k). Proxy t
Proxy @p) String
msg0 [] n a
na
data p <$> q deriving Int -> (p <$> q) -> ShowS
[p <$> q] -> ShowS
(p <$> q) -> String
(Int -> (p <$> q) -> ShowS)
-> ((p <$> q) -> String) -> ([p <$> q] -> ShowS) -> Show (p <$> q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p <$> q) -> ShowS
forall k (p :: k) k (q :: k). [p <$> q] -> ShowS
forall k (p :: k) k (q :: k). (p <$> q) -> String
showList :: [p <$> q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p <$> q] -> ShowS
show :: (p <$> q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p <$> q) -> String
showsPrec :: Int -> (p <$> q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p <$> q) -> ShowS
Show
infixl 4 <$>
instance ( Traversable n
, P q a
, P p b
, PP q a ~ n b
, PP p b ~ c
) => P (p <$> q) a where
type PP (p <$> q) a = (ExtractTFromTA (PP q a)) (PP p (ExtractAFromTA (PP q a)))
eval :: proxy (p <$> q) -> POpts -> a -> m (TT (PP (p <$> q) a))
eval proxy (p <$> q)
_ POpts
opts a
x = do
let msg0 :: String
msg0 = String
"(<$>)"
TT (n b)
qq <- Proxy q -> POpts -> a -> m (TT (PP q a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
x
case Inline
-> POpts
-> String
-> TT (n b)
-> [Tree PE]
-> Either (TT (n c)) (n b)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (n b)
qq [] of
Left TT (n c)
e -> TT (n c) -> m (TT (n c))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (n c)
e
Right n b
q -> POpts
-> Proxy p -> String -> [Tree PE] -> n b -> m (TT (n (PP p b)))
forall k (m :: Type -> Type) (n :: Type -> Type) (p :: k) a.
(P p a, Traversable n, MonadEval m) =>
POpts
-> Proxy p -> String -> [Tree PE] -> n a -> m (TT (n (PP p a)))
_fmapImpl POpts
opts (Proxy p
forall k (t :: k). Proxy t
Proxy @p) String
msg0 [TT (n b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (n b)
qq] n b
q
_fmapImpl :: forall m n p a
. ( P p a
, Traversable n
, MonadEval m
) => POpts
-> Proxy p
-> String
-> [Tree PE]
-> n a
-> m (TT (n (PP p a)))
_fmapImpl :: POpts
-> Proxy p -> String -> [Tree PE] -> n a -> m (TT (n (PP p a)))
_fmapImpl POpts
opts Proxy p
proxyp String
msg0 [Tree PE]
hhs n a
na = do
n (TT (PP p a))
nttb <- (a -> m (TT (PP p a))) -> n a -> m (n (TT (PP p a)))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((TT (PP p a) -> TT (PP p a)) -> m (TT (PP p a)) -> m (TT (PP p a))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\TT (PP p a)
tt -> TT (PP p a)
tt TT (PP p a) -> (TT (PP p a) -> TT (PP p a)) -> TT (PP p a)
forall a b. a -> (a -> b) -> b
& (String -> Identity String)
-> TT (PP p a) -> Identity (TT (PP p a))
forall a. Lens' (TT a) String
ttString ((String -> Identity String)
-> TT (PP p a) -> Identity (TT (PP p a)))
-> ShowS -> TT (PP p a) -> TT (PP p a)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ POpts -> ShowS
litL POpts
opts
TT (PP p a) -> (TT (PP p a) -> TT (PP p a)) -> TT (PP p a)
forall a b. a -> (a -> b) -> b
& ([Tree PE] -> Identity [Tree PE])
-> TT (PP p a) -> Identity (TT (PP p a))
forall a. Lens' (TT a) [Tree PE]
ttForest (([Tree PE] -> Identity [Tree PE])
-> TT (PP p a) -> Identity (TT (PP p a)))
-> [Tree PE] -> TT (PP p a) -> TT (PP p a)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
tt]) (m (TT (PP p a)) -> m (TT (PP p a)))
-> (a -> m (TT (PP p a))) -> a -> m (TT (PP p a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval Proxy p
proxyp POpts
opts) n a
na
let ttnb :: TT (n (PP p a))
ttnb = n (TT (PP p a)) -> TT (n (PP p a))
forall (t :: Type -> Type) (f :: Type -> Type) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA n (TT (PP p a))
nttb
TT (n (PP p a)) -> m (TT (n (PP p a)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (n (PP p a)) -> m (TT (n (PP p a))))
-> TT (n (PP p a)) -> m (TT (n (PP p a)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (n (PP p a))
-> [Tree PE]
-> Either (TT (n (PP p a))) (n (PP p a))
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
Inline POpts
opts String
"" TT (n (PP p a))
ttnb [Tree PE]
hhs of
Left TT (n (PP p a))
e -> TT (n (PP p a))
e
Right n (PP p a)
ret ->
let ind :: String
ind = if n (PP p a) -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null n (PP p a)
ret then String
" <skipped>" else String
""
in TT (n (PP p a))
ttnb TT (n (PP p a))
-> (TT (n (PP p a)) -> TT (n (PP p a))) -> TT (n (PP p a))
forall a b. a -> (a -> b) -> b
& (Val (n (PP p a)) -> Identity (Val (n (PP p a))))
-> TT (n (PP p a)) -> Identity (TT (n (PP p a)))
forall a b. Lens (TT a) (TT b) (Val a) (Val b)
ttVal ((Val (n (PP p a)) -> Identity (Val (n (PP p a))))
-> TT (n (PP p a)) -> Identity (TT (n (PP p a))))
-> Val (n (PP p a)) -> TT (n (PP p a)) -> TT (n (PP p a))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ n (PP p a) -> Val (n (PP p a))
forall a. a -> Val a
Val n (PP p a)
ret
TT (n (PP p a))
-> (TT (n (PP p a)) -> TT (n (PP p a))) -> TT (n (PP p a))
forall a b. a -> (a -> b) -> b
& ([Tree PE] -> Identity [Tree PE])
-> TT (n (PP p a)) -> Identity (TT (n (PP p a)))
forall a. Lens' (TT a) [Tree PE]
ttForest (([Tree PE] -> Identity [Tree PE])
-> TT (n (PP p a)) -> Identity (TT (n (PP p a))))
-> ([Tree PE] -> [Tree PE]) -> TT (n (PP p a)) -> TT (n (PP p a))
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Tree PE]
hhs [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. Semigroup a => a -> a -> a
<>)
TT (n (PP p a))
-> (TT (n (PP p a)) -> TT (n (PP p a))) -> TT (n (PP p a))
forall a b. a -> (a -> b) -> b
& (String -> Identity String)
-> TT (n (PP p a)) -> Identity (TT (n (PP p a)))
forall a. Lens' (TT a) String
ttString ((String -> Identity String)
-> TT (n (PP p a)) -> Identity (TT (n (PP p a))))
-> ShowS -> TT (n (PP p a)) -> TT (n (PP p a))
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
ind String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
nullIf String
" "
data p <&> q deriving Int -> (p <&> q) -> ShowS
[p <&> q] -> ShowS
(p <&> q) -> String
(Int -> (p <&> q) -> ShowS)
-> ((p <&> q) -> String) -> ([p <&> q] -> ShowS) -> Show (p <&> q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p <&> q) -> ShowS
forall k (p :: k) k (q :: k). [p <&> q] -> ShowS
forall k (p :: k) k (q :: k). (p <&> q) -> String
showList :: [p <&> q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p <&> q] -> ShowS
show :: (p <&> q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p <&> q) -> String
showsPrec :: Int -> (p <&> q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p <&> q) -> ShowS
Show
infixl 1 <&>
type FMapFlipT p q = q <$> p
instance P (FMapFlipT p q) x => P (p <&> q) x where
type PP (p <&> q) x = PP (FMapFlipT p q) x
eval :: proxy (p <&> q) -> POpts -> x -> m (TT (PP (p <&> q) x))
eval proxy (p <&> q)
_ = Proxy (FMapFlipT p q)
-> POpts -> x -> m (TT (PP (FMapFlipT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (FMapFlipT p q)
forall k (t :: k). Proxy t
Proxy @(FMapFlipT p q))
data FPair p q deriving Int -> FPair p q -> ShowS
[FPair p q] -> ShowS
FPair p q -> String
(Int -> FPair p q -> ShowS)
-> (FPair p q -> String)
-> ([FPair p q] -> ShowS)
-> Show (FPair p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> FPair p q -> ShowS
forall k (p :: k) k (q :: k). [FPair p q] -> ShowS
forall k (p :: k) k (q :: k). FPair p q -> String
showList :: [FPair p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [FPair p q] -> ShowS
show :: FPair p q -> String
$cshow :: forall k (p :: k) k (q :: k). FPair p q -> String
showsPrec :: Int -> FPair p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> FPair p q -> ShowS
Show
instance ( Applicative n
, PP p a ~ n x
, PP q a ~ n y
, JoinT (PP p a) (PP q a) ~ n (x,y)
, P p a
, P q a
)
=> P (FPair p q) a where
type PP (FPair p q) a = JoinT (PP p a) (PP q a)
eval :: proxy (FPair p q) -> POpts -> a -> m (TT (PP (FPair p q) a))
eval proxy (FPair p q)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"FPair"
Either (TT (n (x, y))) (n x, n y, TT (n x), TT (n y))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (n (x, y))) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
(proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
TT (n (x, y)) -> m (TT (n (x, y)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (n (x, y)) -> m (TT (n (x, y))))
-> TT (n (x, y)) -> m (TT (n (x, y)))
forall a b. (a -> b) -> a -> b
$ case Either (TT (n (x, y))) (n x, n y, TT (n x), TT (n y))
lr of
Left TT (n (x, y))
e -> TT (n (x, y))
e
Right (n x
p,n y
q,TT (n x)
pp,TT (n y)
qq) ->
let d :: n (x, y)
d = (x -> y -> (x, y)) -> n x -> n y -> n (x, y)
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) n x
p n y
q
in POpts -> Val (n (x, y)) -> String -> [Tree PE] -> TT (n (x, y))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (n (x, y) -> Val (n (x, y))
forall a. a -> Val a
Val n (x, y)
d) String
msg0 [TT (n x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (n x)
pp, TT (n y) -> Tree PE
forall a. TT a -> Tree PE
hh TT (n y)
qq]
data p <:> q deriving Int -> (p <:> q) -> ShowS
[p <:> q] -> ShowS
(p <:> q) -> String
(Int -> (p <:> q) -> ShowS)
-> ((p <:> q) -> String) -> ([p <:> q] -> ShowS) -> Show (p <:> q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p <:> q) -> ShowS
forall k (p :: k) k (q :: k). [p <:> q] -> ShowS
forall k (p :: k) k (q :: k). (p <:> q) -> String
showList :: [p <:> q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p <:> q] -> ShowS
show :: (p <:> q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p <:> q) -> String
showsPrec :: Int -> (p <:> q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p <:> q) -> ShowS
Show
type FPairT p q = FPair p q
infixl 6 <:>
instance P (FPairT p q) x => P (p <:> q) x where
type PP (p <:> q) x = PP (FPairT p q) x
eval :: proxy (p <:> q) -> POpts -> x -> m (TT (PP (p <:> q) x))
eval proxy (p <:> q)
_ = Proxy (FPairT p q) -> POpts -> x -> m (TT (PP (FPairT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (FPairT p q)
forall k (t :: k). Proxy t
Proxy @(FPairT p q))
data FFish amb bmc a deriving Int -> FFish amb bmc a -> ShowS
[FFish amb bmc a] -> ShowS
FFish amb bmc a -> String
(Int -> FFish amb bmc a -> ShowS)
-> (FFish amb bmc a -> String)
-> ([FFish amb bmc a] -> ShowS)
-> Show (FFish amb bmc a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (amb :: k) k (bmc :: k) k (a :: k).
Int -> FFish amb bmc a -> ShowS
forall k (amb :: k) k (bmc :: k) k (a :: k).
[FFish amb bmc a] -> ShowS
forall k (amb :: k) k (bmc :: k) k (a :: k).
FFish amb bmc a -> String
showList :: [FFish amb bmc a] -> ShowS
$cshowList :: forall k (amb :: k) k (bmc :: k) k (a :: k).
[FFish amb bmc a] -> ShowS
show :: FFish amb bmc a -> String
$cshow :: forall k (amb :: k) k (bmc :: k) k (a :: k).
FFish amb bmc a -> String
showsPrec :: Int -> FFish amb bmc a -> ShowS
$cshowsPrec :: forall k (amb :: k) k (bmc :: k) k (a :: k).
Int -> FFish amb bmc a -> ShowS
Show
type FFishT amb bmc a = a >> amb >> FMap bmc >> Join
instance P (FFishT p q r) x => P (FFish p q r) x where
type PP (FFish p q r) x = PP (FFishT p q r) x
eval :: proxy (FFish p q r) -> POpts -> x -> m (TT (PP (FFish p q r) x))
eval proxy (FFish p q r)
_ = Proxy (FFishT p q r) -> POpts -> x -> m (TT (PP (FFishT p q r) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (FFishT p q r)
forall k (t :: k). Proxy t
Proxy @(FFishT p q r))
data ma >>= amb deriving Int -> (ma >>= amb) -> ShowS
[ma >>= amb] -> ShowS
(ma >>= amb) -> String
(Int -> (ma >>= amb) -> ShowS)
-> ((ma >>= amb) -> String)
-> ([ma >>= amb] -> ShowS)
-> Show (ma >>= amb)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (ma :: k) k (amb :: k). Int -> (ma >>= amb) -> ShowS
forall k (ma :: k) k (amb :: k). [ma >>= amb] -> ShowS
forall k (ma :: k) k (amb :: k). (ma >>= amb) -> String
showList :: [ma >>= amb] -> ShowS
$cshowList :: forall k (ma :: k) k (amb :: k). [ma >>= amb] -> ShowS
show :: (ma >>= amb) -> String
$cshow :: forall k (ma :: k) k (amb :: k). (ma >>= amb) -> String
showsPrec :: Int -> (ma >>= amb) -> ShowS
$cshowsPrec :: forall k (ma :: k) k (amb :: k). Int -> (ma >>= amb) -> ShowS
Show
type MBindT ma amb = ma >> FMap amb >> Join
infixl 1 >>=
instance P (MBindT p q) x => P (p >>= q) x where
type PP (p >>= q) x = PP (MBindT p q) x
eval :: proxy (p >>= q) -> POpts -> x -> m (TT (PP (p >>= q) x))
eval proxy (p >>= q)
_ = Proxy (MBindT p q) -> POpts -> x -> m (TT (PP (MBindT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (MBindT p q)
forall k (t :: k). Proxy t
Proxy @(MBindT p q))
data p <*> q deriving Int -> (p <*> q) -> ShowS
[p <*> q] -> ShowS
(p <*> q) -> String
(Int -> (p <*> q) -> ShowS)
-> ((p <*> q) -> String) -> ([p <*> q] -> ShowS) -> Show (p <*> q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p <*> q) -> ShowS
forall k (p :: k) k (q :: k). [p <*> q] -> ShowS
forall k (p :: k) k (q :: k). (p <*> q) -> String
showList :: [p <*> q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p <*> q] -> ShowS
show :: (p <*> q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p <*> q) -> String
showsPrec :: Int -> (p <*> q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p <*> q) -> ShowS
Show
infixl 1 <*>
type AppT fab fa = fa >>= (Id <$> fab)
instance P (AppT p q) x => P (p <*> q) x where
type PP (p <*> q) x = PP (AppT p q) x
eval :: proxy (p <*> q) -> POpts -> x -> m (TT (PP (p <*> q) x))
eval proxy (p <*> q)
_ = Proxy (AppT p q) -> POpts -> x -> m (TT (PP (AppT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (AppT p q)
forall k (t :: k). Proxy t
Proxy @(AppT p q))
data Flip (p :: k1 -> k2 -> k3) (q :: k2) (r :: k1) deriving Int -> Flip p q r -> ShowS
[Flip p q r] -> ShowS
Flip p q r -> String
(Int -> Flip p q r -> ShowS)
-> (Flip p q r -> String)
-> ([Flip p q r] -> ShowS)
-> Show (Flip p q r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k3 k2 k1 (p :: k1 -> k2 -> k3) (q :: k2) (r :: k1).
Int -> Flip p q r -> ShowS
forall k3 k2 k1 (p :: k1 -> k2 -> k3) (q :: k2) (r :: k1).
[Flip p q r] -> ShowS
forall k3 k2 k1 (p :: k1 -> k2 -> k3) (q :: k2) (r :: k1).
Flip p q r -> String
showList :: [Flip p q r] -> ShowS
$cshowList :: forall k3 k2 k1 (p :: k1 -> k2 -> k3) (q :: k2) (r :: k1).
[Flip p q r] -> ShowS
show :: Flip p q r -> String
$cshow :: forall k3 k2 k1 (p :: k1 -> k2 -> k3) (q :: k2) (r :: k1).
Flip p q r -> String
showsPrec :: Int -> Flip p q r -> ShowS
$cshowsPrec :: forall k3 k2 k1 (p :: k1 -> k2 -> k3) (q :: k2) (r :: k1).
Int -> Flip p q r -> ShowS
Show
instance P (p r q) x => P (Flip p q r) x where
type PP (Flip p q r) x = PP (p r q) x
eval :: proxy (Flip p q r) -> POpts -> x -> m (TT (PP (Flip p q r) x))
eval proxy (Flip p q r)
_ = Proxy (p r q) -> POpts -> x -> m (TT (PP (p r q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (p r q)
forall k (t :: k). Proxy t
Proxy @(p r q))
data LiftA2 p q r deriving Int -> LiftA2 p q r -> ShowS
[LiftA2 p q r] -> ShowS
LiftA2 p q r -> String
(Int -> LiftA2 p q r -> ShowS)
-> (LiftA2 p q r -> String)
-> ([LiftA2 p q r] -> ShowS)
-> Show (LiftA2 p q r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k) k (r :: k).
Int -> LiftA2 p q r -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). [LiftA2 p q r] -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). LiftA2 p q r -> String
showList :: [LiftA2 p q r] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k) k (r :: k). [LiftA2 p q r] -> ShowS
show :: LiftA2 p q r -> String
$cshow :: forall k (p :: k) k (q :: k) k (r :: k). LiftA2 p q r -> String
showsPrec :: Int -> LiftA2 p q r -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k) k (r :: k).
Int -> LiftA2 p q r -> ShowS
Show
instance ( Traversable n
, Applicative n
, P p (a,b)
, P q x
, P r x
, PP p (a,b) ~ c
, PP q x ~ n a
, PP r x ~ n b
) => P (LiftA2 p q r) x where
type PP (LiftA2 p q r) x = (ExtractTFromTA (PP q x)) (PP p (ExtractAFromTA (PP q x), ExtractAFromTA (PP r x)))
eval :: proxy (LiftA2 p q r) -> POpts -> x -> m (TT (PP (LiftA2 p q r) x))
eval proxy (LiftA2 p q r)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"LiftA2"
Either (TT (n c)) (n a, n b, TT (n a), TT (n b))
lr <- Inline
-> String
-> Proxy q
-> Proxy r
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT (n c)) (PP q x, PP r x, TT (PP q x), TT (PP r x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
(proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy q
forall k (t :: k). Proxy t
Proxy @q) (Proxy r
forall k (t :: k). Proxy t
Proxy @r) POpts
opts x
x []
case Either (TT (n c)) (n a, n b, TT (n a), TT (n b))
lr of
Left TT (n c)
e -> TT (n c) -> m (TT (n c))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (n c)
e
Right (n a
q,n b
r,TT (n a)
qq,TT (n b)
rr) -> do
let w :: n (a, b)
w = (a -> b -> (a, b)) -> n a -> n b -> n (a, b)
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) n a
q n b
r
POpts
-> Proxy p
-> String
-> [Tree PE]
-> n (a, b)
-> m (TT (n (PP p (a, b))))
forall k (m :: Type -> Type) (n :: Type -> Type) (p :: k) a.
(P p a, Traversable n, MonadEval m) =>
POpts
-> Proxy p -> String -> [Tree PE] -> n a -> m (TT (n (PP p a)))
_fmapImpl POpts
opts (Proxy p
forall k (t :: k). Proxy t
Proxy @p) String
msg0 [TT (n a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (n a)
qq, TT (n b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (n b)
rr] n (a, b)
w
data BiMap p q deriving Int -> BiMap p q -> ShowS
[BiMap p q] -> ShowS
BiMap p q -> String
(Int -> BiMap p q -> ShowS)
-> (BiMap p q -> String)
-> ([BiMap p q] -> ShowS)
-> Show (BiMap p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> BiMap p q -> ShowS
forall k (p :: k) k (q :: k). [BiMap p q] -> ShowS
forall k (p :: k) k (q :: k). BiMap p q -> String
showList :: [BiMap p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [BiMap p q] -> ShowS
show :: BiMap p q -> String
$cshow :: forall k (p :: k) k (q :: k). BiMap p q -> String
showsPrec :: Int -> BiMap p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> BiMap p q -> ShowS
Show
instance ( Bitraversable n
, P p a
, P q b
) => P (BiMap p q) (n a b) where
type PP (BiMap p q) (n a b) = n (PP p a) (PP q b)
eval :: proxy (BiMap p q)
-> POpts -> n a b -> m (TT (PP (BiMap p q) (n a b)))
eval proxy (BiMap p q)
_ POpts
opts n a b
nab = do
let msg0 :: String
msg0 = String
"BiMap"
POpts
-> Proxy p
-> Proxy q
-> String
-> [Tree PE]
-> n a b
-> m (TT (n (PP p a) (PP q b)))
forall k k (m :: Type -> Type) (n :: Type -> Type -> Type) (p :: k)
(q :: k) a b.
(P p a, P q b, Bitraversable n, MonadEval m) =>
POpts
-> Proxy p
-> Proxy q
-> String
-> [Tree PE]
-> n a b
-> m (TT (n (PP p a) (PP q b)))
_bimapImpl POpts
opts (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) String
msg0 [] n a b
nab
_bimapImpl :: forall m n p q a b
. ( P p a
, P q b
, Bitraversable n
, MonadEval m
) => POpts
-> Proxy p
-> Proxy q
-> String
-> [Tree PE]
-> n a b
-> m (TT (n (PP p a) (PP q b)))
_bimapImpl :: POpts
-> Proxy p
-> Proxy q
-> String
-> [Tree PE]
-> n a b
-> m (TT (n (PP p a) (PP q b)))
_bimapImpl POpts
opts Proxy p
proxyp Proxy q
proxyq String
msg0 [Tree PE]
hhs n a b
nab = do
n (TT (PP p a)) (TT (PP q b))
nttb <- (a -> m (TT (PP p a)))
-> (b -> m (TT (PP q b)))
-> n a b
-> m (n (TT (PP p a)) (TT (PP q b)))
forall (t :: Type -> Type -> Type) (f :: Type -> Type) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse
((TT (PP p a) -> TT (PP p a)) -> m (TT (PP p a)) -> m (TT (PP p a))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\TT (PP p a)
tt -> TT (PP p a)
tt TT (PP p a) -> (TT (PP p a) -> TT (PP p a)) -> TT (PP p a)
forall a b. a -> (a -> b) -> b
& (String -> Identity String)
-> TT (PP p a) -> Identity (TT (PP p a))
forall a. Lens' (TT a) String
ttString ((String -> Identity String)
-> TT (PP p a) -> Identity (TT (PP p a)))
-> ShowS -> TT (PP p a) -> TT (PP p a)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ POpts -> ShowS
litL POpts
opts
TT (PP p a) -> (TT (PP p a) -> TT (PP p a)) -> TT (PP p a)
forall a b. a -> (a -> b) -> b
& ([Tree PE] -> Identity [Tree PE])
-> TT (PP p a) -> Identity (TT (PP p a))
forall a. Lens' (TT a) [Tree PE]
ttForest (([Tree PE] -> Identity [Tree PE])
-> TT (PP p a) -> Identity (TT (PP p a)))
-> [Tree PE] -> TT (PP p a) -> TT (PP p a)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
tt]) (m (TT (PP p a)) -> m (TT (PP p a)))
-> (a -> m (TT (PP p a))) -> a -> m (TT (PP p a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval Proxy p
proxyp POpts
opts)
((TT (PP q b) -> TT (PP q b)) -> m (TT (PP q b)) -> m (TT (PP q b))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\TT (PP q b)
tt -> TT (PP q b)
tt TT (PP q b) -> (TT (PP q b) -> TT (PP q b)) -> TT (PP q b)
forall a b. a -> (a -> b) -> b
& (String -> Identity String)
-> TT (PP q b) -> Identity (TT (PP q b))
forall a. Lens' (TT a) String
ttString ((String -> Identity String)
-> TT (PP q b) -> Identity (TT (PP q b)))
-> ShowS -> TT (PP q b) -> TT (PP q b)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ POpts -> ShowS
litL POpts
opts
TT (PP q b) -> (TT (PP q b) -> TT (PP q b)) -> TT (PP q b)
forall a b. a -> (a -> b) -> b
& ([Tree PE] -> Identity [Tree PE])
-> TT (PP q b) -> Identity (TT (PP q b))
forall a. Lens' (TT a) [Tree PE]
ttForest (([Tree PE] -> Identity [Tree PE])
-> TT (PP q b) -> Identity (TT (PP q b)))
-> [Tree PE] -> TT (PP q b) -> TT (PP q b)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TT (PP q b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q b)
tt]) (m (TT (PP q b)) -> m (TT (PP q b)))
-> (b -> m (TT (PP q b))) -> b -> m (TT (PP q b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy q -> POpts -> b -> m (TT (PP q b))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval Proxy q
proxyq POpts
opts)
n a b
nab
let ttnb :: TT (n (PP p a) (PP q b))
ttnb = n (TT (PP p a)) (TT (PP q b)) -> TT (n (PP p a) (PP q b))
forall (t :: Type -> Type -> Type) (f :: Type -> Type) a b.
(Bitraversable t, Applicative f) =>
t (f a) (f b) -> f (t a b)
bisequence n (TT (PP p a)) (TT (PP q b))
nttb
TT (n (PP p a) (PP q b)) -> m (TT (n (PP p a) (PP q b)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (n (PP p a) (PP q b)) -> m (TT (n (PP p a) (PP q b))))
-> TT (n (PP p a) (PP q b)) -> m (TT (n (PP p a) (PP q b)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (n (PP p a) (PP q b))
-> [Tree PE]
-> Either (TT (n (PP p a) (PP q b))) (n (PP p a) (PP q b))
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
Inline POpts
opts String
"" TT (n (PP p a) (PP q b))
ttnb [Tree PE]
hhs of
Left TT (n (PP p a) (PP q b))
e -> TT (n (PP p a) (PP q b))
e
Right n (PP p a) (PP q b)
ret ->
let ind :: String
ind = case (PP p a -> ([PP p a], [PP q b]))
-> (PP q b -> ([PP p a], [PP q b]))
-> n (PP p a) (PP q b)
-> ([PP p a], [PP q b])
forall (p :: Type -> Type -> Type) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap ((,[PP q b]
forall a. Monoid a => a
mempty) ([PP p a] -> ([PP p a], [PP q b]))
-> (PP p a -> [PP p a]) -> PP p a -> ([PP p a], [PP q b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP p a -> [PP p a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure) (([PP p a]
forall a. Monoid a => a
mempty,) ([PP q b] -> ([PP p a], [PP q b]))
-> (PP q b -> [PP q b]) -> PP q b -> ([PP p a], [PP q b])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PP q b -> [PP q b]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure) n (PP p a) (PP q b)
ret of
([], []) -> String
" <skipped>"
(PP p a
_:[PP p a]
_, []) -> String
"(L)"
([], PP q b
_:[PP q b]
_) -> String
"(R)"
(PP p a
_:[PP p a]
_, PP q b
_:[PP q b]
_) -> String
"(B)"
in TT (n (PP p a) (PP q b))
ttnb TT (n (PP p a) (PP q b))
-> (TT (n (PP p a) (PP q b)) -> TT (n (PP p a) (PP q b)))
-> TT (n (PP p a) (PP q b))
forall a b. a -> (a -> b) -> b
& (Val (n (PP p a) (PP q b)) -> Identity (Val (n (PP p a) (PP q b))))
-> TT (n (PP p a) (PP q b)) -> Identity (TT (n (PP p a) (PP q b)))
forall a b. Lens (TT a) (TT b) (Val a) (Val b)
ttVal ((Val (n (PP p a) (PP q b))
-> Identity (Val (n (PP p a) (PP q b))))
-> TT (n (PP p a) (PP q b)) -> Identity (TT (n (PP p a) (PP q b))))
-> Val (n (PP p a) (PP q b))
-> TT (n (PP p a) (PP q b))
-> TT (n (PP p a) (PP q b))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ n (PP p a) (PP q b) -> Val (n (PP p a) (PP q b))
forall a. a -> Val a
Val n (PP p a) (PP q b)
ret
TT (n (PP p a) (PP q b))
-> (TT (n (PP p a) (PP q b)) -> TT (n (PP p a) (PP q b)))
-> TT (n (PP p a) (PP q b))
forall a b. a -> (a -> b) -> b
& ([Tree PE] -> Identity [Tree PE])
-> TT (n (PP p a) (PP q b)) -> Identity (TT (n (PP p a) (PP q b)))
forall a. Lens' (TT a) [Tree PE]
ttForest (([Tree PE] -> Identity [Tree PE])
-> TT (n (PP p a) (PP q b)) -> Identity (TT (n (PP p a) (PP q b))))
-> ([Tree PE] -> [Tree PE])
-> TT (n (PP p a) (PP q b))
-> TT (n (PP p a) (PP q b))
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Tree PE]
hhs [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. Semigroup a => a -> a -> a
<>)
TT (n (PP p a) (PP q b))
-> (TT (n (PP p a) (PP q b)) -> TT (n (PP p a) (PP q b)))
-> TT (n (PP p a) (PP q b))
forall a b. a -> (a -> b) -> b
& (String -> Identity String)
-> TT (n (PP p a) (PP q b)) -> Identity (TT (n (PP p a) (PP q b)))
forall a. Lens' (TT a) String
ttString ((String -> Identity String)
-> TT (n (PP p a) (PP q b)) -> Identity (TT (n (PP p a) (PP q b))))
-> ShowS -> TT (n (PP p a) (PP q b)) -> TT (n (PP p a) (PP q b))
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
ind String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
nullIf String
" "
data ELR a b = EEmpty | ELeft !a | ERight !b | EBoth !a !b deriving (Int -> ELR a b -> ShowS
[ELR a b] -> ShowS
ELR a b -> String
(Int -> ELR a b -> ShowS)
-> (ELR a b -> String) -> ([ELR a b] -> ShowS) -> Show (ELR a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> ELR a b -> ShowS
forall a b. (Show a, Show b) => [ELR a b] -> ShowS
forall a b. (Show a, Show b) => ELR a b -> String
showList :: [ELR a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [ELR a b] -> ShowS
show :: ELR a b -> String
$cshow :: forall a b. (Show a, Show b) => ELR a b -> String
showsPrec :: Int -> ELR a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> ELR a b -> ShowS
Show,ELR a b -> ELR a b -> Bool
(ELR a b -> ELR a b -> Bool)
-> (ELR a b -> ELR a b -> Bool) -> Eq (ELR a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => ELR a b -> ELR a b -> Bool
/= :: ELR a b -> ELR a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => ELR a b -> ELR a b -> Bool
== :: ELR a b -> ELR a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => ELR a b -> ELR a b -> Bool
Eq,Eq (ELR a b)
Eq (ELR a b)
-> (ELR a b -> ELR a b -> Ordering)
-> (ELR a b -> ELR a b -> Bool)
-> (ELR a b -> ELR a b -> Bool)
-> (ELR a b -> ELR a b -> Bool)
-> (ELR a b -> ELR a b -> Bool)
-> (ELR a b -> ELR a b -> ELR a b)
-> (ELR a b -> ELR a b -> ELR a b)
-> Ord (ELR a b)
ELR a b -> ELR a b -> Bool
ELR a b -> ELR a b -> Ordering
ELR a b -> ELR a b -> ELR a b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a b. (Ord a, Ord b) => Eq (ELR a b)
forall a b. (Ord a, Ord b) => ELR a b -> ELR a b -> Bool
forall a b. (Ord a, Ord b) => ELR a b -> ELR a b -> Ordering
forall a b. (Ord a, Ord b) => ELR a b -> ELR a b -> ELR a b
min :: ELR a b -> ELR a b -> ELR a b
$cmin :: forall a b. (Ord a, Ord b) => ELR a b -> ELR a b -> ELR a b
max :: ELR a b -> ELR a b -> ELR a b
$cmax :: forall a b. (Ord a, Ord b) => ELR a b -> ELR a b -> ELR a b
>= :: ELR a b -> ELR a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => ELR a b -> ELR a b -> Bool
> :: ELR a b -> ELR a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => ELR a b -> ELR a b -> Bool
<= :: ELR a b -> ELR a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => ELR a b -> ELR a b -> Bool
< :: ELR a b -> ELR a b -> Bool
$c< :: forall a b. (Ord a, Ord b) => ELR a b -> ELR a b -> Bool
compare :: ELR a b -> ELR a b -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => ELR a b -> ELR a b -> Ordering
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (ELR a b)
Ord,ELR a a -> Bool
(a -> m) -> ELR a a -> m
(a -> b -> b) -> b -> ELR a a -> b
(forall m. Monoid m => ELR a m -> m)
-> (forall m a. Monoid m => (a -> m) -> ELR a a -> m)
-> (forall m a. Monoid m => (a -> m) -> ELR a a -> m)
-> (forall a b. (a -> b -> b) -> b -> ELR a a -> b)
-> (forall a b. (a -> b -> b) -> b -> ELR a a -> b)
-> (forall b a. (b -> a -> b) -> b -> ELR a a -> b)
-> (forall b a. (b -> a -> b) -> b -> ELR a a -> b)
-> (forall a. (a -> a -> a) -> ELR a a -> a)
-> (forall a. (a -> a -> a) -> ELR a a -> a)
-> (forall a. ELR a a -> [a])
-> (forall a. ELR a a -> Bool)
-> (forall a. ELR a a -> Int)
-> (forall a. Eq a => a -> ELR a a -> Bool)
-> (forall a. Ord a => ELR a a -> a)
-> (forall a. Ord a => ELR a a -> a)
-> (forall a. Num a => ELR a a -> a)
-> (forall a. Num a => ELR a a -> a)
-> Foldable (ELR a)
forall a. Eq a => a -> ELR a a -> Bool
forall a. Num a => ELR a a -> a
forall a. Ord a => ELR a a -> a
forall m. Monoid m => ELR a m -> m
forall a. ELR a a -> Bool
forall a. ELR a a -> Int
forall a. ELR a a -> [a]
forall a. (a -> a -> a) -> ELR a a -> a
forall a a. Eq a => a -> ELR a a -> Bool
forall a a. Num a => ELR a a -> a
forall a a. Ord a => ELR a a -> a
forall m a. Monoid m => (a -> m) -> ELR a a -> m
forall a m. Monoid m => ELR a m -> m
forall a a. ELR a a -> Bool
forall a a. ELR a a -> Int
forall a a. ELR a a -> [a]
forall b a. (b -> a -> b) -> b -> ELR a a -> b
forall a b. (a -> b -> b) -> b -> ELR a a -> b
forall a a. (a -> a -> a) -> ELR a a -> a
forall a m a. Monoid m => (a -> m) -> ELR a a -> m
forall a b a. (b -> a -> b) -> b -> ELR a a -> b
forall a a b. (a -> b -> b) -> b -> ELR a a -> b
forall (t :: Type -> Type).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: ELR a a -> a
$cproduct :: forall a a. Num a => ELR a a -> a
sum :: ELR a a -> a
$csum :: forall a a. Num a => ELR a a -> a
minimum :: ELR a a -> a
$cminimum :: forall a a. Ord a => ELR a a -> a
maximum :: ELR a a -> a
$cmaximum :: forall a a. Ord a => ELR a a -> a
elem :: a -> ELR a a -> Bool
$celem :: forall a a. Eq a => a -> ELR a a -> Bool
length :: ELR a a -> Int
$clength :: forall a a. ELR a a -> Int
null :: ELR a a -> Bool
$cnull :: forall a a. ELR a a -> Bool
toList :: ELR a a -> [a]
$ctoList :: forall a a. ELR a a -> [a]
foldl1 :: (a -> a -> a) -> ELR a a -> a
$cfoldl1 :: forall a a. (a -> a -> a) -> ELR a a -> a
foldr1 :: (a -> a -> a) -> ELR a a -> a
$cfoldr1 :: forall a a. (a -> a -> a) -> ELR a a -> a
foldl' :: (b -> a -> b) -> b -> ELR a a -> b
$cfoldl' :: forall a b a. (b -> a -> b) -> b -> ELR a a -> b
foldl :: (b -> a -> b) -> b -> ELR a a -> b
$cfoldl :: forall a b a. (b -> a -> b) -> b -> ELR a a -> b
foldr' :: (a -> b -> b) -> b -> ELR a a -> b
$cfoldr' :: forall a a b. (a -> b -> b) -> b -> ELR a a -> b
foldr :: (a -> b -> b) -> b -> ELR a a -> b
$cfoldr :: forall a a b. (a -> b -> b) -> b -> ELR a a -> b
foldMap' :: (a -> m) -> ELR a a -> m
$cfoldMap' :: forall a m a. Monoid m => (a -> m) -> ELR a a -> m
foldMap :: (a -> m) -> ELR a a -> m
$cfoldMap :: forall a m a. Monoid m => (a -> m) -> ELR a a -> m
fold :: ELR a m -> m
$cfold :: forall a m. Monoid m => ELR a m -> m
Foldable,a -> ELR a b -> ELR a a
(a -> b) -> ELR a a -> ELR a b
(forall a b. (a -> b) -> ELR a a -> ELR a b)
-> (forall a b. a -> ELR a b -> ELR a a) -> Functor (ELR a)
forall a b. a -> ELR a b -> ELR a a
forall a b. (a -> b) -> ELR a a -> ELR a b
forall a a b. a -> ELR a b -> ELR a a
forall a a b. (a -> b) -> ELR a a -> ELR a b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ELR a b -> ELR a a
$c<$ :: forall a a b. a -> ELR a b -> ELR a a
fmap :: (a -> b) -> ELR a a -> ELR a b
$cfmap :: forall a a b. (a -> b) -> ELR a a -> ELR a b
Functor,Functor (ELR a)
Foldable (ELR a)
Functor (ELR a)
-> Foldable (ELR a)
-> (forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> ELR a a -> f (ELR a b))
-> (forall (f :: Type -> Type) a.
Applicative f =>
ELR a (f a) -> f (ELR a a))
-> (forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> ELR a a -> m (ELR a b))
-> (forall (m :: Type -> Type) a.
Monad m =>
ELR a (m a) -> m (ELR a a))
-> Traversable (ELR a)
(a -> f b) -> ELR a a -> f (ELR a b)
forall a. Functor (ELR a)
forall a. Foldable (ELR a)
forall a (m :: Type -> Type) a.
Monad m =>
ELR a (m a) -> m (ELR a a)
forall a (f :: Type -> Type) a.
Applicative f =>
ELR a (f a) -> f (ELR a a)
forall a (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> ELR a a -> m (ELR a b)
forall a (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> ELR a a -> f (ELR a b)
forall (t :: Type -> Type).
Functor t
-> Foldable t
-> (forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: Type -> Type) a.
Applicative f =>
t (f a) -> f (t a))
-> (forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: Type -> Type) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: Type -> Type) a. Monad m => ELR a (m a) -> m (ELR a a)
forall (f :: Type -> Type) a.
Applicative f =>
ELR a (f a) -> f (ELR a a)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> ELR a a -> m (ELR a b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> ELR a a -> f (ELR a b)
sequence :: ELR a (m a) -> m (ELR a a)
$csequence :: forall a (m :: Type -> Type) a.
Monad m =>
ELR a (m a) -> m (ELR a a)
mapM :: (a -> m b) -> ELR a a -> m (ELR a b)
$cmapM :: forall a (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> ELR a a -> m (ELR a b)
sequenceA :: ELR a (f a) -> f (ELR a a)
$csequenceA :: forall a (f :: Type -> Type) a.
Applicative f =>
ELR a (f a) -> f (ELR a a)
traverse :: (a -> f b) -> ELR a a -> f (ELR a b)
$ctraverse :: forall a (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> ELR a a -> f (ELR a b)
$cp2Traversable :: forall a. Foldable (ELR a)
$cp1Traversable :: forall a. Functor (ELR a)
Traversable)
instance Bifunctor ELR where
bimap :: (a -> b) -> (c -> d) -> ELR a c -> ELR b d
bimap a -> b
f c -> d
g ELR a c
x =
case ELR a c
x of
ELR a c
EEmpty -> ELR b d
forall a b. ELR a b
EEmpty
ELeft a
a -> b -> ELR b d
forall a b. a -> ELR a b
ELeft (a -> b
f a
a)
ERight c
b -> d -> ELR b d
forall a b. b -> ELR a b
ERight (c -> d
g c
b)
EBoth a
a c
b -> b -> d -> ELR b d
forall a b. a -> b -> ELR a b
EBoth (a -> b
f a
a) (c -> d
g c
b)
instance Bifoldable ELR where
bifoldMap :: (a -> m) -> (b -> m) -> ELR a b -> m
bifoldMap a -> m
f b -> m
g ELR a b
x =
case ELR a b
x of
ELR a b
EEmpty -> m
forall a. Monoid a => a
mempty
ELeft a
a -> a -> m
f a
a
ERight b
b -> b -> m
g b
b
EBoth a
a b
b -> a -> m
f a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> b -> m
g b
b
instance Bitraversable ELR where
bitraverse :: (a -> f c) -> (b -> f d) -> ELR a b -> f (ELR c d)
bitraverse a -> f c
f b -> f d
g ELR a b
x =
case ELR a b
x of
ELR a b
EEmpty -> ELR c d -> f (ELR c d)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ELR c d
forall a b. ELR a b
EEmpty
ELeft a
a -> c -> ELR c d
forall a b. a -> ELR a b
ELeft (c -> ELR c d) -> f c -> f (ELR c d)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a
ERight b
b -> d -> ELR c d
forall a b. b -> ELR a b
ERight (d -> ELR c d) -> f d -> f (ELR c d)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
b
EBoth a
a b
b -> c -> d -> ELR c d
forall a b. a -> b -> ELR a b
EBoth (c -> d -> ELR c d) -> f c -> f (d -> ELR c d)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a f (d -> ELR c d) -> f d -> f (ELR c d)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> b -> f d
g b
b
instance SwapC ELR where
swapC :: ELR a b -> ELR b a
swapC =
\case
ELR a b
EEmpty -> ELR b a
forall a b. ELR a b
EEmpty
ELeft a
a -> a -> ELR b a
forall a b. b -> ELR a b
ERight a
a
ERight b
b -> b -> ELR b a
forall a b. a -> ELR a b
ELeft b
b
EBoth a
a b
b -> b -> a -> ELR b a
forall a b. a -> b -> ELR a b
EBoth b
b a
a