{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE NoStarIsType #-}
module Predicate.Core (
Id
, IdT
, W
, Msg
, MsgI
, Hide
, Width
, Hole
, UnproxyT
, Len
, Length
, Map'
, Map
, Do
, OneP
, Swap
, Arg'
, pan
, panv
, pa
, pu
, pab
, pub
, pav
, puv
, pl
, pz
, run
, runs
, unsafeEval
, runP
, runPQ
, runPQBool
, evalBool
, evalBoolHide
, evalHide
, evalQuick
, evalEither
, Wrap
, Wrap'
, Unwrap
, Fail
, FailP
, FailT
, FailS
, Fst
, Snd
, Thd
, L1
, L2
, L3
, L4
, L5
, L6
, L7
, L8
, L11
, L12
, L13
, L21
, L22
, L23
, L31
, L32
, L33
, type (&&)
, type (&&~)
, type (||)
, type (||~)
, type (~>)
, Not
, Between
, type (<..>)
, All
, Any
, IdBool
, type (>>)
, type (>>>)
, type (<<)
, type ($)
, type (&)
, DoL
, P(..)
, DoExpandT
, DoExpandLT
, ArgT
) where
import Predicate.Misc
import Predicate.Util
import Predicate.Elr
import qualified GHC.TypeLits as GL
import GHC.TypeLits (Symbol,Nat,KnownSymbol,KnownNat,ErrorMessage((:$$:),(:<>:)))
import Control.Lens
import Data.Foldable (toList)
import Data.Proxy (Proxy(..))
import Data.Typeable (Typeable)
import Data.Kind (Type)
import Data.These (These(..))
import Control.Monad (zipWithM)
import Control.Arrow (right)
import Data.List (find)
import Data.Maybe (fromMaybe)
import Data.Tree (Tree)
import Data.Tree.Lens (root)
import qualified Text.Regex.PCRE.Heavy as RH
import GHC.Stack (HasCallStack)
import qualified Data.Semigroup as SG
class P p a where
type PP (p :: k) a :: Type
eval :: MonadEval m
=> proxy p
-> POpts
-> a
-> m (TT (PP p a))
evalBool :: ( MonadEval m
, P p a
, PP p a ~ Bool
) => proxy p
-> POpts
-> a
-> m (TT (PP p a))
evalBool :: proxy p -> POpts -> a -> m (TT (PP p a))
evalBool proxy p
p POpts
opts = (TT Bool -> TT Bool) -> m (TT Bool) -> m (TT Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap TT Bool -> TT Bool
fixTTBool (m (TT Bool) -> m (TT Bool))
-> (a -> m (TT Bool)) -> a -> m (TT Bool)
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
p POpts
opts
evalQuick :: forall opts p i
. ( OptC opts
, P p i
)
=> i
-> Either String (PP p i)
evalQuick :: i -> Either String (PP p i)
evalQuick = TT (PP p i) -> Either String (PP p i)
forall a. TT a -> Either String a
getValLRFromTT (TT (PP p i) -> Either String (PP p i))
-> (i -> TT (PP p i)) -> i -> Either String (PP p i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (TT (PP p i)) -> TT (PP p i)
forall a. Identity a -> a
runIdentity (Identity (TT (PP p i)) -> TT (PP p i))
-> (i -> Identity (TT (PP p i))) -> i -> TT (PP p i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy p -> POpts -> i -> Identity (TT (PP p i))
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) (OptC opts => POpts
forall (o :: Opt). OptC o => POpts
getOpt @opts)
data Id deriving Int -> Id -> ShowS
[Id] -> ShowS
Id -> String
(Int -> Id -> ShowS)
-> (Id -> String) -> ([Id] -> ShowS) -> Show Id
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Id] -> ShowS
$cshowList :: [Id] -> ShowS
show :: Id -> String
$cshow :: Id -> String
showsPrec :: Int -> Id -> ShowS
$cshowsPrec :: Int -> Id -> ShowS
Show
instance Show a => P Id a where
type PP Id a = a
eval :: proxy Id -> POpts -> a -> m (TT (PP Id a))
eval proxy Id
_ POpts
opts a
a =
let msg0 :: String
msg0 = String
"Id"
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
a) (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
a) []
data IdT deriving Int -> IdT -> ShowS
[IdT] -> ShowS
IdT -> String
(Int -> IdT -> ShowS)
-> (IdT -> String) -> ([IdT] -> ShowS) -> Show IdT
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdT] -> ShowS
$cshowList :: [IdT] -> ShowS
show :: IdT -> String
$cshow :: IdT -> String
showsPrec :: Int -> IdT -> ShowS
$cshowsPrec :: Int -> IdT -> ShowS
Show
instance ( Typeable a
, Show a
) => P IdT a where
type PP IdT a = a
eval :: proxy IdT -> POpts -> a -> m (TT (PP IdT a))
eval proxy IdT
_ POpts
opts a
a =
let msg0 :: String
msg0 = String
"IdT(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
t :: String
t = Typeable a => String
forall t. Typeable t => String
showT @a
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
a) (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
a) []
data W (p :: k) deriving Int -> W p -> ShowS
[W p] -> ShowS
W p -> String
(Int -> W p -> ShowS)
-> (W p -> String) -> ([W p] -> ShowS) -> Show (W p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> W p -> ShowS
forall k (p :: k). [W p] -> ShowS
forall k (p :: k). W p -> String
showList :: [W p] -> ShowS
$cshowList :: forall k (p :: k). [W p] -> ShowS
show :: W p -> String
$cshow :: forall k (p :: k). W p -> String
showsPrec :: Int -> W p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> W p -> ShowS
Show
instance P p a => P (W p) a where
type PP (W p) a = PP p a
eval :: proxy (W p) -> POpts -> a -> m (TT (PP (W p) a))
eval proxy (W p)
_ POpts
opts | POpts -> Bool
isVerbose POpts
opts = Proxy (MsgI "W " p) -> POpts -> a -> m (TT (PP (MsgI "W " 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 "W " p)
forall k (t :: k). Proxy t
Proxy @(MsgI "W " p)) POpts
opts
| Bool
otherwise = 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
data Msg prt p deriving Int -> Msg prt p -> ShowS
[Msg prt p] -> ShowS
Msg prt p -> String
(Int -> Msg prt p -> ShowS)
-> (Msg prt p -> String)
-> ([Msg prt p] -> ShowS)
-> Show (Msg prt p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (prt :: k) k (p :: k). Int -> Msg prt p -> ShowS
forall k (prt :: k) k (p :: k). [Msg prt p] -> ShowS
forall k (prt :: k) k (p :: k). Msg prt p -> String
showList :: [Msg prt p] -> ShowS
$cshowList :: forall k (prt :: k) k (p :: k). [Msg prt p] -> ShowS
show :: Msg prt p -> String
$cshow :: forall k (prt :: k) k (p :: k). Msg prt p -> String
showsPrec :: Int -> Msg prt p -> ShowS
$cshowsPrec :: forall k (prt :: k) k (p :: k). Int -> Msg prt p -> ShowS
Show
instance ( P prt a
, PP prt a ~ String
, P p a
) => P (Msg prt p) a where
type PP (Msg prt p) a = PP p a
eval :: proxy (Msg prt p) -> POpts -> a -> m (TT (PP (Msg prt p) a))
eval proxy (Msg prt p)
_ POpts
opts a
a = do
TT String
pp <- Proxy prt -> POpts -> a -> m (TT (PP prt 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 prt
forall k (t :: k). Proxy t
Proxy @prt) POpts
opts a
a
case Inline
-> POpts
-> String
-> TT String
-> [Tree PE]
-> Either (TT (PP p a)) String
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
"Msg" TT String
pp [] of
Left TT (PP p a)
e -> TT (PP p a) -> m (TT (PP p a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP p a)
e
Right String
msg -> String -> TT (PP p a) -> TT (PP p a)
forall a. String -> TT a -> TT a
prefixMsg (POpts -> ShowS
setOtherEffects POpts
opts String
msg String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" ") (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
<$> 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
data MsgI prt p deriving Int -> MsgI prt p -> ShowS
[MsgI prt p] -> ShowS
MsgI prt p -> String
(Int -> MsgI prt p -> ShowS)
-> (MsgI prt p -> String)
-> ([MsgI prt p] -> ShowS)
-> Show (MsgI prt p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (prt :: k) k (p :: k). Int -> MsgI prt p -> ShowS
forall k (prt :: k) k (p :: k). [MsgI prt p] -> ShowS
forall k (prt :: k) k (p :: k). MsgI prt p -> String
showList :: [MsgI prt p] -> ShowS
$cshowList :: forall k (prt :: k) k (p :: k). [MsgI prt p] -> ShowS
show :: MsgI prt p -> String
$cshow :: forall k (prt :: k) k (p :: k). MsgI prt p -> String
showsPrec :: Int -> MsgI prt p -> ShowS
$cshowsPrec :: forall k (prt :: k) k (p :: k). Int -> MsgI prt p -> ShowS
Show
instance ( P prt a
, PP prt a ~ String
, P p a
) => P (MsgI prt p) a where
type PP (MsgI prt p) a = PP p a
eval :: proxy (MsgI prt p) -> POpts -> a -> m (TT (PP (MsgI prt p) a))
eval proxy (MsgI prt p)
_ POpts
opts a
a = do
TT String
pp <- Proxy prt -> POpts -> a -> m (TT (PP prt 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 prt
forall k (t :: k). Proxy t
Proxy @prt) POpts
opts a
a
case Inline
-> POpts
-> String
-> TT String
-> [Tree PE]
-> Either (TT (PP p a)) String
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
"MsgI" TT String
pp [] of
Left TT (PP p a)
e -> TT (PP p a) -> m (TT (PP p a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP p a)
e
Right String
msg -> String -> TT (PP p a) -> TT (PP p a)
forall a. String -> TT a -> TT a
prefixMsg String
msg (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
<$> 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
data Hide p deriving Int -> Hide p -> ShowS
[Hide p] -> ShowS
Hide p -> String
(Int -> Hide p -> ShowS)
-> (Hide p -> String) -> ([Hide p] -> ShowS) -> Show (Hide p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> Hide p -> ShowS
forall k (p :: k). [Hide p] -> ShowS
forall k (p :: k). Hide p -> String
showList :: [Hide p] -> ShowS
$cshowList :: forall k (p :: k). [Hide p] -> ShowS
show :: Hide p -> String
$cshow :: forall k (p :: k). Hide p -> String
showsPrec :: Int -> Hide p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> Hide p -> ShowS
Show
instance P p x => P (Hide p) x where
type PP (Hide p) x = PP p x
eval :: proxy (Hide p) -> POpts -> x -> m (TT (PP (Hide p) x))
eval proxy (Hide p)
_ POpts
opts x
x = do
TT (PP p x)
tt <- 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
TT (PP p x) -> m (TT (PP p x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p x) -> m (TT (PP p x))) -> TT (PP p x) -> m (TT (PP p x))
forall a b. (a -> b) -> a -> b
$ TT (PP p x)
tt TT (PP p x) -> (TT (PP p x) -> TT (PP p x)) -> TT (PP p x)
forall a b. a -> (a -> b) -> b
& ([Tree PE] -> Identity [Tree PE])
-> TT (PP p x) -> Identity (TT (PP p x))
forall a. Lens' (TT a) [Tree PE]
ttForest (([Tree PE] -> Identity [Tree PE])
-> TT (PP p x) -> Identity (TT (PP p x)))
-> [Tree PE] -> TT (PP p x) -> TT (PP p x)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ []
data Hole (t :: Type) deriving Int -> Hole t -> ShowS
[Hole t] -> ShowS
Hole t -> String
(Int -> Hole t -> ShowS)
-> (Hole t -> String) -> ([Hole t] -> ShowS) -> Show (Hole t)
forall t. Int -> Hole t -> ShowS
forall t. [Hole t] -> ShowS
forall t. Hole t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Hole t] -> ShowS
$cshowList :: forall t. [Hole t] -> ShowS
show :: Hole t -> String
$cshow :: forall t. Hole t -> String
showsPrec :: Int -> Hole t -> ShowS
$cshowsPrec :: forall t. Int -> Hole t -> ShowS
Show
instance Typeable t => P (Hole t) a where
type PP (Hole t) a = t
eval :: proxy (Hole t) -> POpts -> a -> m (TT (PP (Hole t) a))
eval proxy (Hole t)
_ POpts
opts a
_ =
let msg0 :: String
msg0 = String
"Hole(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Typeable t => String
forall t. Typeable t => String
showT @t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
in TT t -> m (TT t)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT t -> m (TT t)) -> TT t -> m (TT t)
forall a b. (a -> b) -> a -> b
$ POpts -> Val t -> String -> [Tree PE] -> TT t
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val t
forall a. String -> Val a
Fail String
msg0) String
"you probably meant to get access to the type of PP only and not evaluate" []
data Width (n :: Nat) p deriving Int -> Width n p -> ShowS
[Width n p] -> ShowS
Width n p -> String
(Int -> Width n p -> ShowS)
-> (Width n p -> String)
-> ([Width n p] -> ShowS)
-> Show (Width n p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: Nat) k (p :: k). Int -> Width n p -> ShowS
forall (n :: Nat) k (p :: k). [Width n p] -> ShowS
forall (n :: Nat) k (p :: k). Width n p -> String
showList :: [Width n p] -> ShowS
$cshowList :: forall (n :: Nat) k (p :: k). [Width n p] -> ShowS
show :: Width n p -> String
$cshow :: forall (n :: Nat) k (p :: k). Width n p -> String
showsPrec :: Int -> Width n p -> ShowS
$cshowsPrec :: forall (n :: Nat) k (p :: k). Int -> Width n p -> ShowS
Show
instance ( KnownNat n
, P p a
) => P (Width n p) a where
type PP (Width n p) a = PP p a
eval :: proxy (Width n p) -> POpts -> a -> m (TT (PP (Width n p) a))
eval proxy (Width n p)
_ POpts
opts a
a = do
let opts' :: POpts
opts' = POpts
opts { oWidth :: HKD Identity Int
oWidth = forall a. (KnownNat n, Num a) => a
forall (n :: Nat) a. (KnownNat n, Num a) => a
nat @n }
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
instance P () a where
type PP () a = ()
eval :: proxy () -> POpts -> a -> m (TT (PP () a))
eval proxy ()
_ POpts
opts a
_ =
let msg0 :: String
msg0 = String
"()"
in TT () -> m (TT ())
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT () -> m (TT ())) -> TT () -> m (TT ())
forall a b. (a -> b) -> a -> b
$ POpts -> Val () -> String -> [Tree PE] -> TT ()
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (() -> Val ()
forall a. a -> Val a
Val ()) String
msg0 []
instance P [] a where
type PP [] a = [a]
eval :: proxy [] -> POpts -> a -> m (TT (PP [] a))
eval proxy []
_ POpts
opts a
_ =
let msg0 :: String
msg0 = String
"[]"
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 []) String
msg0 []
instance P (Proxy t) a where
type PP (Proxy t) a = Proxy t
eval :: proxy (Proxy t) -> POpts -> a -> m (TT (PP (Proxy t) a))
eval proxy (Proxy t)
_ POpts
opts a
_ =
let msg0 :: String
msg0 = String
"Proxy"
in TT (Proxy t) -> m (TT (Proxy t))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Proxy t) -> m (TT (Proxy t)))
-> TT (Proxy t) -> m (TT (Proxy t))
forall a b. (a -> b) -> a -> b
$ POpts -> Val (Proxy t) -> String -> [Tree PE] -> TT (Proxy t)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Proxy t -> Val (Proxy t)
forall a. a -> Val a
Val Proxy t
forall k (t :: k). Proxy t
Proxy) String
msg0 []
instance GetBool b => P (b :: Bool) a where
type PP b a = Bool
eval :: proxy b -> POpts -> a -> m (TT (PP b a))
eval proxy b
_ POpts
opts a
_ =
let b :: Bool
b = GetBool b => Bool
forall (a :: Bool). GetBool a => Bool
getBool @b
in TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Bool -> m (TT Bool)) -> TT Bool -> m (TT Bool)
forall a b. (a -> b) -> a -> b
$ POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts Bool
b (String
"'" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Bool -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Bool
b) []
instance KnownSymbol s => P (s :: Symbol) a where
type PP s a = String
eval :: proxy s -> POpts -> a -> m (TT (PP s a))
eval proxy s
_ POpts
opts a
_ =
let s :: String
s = KnownSymbol s => String
forall (s :: Symbol). KnownSymbol s => String
symb @s
in TT String -> m (TT String)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT String -> m (TT String)) -> TT String -> m (TT String)
forall a b. (a -> b) -> a -> b
$ POpts -> Val String -> String -> [Tree PE] -> TT String
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val String
forall a. a -> Val a
Val String
s) (String
"'" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> ShowS
litL POpts
opts (String
"\"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\"")) []
instance ( P p a
, P q a
, Show (PP p a)
, Show (PP q a)
) => P '(p,q) a where
type PP '(p,q) a = (PP p a, PP q a)
eval :: proxy '(p, q) -> POpts -> a -> m (TT (PP '(p, q) a))
eval proxy '(p, q)
_ POpts
opts a
a = do
let msg :: String
msg = String
"'(,)"
Either
(TT (PP p a, PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (PP p a, PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k k (p :: k) a (q :: k) (m :: Type -> Type)
(proxy1 :: k -> Type) (proxy2 :: k -> 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
msg (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 (PP p a, PP q a) -> m (TT (PP p a, PP q a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p a, PP q a) -> m (TT (PP p a, PP q a)))
-> TT (PP p a, PP q a) -> m (TT (PP p a, PP q a))
forall a b. (a -> b) -> a -> b
$ case Either
(TT (PP p a, PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a))
lr of
Left TT (PP p a, PP q a)
e -> TT (PP p a, PP q a)
e
Right (PP p a
p,PP q a
q,TT (PP p a)
pp,TT (PP q a)
qq) ->
POpts
-> Val (PP p a, PP q a)
-> String
-> [Tree PE]
-> TT (PP p a, PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ((PP p a, PP q a) -> Val (PP p a, PP q a)
forall a. a -> Val a
Val (PP p a
p,PP q a
q)) (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 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"," String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")") [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
instance ( P p a
, P q a
, P r a
) => P '(p,q,r) a where
type PP '(p,q,r) a = (PP p a, PP q a, PP r a)
eval :: proxy '(p, q, r) -> POpts -> a -> m (TT (PP '(p, q, r) a))
eval proxy '(p, q, r)
_ POpts
opts a
a = do
let msg :: String
msg = String
"'(,,)"
Either
(TT (PP p a, PP q a, PP r a))
(PP p a, PP q a, TT (PP p a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (PP p a, PP q a, PP r a))
(PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k k (p :: k) a (q :: k) (m :: Type -> Type)
(proxy1 :: k -> Type) (proxy2 :: k -> 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
msg (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
case Either
(TT (PP p a, PP q a, PP r a))
(PP p a, PP q a, TT (PP p a), TT (PP q a))
lr of
Left TT (PP p a, PP q a, PP r a)
e -> TT (PP p a, PP q a, PP r a) -> m (TT (PP p a, PP q a, PP r a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP p a, PP q a, PP r a)
e
Right (PP p a
p,PP q a
q,TT (PP p a)
pp,TT (PP q a)
qq) -> do
let hhs0 :: [Tree PE]
hhs0 = [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
TT (PP r a)
rr <- Proxy r -> POpts -> a -> m (TT (PP r 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 r
forall k (t :: k). Proxy t
Proxy @r) POpts
opts a
a
TT (PP p a, PP q a, PP r a) -> m (TT (PP p a, PP q a, PP r a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p a, PP q a, PP r a) -> m (TT (PP p a, PP q a, PP r a)))
-> TT (PP p a, PP q a, PP r a) -> m (TT (PP p a, PP q a, PP r a))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP r a)
-> [Tree PE]
-> Either (TT (PP p a, PP q a, PP r a)) (PP r a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg TT (PP r a)
rr [Tree PE]
hhs0 of
Left TT (PP p a, PP q a, PP r a)
e -> TT (PP p a, PP q a, PP r a)
e
Right PP r a
r ->
let hhs1 :: [Tree PE]
hhs1 = [Tree PE]
hhs0 [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. Semigroup a => a -> a -> a
<> [TT (PP r a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP r a)
rr]
in POpts
-> Val (PP p a, PP q a, PP r a)
-> String
-> [Tree PE]
-> TT (PP p a, PP q a, PP r a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ((PP p a, PP q a, PP r a) -> Val (PP p a, PP q a, PP r a)
forall a. a -> Val a
Val (PP p a
p,PP q a
q,PP r a
r)) String
msg [Tree PE]
hhs1
instance ( P p a
, P q a
, P r a
, P s a
) => P '(p,q,r,s) a where
type PP '(p,q,r,s) a = (PP p a, PP q a, PP r a, PP s a)
eval :: proxy '(p, q, r, s) -> POpts -> a -> m (TT (PP '(p, q, r, s) a))
eval proxy '(p, q, r, s)
_ POpts
opts a
a = do
let msg :: String
msg = String
"'(,,,)"
Either
(TT (PP p a, PP q a, PP r a, PP s a))
(PP p a, PP q a, TT (PP p a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (PP p a, PP q a, PP r a, PP s a))
(PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k k (p :: k) a (q :: k) (m :: Type -> Type)
(proxy1 :: k -> Type) (proxy2 :: k -> 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
msg (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
case Either
(TT (PP p a, PP q a, PP r a, PP s a))
(PP p a, PP q a, TT (PP p a), TT (PP q a))
lr of
Left TT (PP p a, PP q a, PP r a, PP s a)
e -> TT (PP p a, PP q a, PP r a, PP s a)
-> m (TT (PP p a, PP q a, PP r a, PP s a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP p a, PP q a, PP r a, PP s a)
e
Right (PP p a
p,PP q a
q,TT (PP p a)
pp,TT (PP q a)
qq) -> do
let hhs0 :: [Tree PE]
hhs0 = [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
Either
(TT (PP p a, PP q a, PP r a, PP s a))
(PP r a, PP s a, TT (PP r a), TT (PP s a))
lr1 <- Inline
-> String
-> Proxy r
-> Proxy s
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (PP p a, PP q a, PP r a, PP s a))
(PP r a, PP s a, TT (PP r a), TT (PP s a)))
forall k k (p :: k) a (q :: k) (m :: Type -> Type)
(proxy1 :: k -> Type) (proxy2 :: k -> 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
msg (Proxy r
forall k (t :: k). Proxy t
Proxy @r) (Proxy s
forall k (t :: k). Proxy t
Proxy @s) POpts
opts a
a [Tree PE]
hhs0
TT (PP p a, PP q a, PP r a, PP s a)
-> m (TT (PP p a, PP q a, PP r a, PP s a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p a, PP q a, PP r a, PP s a)
-> m (TT (PP p a, PP q a, PP r a, PP s a)))
-> TT (PP p a, PP q a, PP r a, PP s a)
-> m (TT (PP p a, PP q a, PP r a, PP s a))
forall a b. (a -> b) -> a -> b
$ case Either
(TT (PP p a, PP q a, PP r a, PP s a))
(PP r a, PP s a, TT (PP r a), TT (PP s a))
lr1 of
Left TT (PP p a, PP q a, PP r a, PP s a)
e -> TT (PP p a, PP q a, PP r a, PP s a)
e
Right (PP r a
r,PP s a
s,TT (PP r a)
rr,TT (PP s a)
ss) ->
let hhs1 :: [Tree PE]
hhs1 = [Tree PE]
hhs0 [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. [a] -> [a] -> [a]
++ [TT (PP r a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP r a)
rr, TT (PP s a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP s a)
ss]
in POpts
-> Val (PP p a, PP q a, PP r a, PP s a)
-> String
-> [Tree PE]
-> TT (PP p a, PP q a, PP r a, PP s a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ((PP p a, PP q a, PP r a, PP s a)
-> Val (PP p a, PP q a, PP r a, PP s a)
forall a. a -> Val a
Val (PP p a
p,PP q a
q,PP r a
r,PP s a
s)) String
msg [Tree PE]
hhs1
instance ( P p a
, P q a
, P r a
, P s a
, P t a
) => P '(p,q,r,s,t) a where
type PP '(p,q,r,s,t) a = (PP p a, PP q a, PP r a, PP s a, PP t a)
eval :: proxy '(p, q, r, s, t)
-> POpts -> a -> m (TT (PP '(p, q, r, s, t) a))
eval proxy '(p, q, r, s, t)
_ POpts
opts a
a = do
let msg :: String
msg = String
"'(,,,,)"
Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a))
(PP p a, PP q a, TT (PP p a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a))
(PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k k (p :: k) a (q :: k) (m :: Type -> Type)
(proxy1 :: k -> Type) (proxy2 :: k -> 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
msg (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
case Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a))
(PP p a, PP q a, TT (PP p a), TT (PP q a))
lr of
Left TT (PP p a, PP q a, PP r a, PP s a, PP t a)
e -> TT (PP p a, PP q a, PP r a, PP s a, PP t a)
-> m (TT (PP p a, PP q a, PP r a, PP s a, PP t a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP p a, PP q a, PP r a, PP s a, PP t a)
e
Right (PP p a
p,PP q a
q,TT (PP p a)
pp,TT (PP q a)
qq) -> do
let hhs0 :: [Tree PE]
hhs0 = [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a))
(PP r a, PP s a, TT (PP r a), TT (PP s a))
lr1 <- Inline
-> String
-> Proxy r
-> Proxy s
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a))
(PP r a, PP s a, TT (PP r a), TT (PP s a)))
forall k k (p :: k) a (q :: k) (m :: Type -> Type)
(proxy1 :: k -> Type) (proxy2 :: k -> 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
msg (Proxy r
forall k (t :: k). Proxy t
Proxy @r) (Proxy s
forall k (t :: k). Proxy t
Proxy @s) POpts
opts a
a [Tree PE]
hhs0
case Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a))
(PP r a, PP s a, TT (PP r a), TT (PP s a))
lr1 of
Left TT (PP p a, PP q a, PP r a, PP s a, PP t a)
e -> TT (PP p a, PP q a, PP r a, PP s a, PP t a)
-> m (TT (PP p a, PP q a, PP r a, PP s a, PP t a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP p a, PP q a, PP r a, PP s a, PP t a)
e
Right (PP r a
r,PP s a
s,TT (PP r a)
rr,TT (PP s a)
ss) -> do
let hhs1 :: [Tree PE]
hhs1 = [Tree PE]
hhs0 [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. [a] -> [a] -> [a]
++ [TT (PP r a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP r a)
rr, TT (PP s a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP s a)
ss]
TT (PP t a)
tt <- Proxy t -> POpts -> a -> m (TT (PP t 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 t
forall k (t :: k). Proxy t
Proxy @t) POpts
opts a
a
TT (PP p a, PP q a, PP r a, PP s a, PP t a)
-> m (TT (PP p a, PP q a, PP r a, PP s a, PP t a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p a, PP q a, PP r a, PP s a, PP t a)
-> m (TT (PP p a, PP q a, PP r a, PP s a, PP t a)))
-> TT (PP p a, PP q a, PP r a, PP s a, PP t a)
-> m (TT (PP p a, PP q a, PP r a, PP s a, PP t a))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP t a)
-> [Tree PE]
-> Either (TT (PP p a, PP q a, PP r a, PP s a, PP t a)) (PP t a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg TT (PP t a)
tt [Tree PE]
hhs1 of
Left TT (PP p a, PP q a, PP r a, PP s a, PP t a)
e -> TT (PP p a, PP q a, PP r a, PP s a, PP t a)
e
Right PP t a
t ->
let hhs2 :: [Tree PE]
hhs2 = [Tree PE]
hhs1 [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. Semigroup a => a -> a -> a
<> [TT (PP t a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP t a)
tt]
in POpts
-> Val (PP p a, PP q a, PP r a, PP s a, PP t a)
-> String
-> [Tree PE]
-> TT (PP p a, PP q a, PP r a, PP s a, PP t a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ((PP p a, PP q a, PP r a, PP s a, PP t a)
-> Val (PP p a, PP q a, PP r a, PP s a, PP t a)
forall a. a -> Val a
Val (PP p a
p,PP q a
q,PP r a
r,PP s a
s,PP t a
t)) String
msg [Tree PE]
hhs2
instance ( P p a
, P q a
, P r a
, P s a
, P t a
, P u a
) => P '(p,q,r,s,t,u) a where
type PP '(p,q,r,s,t,u) a = (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a)
eval :: proxy '(p, q, r, s, t, u)
-> POpts -> a -> m (TT (PP '(p, q, r, s, t, u) a))
eval proxy '(p, q, r, s, t, u)
_ POpts
opts a
a = do
let msg :: String
msg = String
"'(,,,,,)"
Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a))
(PP p a, PP q a, TT (PP p a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a))
(PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k k (p :: k) a (q :: k) (m :: Type -> Type)
(proxy1 :: k -> Type) (proxy2 :: k -> 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
msg (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
case Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a))
(PP p a, PP q a, TT (PP p a), TT (PP q a))
lr of
Left TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a)
e -> TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a)
-> m (TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a)
e
Right (PP p a
p,PP q a
q,TT (PP p a)
pp,TT (PP q a)
qq) -> do
let hhs0 :: [Tree PE]
hhs0 = [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a))
(PP r a, PP s a, TT (PP r a), TT (PP s a))
lr1 <- Inline
-> String
-> Proxy r
-> Proxy s
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a))
(PP r a, PP s a, TT (PP r a), TT (PP s a)))
forall k k (p :: k) a (q :: k) (m :: Type -> Type)
(proxy1 :: k -> Type) (proxy2 :: k -> 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
msg (Proxy r
forall k (t :: k). Proxy t
Proxy @r) (Proxy s
forall k (t :: k). Proxy t
Proxy @s) POpts
opts a
a [Tree PE]
hhs0
case Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a))
(PP r a, PP s a, TT (PP r a), TT (PP s a))
lr1 of
Left TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a)
e -> TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a)
-> m (TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a)
e
Right (PP r a
r,PP s a
s,TT (PP r a)
rr,TT (PP s a)
ss) -> do
let hhs1 :: [Tree PE]
hhs1 = [Tree PE]
hhs0 [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. [a] -> [a] -> [a]
++ [TT (PP r a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP r a)
rr, TT (PP s a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP s a)
ss]
Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a))
(PP t a, PP u a, TT (PP t a), TT (PP u a))
lr2 <- Inline
-> String
-> Proxy t
-> Proxy u
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a))
(PP t a, PP u a, TT (PP t a), TT (PP u a)))
forall k k (p :: k) a (q :: k) (m :: Type -> Type)
(proxy1 :: k -> Type) (proxy2 :: k -> 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
msg (Proxy t
forall k (t :: k). Proxy t
Proxy @t) (Proxy u
forall k (t :: k). Proxy t
Proxy @u) POpts
opts a
a [Tree PE]
hhs1
TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a)
-> m (TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a)
-> m (TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a)))
-> TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a)
-> m (TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a))
forall a b. (a -> b) -> a -> b
$ case Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a))
(PP t a, PP u a, TT (PP t a), TT (PP u a))
lr2 of
Left TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a)
e -> TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a)
e
Right (PP t a
t,PP u a
u,TT (PP t a)
tt,TT (PP u a)
uu) ->
let hhs2 :: [Tree PE]
hhs2 = [Tree PE]
hhs1 [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. [a] -> [a] -> [a]
++ [TT (PP t a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP t a)
tt, TT (PP u a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP u a)
uu]
in POpts
-> Val (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a)
-> String
-> [Tree PE]
-> TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ((PP p a, PP q a, PP r a, PP s a, PP t a, PP u a)
-> Val (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a)
forall a. a -> Val a
Val (PP p a
p,PP q a
q,PP r a
r,PP s a
s,PP t a
t,PP u a
u)) String
msg [Tree PE]
hhs2
instance ( P p a
, P q a
, P r a
, P s a
, P t a
, P u a
, P v a
) => P '(p,q,r,s,t,u,v) a where
type PP '(p,q,r,s,t,u,v) a = (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a)
eval :: proxy '(p, q, r, s, t, u, v)
-> POpts -> a -> m (TT (PP '(p, q, r, s, t, u, v) a))
eval proxy '(p, q, r, s, t, u, v)
_ POpts
opts a
a = do
let msg :: String
msg = String
"'(,,,,,,)"
Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a))
(PP p a, PP q a, TT (PP p a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a))
(PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k k (p :: k) a (q :: k) (m :: Type -> Type)
(proxy1 :: k -> Type) (proxy2 :: k -> 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
msg (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
case Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a))
(PP p a, PP q a, TT (PP p a), TT (PP q a))
lr of
Left TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a)
e -> TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a)
-> m (TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a)
e
Right (PP p a
p,PP q a
q,TT (PP p a)
pp,TT (PP q a)
qq) -> do
let hhs0 :: [Tree PE]
hhs0 = [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a))
(PP r a, PP s a, TT (PP r a), TT (PP s a))
lr1 <- Inline
-> String
-> Proxy r
-> Proxy s
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a))
(PP r a, PP s a, TT (PP r a), TT (PP s a)))
forall k k (p :: k) a (q :: k) (m :: Type -> Type)
(proxy1 :: k -> Type) (proxy2 :: k -> 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
msg (Proxy r
forall k (t :: k). Proxy t
Proxy @r) (Proxy s
forall k (t :: k). Proxy t
Proxy @s) POpts
opts a
a [Tree PE]
hhs0
case Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a))
(PP r a, PP s a, TT (PP r a), TT (PP s a))
lr1 of
Left TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a)
e -> TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a)
-> m (TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a)
e
Right (PP r a
r,PP s a
s,TT (PP r a)
rr,TT (PP s a)
ss) -> do
let hhs1 :: [Tree PE]
hhs1 = [Tree PE]
hhs0 [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. [a] -> [a] -> [a]
++ [TT (PP r a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP r a)
rr, TT (PP s a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP s a)
ss]
Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a))
(PP t a, PP u a, TT (PP t a), TT (PP u a))
lr2 <- Inline
-> String
-> Proxy t
-> Proxy u
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a))
(PP t a, PP u a, TT (PP t a), TT (PP u a)))
forall k k (p :: k) a (q :: k) (m :: Type -> Type)
(proxy1 :: k -> Type) (proxy2 :: k -> 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
msg (Proxy t
forall k (t :: k). Proxy t
Proxy @t) (Proxy u
forall k (t :: k). Proxy t
Proxy @u) POpts
opts a
a [Tree PE]
hhs1
case Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a))
(PP t a, PP u a, TT (PP t a), TT (PP u a))
lr2 of
Left TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a)
e -> TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a)
-> m (TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a)
e
Right (PP t a
t,PP u a
u,TT (PP t a)
tt,TT (PP u a)
uu) -> do
TT (PP v a)
vv <- Proxy v -> POpts -> a -> m (TT (PP v 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 v
forall k (t :: k). Proxy t
Proxy @v) POpts
opts a
a
let hhs2 :: [Tree PE]
hhs2 = [Tree PE]
hhs1 [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. [a] -> [a] -> [a]
++ [TT (PP t a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP t a)
tt, TT (PP u a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP u a)
uu]
TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a)
-> m (TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a)
-> m (TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a)))
-> TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a)
-> m (TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP v a)
-> [Tree PE]
-> Either
(TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a))
(PP v a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg TT (PP v a)
vv [Tree PE]
hhs2 of
Left TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a)
e -> TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a)
e
Right PP v a
v ->
let hhs3 :: [Tree PE]
hhs3 = [Tree PE]
hhs2 [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. [a] -> [a] -> [a]
++ [TT (PP v a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP v a)
vv]
in POpts
-> Val (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a)
-> String
-> [Tree PE]
-> TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ((PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a)
-> Val (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a)
forall a. a -> Val a
Val (PP p a
p,PP q a
q,PP r a
r,PP s a
s,PP t a
t,PP u a
u,PP v a
v)) String
msg [Tree PE]
hhs3
instance ( P p a
, P q a
, P r a
, P s a
, P t a
, P u a
, P v a
, P w a
) => P '(p,q,r,s,t,u,v,w) a where
type PP '(p,q,r,s,t,u,v,w) a = (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a)
eval :: proxy '(p, q, r, s, t, u, v, w)
-> POpts -> a -> m (TT (PP '(p, q, r, s, t, u, v, w) a))
eval proxy '(p, q, r, s, t, u, v, w)
_ POpts
opts a
a = do
let msg :: String
msg = String
"'(,,,,,,,)"
Either
(TT
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a))
(PP p a, PP q a, TT (PP p a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a))
(PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k k (p :: k) a (q :: k) (m :: Type -> Type)
(proxy1 :: k -> Type) (proxy2 :: k -> 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
msg (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
case Either
(TT
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a))
(PP p a, PP q a, TT (PP p a), TT (PP q a))
lr of
Left TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a)
e -> TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a)
-> m (TT
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a)
e
Right (PP p a
p,PP q a
q,TT (PP p a)
pp,TT (PP q a)
qq) -> do
let hhs0 :: [Tree PE]
hhs0 = [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
Either
(TT
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a))
(PP r a, PP s a, TT (PP r a), TT (PP s a))
lr1 <- Inline
-> String
-> Proxy r
-> Proxy s
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a))
(PP r a, PP s a, TT (PP r a), TT (PP s a)))
forall k k (p :: k) a (q :: k) (m :: Type -> Type)
(proxy1 :: k -> Type) (proxy2 :: k -> 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
msg (Proxy r
forall k (t :: k). Proxy t
Proxy @r) (Proxy s
forall k (t :: k). Proxy t
Proxy @s) POpts
opts a
a [Tree PE]
hhs0
case Either
(TT
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a))
(PP r a, PP s a, TT (PP r a), TT (PP s a))
lr1 of
Left TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a)
e -> TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a)
-> m (TT
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a)
e
Right (PP r a
r,PP s a
s,TT (PP r a)
rr,TT (PP s a)
ss) -> do
let hhs1 :: [Tree PE]
hhs1 = [Tree PE]
hhs0 [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. [a] -> [a] -> [a]
++ [TT (PP r a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP r a)
rr, TT (PP s a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP s a)
ss]
Either
(TT
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a))
(PP t a, PP u a, TT (PP t a), TT (PP u a))
lr2 <- Inline
-> String
-> Proxy t
-> Proxy u
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a))
(PP t a, PP u a, TT (PP t a), TT (PP u a)))
forall k k (p :: k) a (q :: k) (m :: Type -> Type)
(proxy1 :: k -> Type) (proxy2 :: k -> 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
msg (Proxy t
forall k (t :: k). Proxy t
Proxy @t) (Proxy u
forall k (t :: k). Proxy t
Proxy @u) POpts
opts a
a [Tree PE]
hhs1
case Either
(TT
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a))
(PP t a, PP u a, TT (PP t a), TT (PP u a))
lr2 of
Left TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a)
e -> TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a)
-> m (TT
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a)
e
Right (PP t a
t,PP u a
u,TT (PP t a)
tt,TT (PP u a)
uu) -> do
let hhs2 :: [Tree PE]
hhs2 = [Tree PE]
hhs1 [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. [a] -> [a] -> [a]
++ [TT (PP t a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP t a)
tt, TT (PP u a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP u a)
uu]
Either
(TT
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a))
(PP v a, PP w a, TT (PP v a), TT (PP w a))
lr3 <- Inline
-> String
-> Proxy v
-> Proxy w
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a))
(PP v a, PP w a, TT (PP v a), TT (PP w a)))
forall k k (p :: k) a (q :: k) (m :: Type -> Type)
(proxy1 :: k -> Type) (proxy2 :: k -> 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
msg (Proxy v
forall k (t :: k). Proxy t
Proxy @v) (Proxy w
forall k (t :: k). Proxy t
Proxy @w) POpts
opts a
a [Tree PE]
hhs2
TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a)
-> m (TT
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a)
-> m (TT
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a)))
-> TT
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a)
-> m (TT
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a))
forall a b. (a -> b) -> a -> b
$ case Either
(TT
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a))
(PP v a, PP w a, TT (PP v a), TT (PP w a))
lr3 of
Left TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a)
e -> TT (PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a)
e
Right (PP v a
v,PP w a
w,TT (PP v a)
vv,TT (PP w a)
ww) ->
let hhs3 :: [Tree PE]
hhs3 = [Tree PE]
hhs2 [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. [a] -> [a] -> [a]
++ [TT (PP v a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP v a)
vv, TT (PP w a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP w a)
ww]
in POpts
-> Val
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a)
-> String
-> [Tree PE]
-> TT
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ((PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a)
-> Val
(PP p a, PP q a, PP r a, PP s a, PP t a, PP u a, PP v a, PP w a)
forall a. a -> Val a
Val (PP p a
p,PP q a
q,PP r a
r,PP s a
s,PP t a
t,PP u a
u,PP v a
v,PP w a
w)) String
msg [Tree PE]
hhs3
instance GetOrdering cmp => P (cmp :: Ordering) a where
type PP cmp a = Ordering
eval :: proxy cmp -> POpts -> a -> m (TT (PP cmp a))
eval proxy cmp
_ POpts
opts a
_ =
let cmp :: Ordering
cmp = GetOrdering cmp => Ordering
forall (cmp :: Ordering). GetOrdering cmp => Ordering
getOrdering @cmp
msg :: String
msg = String
"'" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Ordering -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Ordering
cmp
in TT Ordering -> m (TT Ordering)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Ordering -> m (TT Ordering)) -> TT Ordering -> m (TT Ordering)
forall a b. (a -> b) -> a -> b
$ POpts -> Val Ordering -> String -> [Tree PE] -> TT Ordering
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Ordering -> Val Ordering
forall a. a -> Val a
Val Ordering
cmp) String
msg []
instance KnownNat n => P (n :: Nat) a where
type PP n a = Int
eval :: proxy n -> POpts -> a -> m (TT (PP n a))
eval proxy n
_ POpts
opts a
_ =
let n :: Int
n = forall a. (KnownNat n, Num a) => a
forall (n :: Nat) a. (KnownNat n, Num a) => a
nat @n
in TT Int -> m (TT Int)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Int -> m (TT Int)) -> TT Int -> m (TT Int)
forall a b. (a -> b) -> a -> b
$ POpts -> Val Int -> String -> [Tree PE] -> TT Int
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Int -> Val Int
forall a. a -> Val a
Val Int
n) (String
"'" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Int -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Int
n) []
instance P '() a where
type PP '() a = ()
eval :: proxy '() -> POpts -> a -> m (TT (PP '() a))
eval proxy '()
_ POpts
opts a
_ = TT () -> m (TT ())
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT () -> m (TT ())) -> TT () -> m (TT ())
forall a b. (a -> b) -> a -> b
$ POpts -> Val () -> String -> [Tree PE] -> TT ()
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (() -> Val ()
forall a. a -> Val a
Val ()) String
"'()" []
instance P ('[] :: [k]) a where
type PP ('[] :: [k]) a = [a]
eval :: proxy '[] -> POpts -> a -> m (TT (PP '[] a))
eval proxy '[]
_ POpts
opts 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
$ 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]
forall a. Monoid a => a
mempty) String
"'[]" []
instance ( Show (PP p a)
, Show a
, P p a
) => P '[p] a where
type PP '[p] a = [PP p a]
eval :: proxy '[p] -> POpts -> a -> m (TT (PP '[p] a))
eval proxy '[p]
_ POpts
opts a
a = do
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
let msg0 :: String
msg0 = String
""
TT [PP p a] -> m (TT [PP p a])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [PP p a] -> m (TT [PP p a])) -> TT [PP p a] -> m (TT [PP p a])
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p a)
-> [Tree PE]
-> Either (TT [PP p 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 [PP p a]
e -> TT [PP p a]
e
Right PP p a
b -> POpts -> Val [PP p a] -> String -> [Tree PE] -> TT [PP p a]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([PP p a] -> Val [PP p a]
forall a. a -> Val a
Val [PP p a
b]) (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
b] :: [PP p a]) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> a -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " a
a) [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp]
instance ( Show (PP p a)
, Show a
, P (p1 ': ps) a
, PP (p1 ': ps) a ~ [PP p1 a]
, P p a
, PP p a ~ PP p1 a
) => P (p ': p1 ': ps) a where
type PP (p ': p1 ': ps) a = [PP p a]
eval :: proxy (p : p1 : ps) -> POpts -> a -> m (TT (PP (p : p1 : ps) a))
eval proxy (p : p1 : ps)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"'(p':q)"
TT (PP p1 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
case Inline
-> POpts
-> String
-> TT (PP p1 a)
-> [Tree PE]
-> Either (TT [PP p1 a]) (PP p1 a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP p1 a)
pp [] of
Left TT [PP p1 a]
e -> TT [PP p1 a] -> m (TT [PP p1 a])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT [PP p1 a]
e
Right PP p1 a
p -> do
TT [PP p1 a]
qq <- Proxy (p1 : ps) -> POpts -> a -> m (TT (PP (p1 : ps) 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 (p1 : ps)
forall k (t :: k). Proxy t
Proxy @(p1 ': ps)) POpts
opts a
a
TT [PP p1 a] -> m (TT [PP p1 a])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [PP p1 a] -> m (TT [PP p1 a]))
-> TT [PP p1 a] -> m (TT [PP p1 a])
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT [PP p1 a]
-> [Tree PE]
-> Either (TT [PP p1 a]) [PP p1 a]
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
Inline POpts
opts String
"" TT [PP p1 a]
qq [TT (PP p1 a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p1 a)
pp] of
Left TT [PP p1 a]
e -> TT [PP p1 a]
e
Right [PP p1 a]
q ->
let ret :: [PP p1 a]
ret = PP p1 a
pPP p1 a -> [PP p1 a] -> [PP p1 a]
forall a. a -> [a] -> [a]
:[PP p1 a]
q
in POpts -> Val [PP p1 a] -> String -> [Tree PE] -> TT [PP p1 a]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([PP p1 a] -> Val [PP p1 a]
forall a. a -> Val a
Val [PP p1 a]
ret) (String
"'" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> [PP p1 a] -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts [PP p1 a]
ret String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> ShowS
litVerbose POpts
opts String
" " (TT (PP p1 a) -> String
forall a. TT a -> String
topMessage TT (PP p1 a)
pp) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> a -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " a
a) (POpts -> TT (PP p1 a) -> [Tree PE]
forall a. POpts -> TT a -> [Tree PE]
verboseList POpts
opts TT (PP p1 a)
pp [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. Semigroup a => a -> a -> a
<> [TT [PP p1 a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [PP p1 a]
qq])
instance ( Show a
, PP p x ~ Maybe a
, P p x
) => P ('Just p) x where
type PP ('Just p) x = MaybeT (PP p x)
eval :: proxy ('Just p) -> POpts -> x -> m (TT (PP ('Just p) x))
eval proxy ('Just p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"'Just"
TT (Maybe a)
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
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 (Maybe a)
-> [Tree PE]
-> Either (TT a) (Maybe a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (Maybe a)
pp [] of
Left TT a
e -> TT a
e
Right Maybe a
p ->
case Maybe a
p of
Maybe a
Nothing -> POpts -> Val a -> String -> [Tree PE] -> TT a
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val a
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"(empty)")) String
"" [TT (Maybe a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Maybe a)
pp]
Just a
d -> 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 -> Maybe a -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 a
d Maybe a
p) [TT (Maybe a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Maybe a)
pp]
instance P 'Nothing (Maybe a) where
type PP 'Nothing (Maybe a) = Proxy a
eval :: proxy 'Nothing
-> POpts -> Maybe a -> m (TT (PP 'Nothing (Maybe a)))
eval proxy 'Nothing
_ POpts
opts Maybe a
ma =
let msg0 :: String
msg0 = String
"'Nothing"
in TT (Proxy a) -> m (TT (Proxy a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Proxy a) -> m (TT (Proxy a)))
-> TT (Proxy a) -> m (TT (Proxy a))
forall a b. (a -> b) -> a -> b
$ case Maybe a
ma of
Maybe a
Nothing -> POpts -> Val (Proxy a) -> String -> [Tree PE] -> TT (Proxy a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Proxy a -> Val (Proxy a)
forall a. a -> Val a
Val Proxy a
forall k (t :: k). Proxy t
Proxy) String
msg0 []
Just a
_ -> POpts -> Val (Proxy a) -> String -> [Tree PE] -> TT (Proxy a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (Proxy a)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found Just")) String
"" []
instance ( PP p x ~ Either a b
, P p x
)
=> P ('Left p) x where
type PP ('Left p) x = LeftT (PP p x)
eval :: proxy ('Left p) -> POpts -> x -> m (TT (PP ('Left p) x))
eval proxy ('Left p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"'Left"
TT (Either a b)
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
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 (Either a b)
-> [Tree PE]
-> Either (TT a) (Either a b)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (Either a b)
pp [] of
Left TT a
e -> TT a
e
Right Either a b
p ->
case Either a b
p of
Left a
a -> 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
"Left" [TT (Either a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Either a b)
pp]
Right b
_b -> POpts -> Val a -> String -> [Tree PE] -> TT a
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val a
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found Right")) String
"" [TT (Either a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Either a b)
pp]
instance ( PP p x ~ Either a b
, P p x
)
=> P ('Right p) x where
type PP ('Right p) x = RightT (PP p x)
eval :: proxy ('Right p) -> POpts -> x -> m (TT (PP ('Right p) x))
eval proxy ('Right p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"'Right"
TT (Either a b)
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
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 Inline
-> POpts
-> String
-> TT (Either a b)
-> [Tree PE]
-> Either (TT b) (Either a b)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (Either a b)
pp [] of
Left TT b
e -> TT b
e
Right Either a b
p ->
case Either a b
p of
Left a
_a -> POpts -> Val b -> String -> [Tree PE] -> TT b
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val b
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found Left")) String
"" [TT (Either a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Either a b)
pp]
Right b
b -> 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
b) String
"Right" [TT (Either a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Either a b)
pp]
instance ( PP p x ~ These a b
, P p x
)
=> P ('This p) x where
type PP ('This p) x = ThisT (PP p x)
eval :: proxy ('This p) -> POpts -> x -> m (TT (PP ('This p) x))
eval proxy ('This p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"'This"
TT (These a b)
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
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 (These a b)
-> [Tree PE]
-> Either (TT a) (These a b)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (These a b)
pp [] of
Left TT a
e -> TT a
e
Right These a b
p ->
case These a b
p of
This a
a -> 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
"This" [TT (These a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (These a b)
pp]
That b
_b -> POpts -> Val a -> String -> [Tree PE] -> TT a
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val a
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found That")) String
"" [TT (These a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (These a b)
pp]
These a
_a b
_b -> POpts -> Val a -> String -> [Tree PE] -> TT a
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val a
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found These")) String
"" [TT (These a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (These a b)
pp]
instance ( PP p x ~ These a b
, P p x
)
=> P ('That p) x where
type PP ('That p) x = ThatT (PP p x)
eval :: proxy ('That p) -> POpts -> x -> m (TT (PP ('That p) x))
eval proxy ('That p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"'That"
TT (These a b)
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
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 Inline
-> POpts
-> String
-> TT (These a b)
-> [Tree PE]
-> Either (TT b) (These a b)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (These a b)
pp [] of
Left TT b
e -> TT b
e
Right These a b
p ->
case These a b
p of
This a
_a -> POpts -> Val b -> String -> [Tree PE] -> TT b
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val b
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found This")) String
"" [TT (These a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (These a b)
pp]
That b
b -> 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
b) String
"That" [TT (These a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (These a b)
pp]
These a
_a b
_b -> POpts -> Val b -> String -> [Tree PE] -> TT b
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val b
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found These")) String
"" [TT (These a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (These a b)
pp]
instance ( Show a
, Show b
, P p a
, P q b
, Show (PP p a)
, Show (PP q b)
) => P ('These p q) (These a b) where
type PP ('These p q) (These a b) = (PP p a, PP q b)
eval :: proxy ('These p q)
-> POpts -> These a b -> m (TT (PP ('These p q) (These a b)))
eval proxy ('These p q)
_ POpts
opts These a b
th = do
let msg0 :: String
msg0 = String
"'These"
case These a b
th of
These a
a b
b -> do
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
case Inline
-> POpts
-> String
-> TT (PP p a)
-> [Tree PE]
-> Either (TT (PP p a, PP q b)) (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 (PP p a, PP q b)
e -> TT (PP p a, PP q b) -> m (TT (PP p a, PP q b))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP p a, PP q b)
e
Right PP p a
p -> do
TT (PP q b)
qq <- 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
forall k (t :: k). Proxy t
Proxy @q) POpts
opts b
b
TT (PP p a, PP q b) -> m (TT (PP p a, PP q b))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p a, PP q b) -> m (TT (PP p a, PP q b)))
-> TT (PP p a, PP q b) -> m (TT (PP p a, PP q b))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP q b)
-> [Tree PE]
-> Either (TT (PP p a, PP q b)) (PP q b)
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
" q failed p=" 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 q b)
qq [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp] of
Left TT (PP p a, PP q b)
e -> TT (PP p a, PP q b)
e
Right PP q b
q ->
let ret :: (PP p a, PP q b)
ret =(PP p a
p,PP q b
q)
in POpts
-> Val (PP p a, PP q b)
-> String
-> [Tree PE]
-> TT (PP p a, PP q b)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ((PP p a, PP q b) -> Val (PP p a, PP q b)
forall a. a -> Val a
Val (PP p a, PP q b)
ret) (POpts -> String -> (PP p a, PP q b) -> These a b -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 (PP p a, PP q b)
ret (a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
b)) [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp, TT (PP q b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q b)
qq]
These a b
_ -> TT (PP p a, PP q b) -> m (TT (PP p a, PP q b))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p a, PP q b) -> m (TT (PP p a, PP q b)))
-> TT (PP p a, PP q b) -> m (TT (PP p a, PP q b))
forall a b. (a -> b) -> a -> b
$ POpts
-> Val (PP p a, PP q b)
-> String
-> [Tree PE]
-> TT (PP p a, PP q b)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP p a, PP q b)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> These a b -> String
forall a b. These a b -> String
showThese These a b
th)) String
"" []
instance P 'Proxy t where
type PP 'Proxy t = Proxy t
eval :: proxy 'Proxy -> POpts -> t -> m (TT (PP 'Proxy t))
eval proxy 'Proxy
_ POpts
opts t
_ =
let b :: Proxy t
b = Proxy t
forall k (t :: k). Proxy t
Proxy @t
in TT (Proxy t) -> m (TT (Proxy t))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Proxy t) -> m (TT (Proxy t)))
-> TT (Proxy t) -> m (TT (Proxy t))
forall a b. (a -> b) -> a -> b
$ POpts -> Val (Proxy t) -> String -> [Tree PE] -> TT (Proxy t)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Proxy t -> Val (Proxy t)
forall a. a -> Val a
Val Proxy t
b) String
"'Proxy" []
pu, pl, pa, pan, panv, pab, pub, pav, puv, pz
:: forall p a
. ( Show (PP p a)
, P p a
) => a
-> IO (Val (PP p a))
pz :: a -> IO (Val (PP p a))
pz = forall a. (OptC OZ, Show (PP p a), P p a) => a -> IO (Val (PP p a))
forall k (opts :: Opt) (p :: k) a.
(OptC opts, Show (PP p a), P p a) =>
a -> IO (Val (PP p a))
run @OZ @p
pl :: a -> IO (Val (PP p a))
pl = forall a. (OptC OL, Show (PP p a), P p a) => a -> IO (Val (PP p a))
forall k (opts :: Opt) (p :: k) a.
(OptC opts, Show (PP p a), P p a) =>
a -> IO (Val (PP p a))
run @OL @p
pan :: a -> IO (Val (PP p a))
pan = forall a.
(OptC OAN, Show (PP p a), P p a) =>
a -> IO (Val (PP p a))
forall k (opts :: Opt) (p :: k) a.
(OptC opts, Show (PP p a), P p a) =>
a -> IO (Val (PP p a))
run @OAN @p
panv :: a -> IO (Val (PP p a))
panv = forall a.
(OptC OANV, Show (PP p a), P p a) =>
a -> IO (Val (PP p a))
forall k (opts :: Opt) (p :: k) a.
(OptC opts, Show (PP p a), P p a) =>
a -> IO (Val (PP p a))
run @OANV @p
pa :: a -> IO (Val (PP p a))
pa = forall a. (OptC OA, Show (PP p a), P p a) => a -> IO (Val (PP p a))
forall k (opts :: Opt) (p :: k) a.
(OptC opts, Show (PP p a), P p a) =>
a -> IO (Val (PP p a))
run @OA @p
pab :: a -> IO (Val (PP p a))
pab = forall a.
(OptC OAB, Show (PP p a), P p a) =>
a -> IO (Val (PP p a))
forall k (opts :: Opt) (p :: k) a.
(OptC opts, Show (PP p a), P p a) =>
a -> IO (Val (PP p a))
run @OAB @p
pav :: a -> IO (Val (PP p a))
pav = forall a.
(OptC OAV, Show (PP p a), P p a) =>
a -> IO (Val (PP p a))
forall k (opts :: Opt) (p :: k) a.
(OptC opts, Show (PP p a), P p a) =>
a -> IO (Val (PP p a))
run @OAV @p
pu :: a -> IO (Val (PP p a))
pu = forall a. (OptC OU, Show (PP p a), P p a) => a -> IO (Val (PP p a))
forall k (opts :: Opt) (p :: k) a.
(OptC opts, Show (PP p a), P p a) =>
a -> IO (Val (PP p a))
run @OU @p
pub :: a -> IO (Val (PP p a))
pub = forall a.
(OptC OUB, Show (PP p a), P p a) =>
a -> IO (Val (PP p a))
forall k (opts :: Opt) (p :: k) a.
(OptC opts, Show (PP p a), P p a) =>
a -> IO (Val (PP p a))
run @OUB @p
puv :: a -> IO (Val (PP p a))
puv = forall a.
(OptC OUV, Show (PP p a), P p a) =>
a -> IO (Val (PP p a))
forall k (opts :: Opt) (p :: k) a.
(OptC opts, Show (PP p a), P p a) =>
a -> IO (Val (PP p a))
run @OUV @p
run :: forall opts p a
. ( OptC opts
, Show (PP p a)
, P p a
)
=> a
-> IO (Val (PP p a))
run :: a -> IO (Val (PP p a))
run a
a = do
let opts :: POpts
opts = OptC opts => POpts
forall (o :: Opt). OptC o => POpts
getOpt @opts
TT (PP p a)
pp <- Proxy p -> POpts -> a -> IO (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
case POpts -> HKD Identity Debug
forall (f :: Type -> Type). HOpts f -> HKD f Debug
oDebug POpts
opts of
HKD Identity Debug
DZero -> () -> IO ()
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
HKD Identity Debug
_ -> String -> (String -> IO ()) -> IO ()
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Foldable t, Applicative m) =>
t a -> (t a -> m ()) -> m ()
unlessNullM (POpts -> TT (PP p a) -> String
forall x. Show x => POpts -> TT x -> String
prtTree POpts
opts TT (PP p a)
pp) String -> IO ()
putStrLn
Val (PP p a) -> IO (Val (PP p a))
forall (m :: Type -> Type) a. Monad m => a -> m a
return (TT (PP p a)
pp TT (PP p a)
-> Getting (Val (PP p a)) (TT (PP p a)) (Val (PP p a))
-> Val (PP p a)
forall s a. s -> Getting a s a -> a
^. Getting (Val (PP p a)) (TT (PP p a)) (Val (PP p a))
forall a b. Lens (TT a) (TT b) (Val a) (Val b)
ttVal)
runs :: forall optss p a
. ( OptC (OptT optss)
, Show (PP p a)
, P p a
)
=> a
-> IO (Val (PP p a))
runs :: a -> IO (Val (PP p a))
runs = forall a.
(OptC (OptT optss), Show (PP p a), P p a) =>
a -> IO (Val (PP p a))
forall k (opts :: Opt) (p :: k) a.
(OptC opts, Show (PP p a), P p a) =>
a -> IO (Val (PP p a))
run @(OptT optss) @p
runP :: ( P p a
, MonadEval m)
=> Inline
-> String
-> proxy p
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, TT (PP p a)))
runP :: Inline
-> String
-> proxy p
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, TT (PP p a)))
runP Inline
inline String
msg0 proxy p
proxyp POpts
opts a
a [Tree PE]
hhs = do
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
proxyp POpts
opts a
a
Either (TT x) (PP p a, TT (PP p a))
-> m (Either (TT x) (PP p a, TT (PP p a)))
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either (TT x) (PP p a, TT (PP p a))
-> m (Either (TT x) (PP p a, TT (PP p a))))
-> Either (TT x) (PP p a, TT (PP p a))
-> m (Either (TT x) (PP p a, TT (PP p a)))
forall a b. (a -> b) -> a -> b
$ (PP p a -> (PP p a, TT (PP p a)))
-> Either (TT x) (PP p a) -> Either (TT x) (PP p a, TT (PP p a))
forall (a :: Type -> Type -> Type) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right (,TT (PP p a)
pp) (Either (TT x) (PP p a) -> Either (TT x) (PP p a, TT (PP p a)))
-> Either (TT x) (PP p a) -> Either (TT x) (PP p a, TT (PP p a))
forall a b. (a -> b) -> a -> b
$ Inline
-> POpts
-> String
-> TT (PP p a)
-> [Tree PE]
-> Either (TT x) (PP p a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
inline POpts
opts String
msg0 TT (PP p a)
pp [Tree PE]
hhs
runPQ :: ( 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
-> 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
inline String
msg0 proxy1 p
proxyp proxy2 q
proxyq POpts
opts a
a [Tree PE]
hhs = do
TT (PP p a)
pp <- proxy1 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 proxy1 p
proxyp POpts
opts a
a
case Inline
-> POpts
-> String
-> TT (PP p a)
-> [Tree PE]
-> Either (TT x) (PP p a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
inline POpts
opts String
msg0 TT (PP p a)
pp [Tree PE]
hhs of
Left TT x
e -> Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a))
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a))
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a))))
-> Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a))
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall a b. (a -> b) -> a -> b
$ TT x -> Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a))
forall a b. a -> Either a b
Left TT x
e
Right PP p a
p -> do
TT (PP q a)
qq <- proxy2 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 proxy2 q
proxyq POpts
opts a
a
Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a))
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a))
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a))))
-> Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a))
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP q a)
-> [Tree PE]
-> Either (TT x) (PP q a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
inline POpts
opts String
msg0 TT (PP q a)
qq ([Tree PE]
hhs [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. Semigroup a => a -> a -> a
<> [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp]) of
Left TT x
e -> TT x -> Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a))
forall a b. a -> Either a b
Left TT x
e
Right PP q a
q -> (PP p a, PP q a, TT (PP p a), TT (PP q a))
-> Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a))
forall a b. b -> Either a b
Right (PP p a
p, PP q a
q, TT (PP p a)
pp, TT (PP q a)
qq)
runPQBool :: ( P p a
, PP p a ~ Bool
, P q a
, PP q a ~ Bool, 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)))
runPQBool :: 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)))
runPQBool Inline
inline String
msg0 proxy1 p
proxyp proxy2 q
proxyq POpts
opts a
a [Tree PE]
hhs = do
TT Bool
pp <- proxy1 p -> POpts -> a -> m (TT (PP p a))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool proxy1 p
proxyp POpts
opts a
a
case Inline
-> POpts -> String -> TT Bool -> [Tree PE] -> Either (TT x) Bool
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
inline POpts
opts String
msg0 TT Bool
pp [Tree PE]
hhs of
Left TT x
e -> Either (TT x) (Bool, Bool, TT Bool, TT Bool)
-> m (Either (TT x) (Bool, Bool, TT Bool, TT Bool))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either (TT x) (Bool, Bool, TT Bool, TT Bool)
-> m (Either (TT x) (Bool, Bool, TT Bool, TT Bool)))
-> Either (TT x) (Bool, Bool, TT Bool, TT Bool)
-> m (Either (TT x) (Bool, Bool, TT Bool, TT Bool))
forall a b. (a -> b) -> a -> b
$ TT x -> Either (TT x) (Bool, Bool, TT Bool, TT Bool)
forall a b. a -> Either a b
Left TT x
e
Right Bool
p -> do
TT Bool
qq <- proxy2 q -> POpts -> a -> m (TT (PP q a))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool proxy2 q
proxyq POpts
opts a
a
Either (TT x) (Bool, Bool, TT Bool, TT Bool)
-> m (Either (TT x) (Bool, Bool, TT Bool, TT Bool))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Either (TT x) (Bool, Bool, TT Bool, TT Bool)
-> m (Either (TT x) (Bool, Bool, TT Bool, TT Bool)))
-> Either (TT x) (Bool, Bool, TT Bool, TT Bool)
-> m (Either (TT x) (Bool, Bool, TT Bool, TT Bool))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts -> String -> TT Bool -> [Tree PE] -> Either (TT x) Bool
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
inline POpts
opts String
msg0 TT Bool
qq ([Tree PE]
hhs [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. Semigroup a => a -> a -> a
<> [TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
pp]) of
Left TT x
e -> TT x -> Either (TT x) (Bool, Bool, TT Bool, TT Bool)
forall a b. a -> Either a b
Left TT x
e
Right Bool
q -> (Bool, Bool, TT Bool, TT Bool)
-> Either (TT x) (Bool, Bool, TT Bool, TT Bool)
forall a b. b -> Either a b
Right (Bool
p, Bool
q, TT Bool
pp, TT Bool
qq)
evalBoolHide :: forall p a m
. (MonadEval m, P p a, PP p a ~ Bool)
=> POpts
-> a
-> m (TT (PP p a))
evalBoolHide :: POpts -> a -> m (TT (PP p a))
evalBoolHide POpts
opts
| POpts -> Bool
isVerbose POpts
opts = Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts
| Bool
otherwise = Proxy (Hide p) -> POpts -> a -> m (TT (PP (Hide p) a))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy (Hide p)
forall k (t :: k). Proxy t
Proxy @(Hide p)) POpts
opts
evalHide :: forall p a m
. ( MonadEval m
, P p a
)
=> POpts
-> a
-> m (TT (PP p a))
evalHide :: POpts -> a -> m (TT (PP p a))
evalHide POpts
opts
| POpts -> Bool
isVerbose POpts
opts = 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
| Bool
otherwise = Proxy (Hide p) -> POpts -> a -> m (TT (PP (Hide 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 (Hide p)
forall k (t :: k). Proxy t
Proxy @(Hide p)) POpts
opts
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
infixr 1 >>
instance ( P p a
, P q (PP p a)
, Show (PP p a)
, Show (PP q (PP p a))
) => P (p >> q) a where
type PP (p >> q) a = PP q (PP p a)
eval :: proxy (p >> q) -> POpts -> a -> m (TT (PP (p >> q) a))
eval proxy (p >> q)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"(>>)"
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
case Inline
-> POpts
-> String
-> TT (PP p a)
-> [Tree PE]
-> Either (TT (PP q (PP p a))) (PP p a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
"" TT (PP p a)
pp [] of
Left TT (PP q (PP p a))
e -> TT (PP q (PP p a)) -> m (TT (PP q (PP p a)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP q (PP p a))
e
Right PP p a
p -> do
TT (PP q (PP p a))
qq <- Proxy q -> POpts -> PP p a -> m (TT (PP q (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 q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts PP p a
p
TT (PP q (PP p a)) -> m (TT (PP q (PP p a)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q (PP p a)) -> m (TT (PP q (PP p a))))
-> TT (PP q (PP p a)) -> m (TT (PP q (PP p a)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP q (PP p a))
-> [Tree PE]
-> Either (TT (PP q (PP p a))) (PP q (PP p a))
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts (POpts -> PP p a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP p a
p) TT (PP q (PP p a))
qq [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp] of
Left TT (PP q (PP p a))
e | POpts -> Bool
isVerbose POpts
opts -> TT (PP q (PP p a))
e
| Bool
otherwise ->
if Getting Any (TT (PP q (PP p a))) ValP
-> (ValP -> Bool) -> TT (PP q (PP p a)) -> Bool
forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf (([Tree PE] -> Const Any [Tree PE])
-> TT (PP q (PP p a)) -> Const Any (TT (PP q (PP p a)))
forall a. Lens' (TT a) [Tree PE]
ttForest (([Tree PE] -> Const Any [Tree PE])
-> TT (PP q (PP p a)) -> Const Any (TT (PP q (PP p a))))
-> ((ValP -> Const Any ValP) -> [Tree PE] -> Const Any [Tree PE])
-> Getting Any (TT (PP q (PP p a))) ValP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tree PE -> Const Any (Tree PE))
-> [Tree PE] -> Const Any [Tree PE]
forall (f :: Type -> Type) a. Foldable f => IndexedFold Int (f a) a
folded ((Tree PE -> Const Any (Tree PE))
-> [Tree PE] -> Const Any [Tree PE])
-> ((ValP -> Const Any ValP) -> Tree PE -> Const Any (Tree PE))
-> (ValP -> Const Any ValP)
-> [Tree PE]
-> Const Any [Tree PE]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PE -> Const Any PE) -> Tree PE -> Const Any (Tree PE)
forall a. Lens' (Tree a) a
root ((PE -> Const Any PE) -> Tree PE -> Const Any (Tree PE))
-> ((ValP -> Const Any ValP) -> PE -> Const Any PE)
-> (ValP -> Const Any ValP)
-> Tree PE
-> Const Any (Tree PE)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValP -> Const Any ValP) -> PE -> Const Any PE
Lens' PE ValP
peValP) (Getting Any ValP String -> ValP -> Bool
forall s a. Getting Any s a -> s -> Bool
has Getting Any ValP String
Prism' ValP String
_FailP) TT (PP q (PP p a))
qq
then TT (PP q (PP p a))
qq TT (PP q (PP p a))
-> (TT (PP q (PP p a)) -> TT (PP q (PP p a))) -> TT (PP q (PP p a))
forall a b. a -> (a -> b) -> b
& ([Tree PE] -> Identity [Tree PE])
-> TT (PP q (PP p a)) -> Identity (TT (PP q (PP p a)))
forall a. Lens' (TT a) [Tree PE]
ttForest (([Tree PE] -> Identity [Tree PE])
-> TT (PP q (PP p a)) -> Identity (TT (PP q (PP p a))))
-> ([Tree PE] -> [Tree PE])
-> TT (PP q (PP p a))
-> TT (PP q (PP p a))
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
ppTree PE -> [Tree PE] -> [Tree PE]
forall a. a -> [a] -> [a]
:)
else TT (PP q (PP p a))
e
Right PP q (PP p a)
q -> POpts
-> TT (PP q (PP p a)) -> String -> [Tree PE] -> TT (PP q (PP p a))
forall a. POpts -> TT a -> String -> [Tree PE] -> TT a
mkNodeCopy POpts
opts TT (PP q (PP p a))
qq (POpts -> String -> PP q (PP p a) -> String -> ShowS
forall a1. Show a1 => POpts -> String -> a1 -> String -> ShowS
lit3 POpts
opts String
msg0 PP q (PP p a)
q String
"" (ShowS
topMessageEgregious (TT (PP q (PP p a))
qq TT (PP q (PP p a))
-> Getting String (TT (PP q (PP p a))) String -> String
forall s a. s -> Getting a s a -> a
^. Getting String (TT (PP q (PP p a))) String
forall a. Lens' (TT a) String
ttString))) [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 RightArrowsLeftInfixT p q = p >> q
infixl 1 >>>
instance P (RightArrowsLeftInfixT p q) x => P (p >>> q) x where
type PP (p >>> q) x = PP (RightArrowsLeftInfixT p q) x
eval :: proxy (p >>> q) -> POpts -> x -> m (TT (PP (p >>> q) x))
eval proxy (p >>> q)
_ = Proxy (RightArrowsLeftInfixT p q)
-> POpts -> x -> m (TT (PP (RightArrowsLeftInfixT 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 (RightArrowsLeftInfixT p q)
forall k (t :: k). Proxy t
Proxy @(RightArrowsLeftInfixT 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 LeftArrowsT p q = q >> p
infixr 1 <<
instance P (LeftArrowsT p q) x => P (p << q) x where
type PP (p << q) x = PP (LeftArrowsT p q) x
eval :: proxy (p << q) -> POpts -> x -> m (TT (PP (p << q) x))
eval proxy (p << q)
_ = Proxy (LeftArrowsT p q)
-> POpts -> x -> m (TT (PP (LeftArrowsT 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 (LeftArrowsT p q)
forall k (t :: k). Proxy t
Proxy @(LeftArrowsT p q))
topMessageEgregious :: String -> String
topMessageEgregious :: ShowS
topMessageEgregious String
s =
let ret :: String
ret = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Regex -> String -> [(String, [String])]
forall a.
(ConvertibleStrings SBS a, ConvertibleStrings a SBS) =>
Regex -> a -> [(a, [a])]
RH.scan Regex
topMessageExtractRe String
s [(String, [String])]
-> Getting (First String) [(String, [String])] String
-> Maybe String
forall s a. s -> Getting (First a) s a -> Maybe a
^? ((String, [String]) -> Const (First String) (String, [String]))
-> [(String, [String])]
-> Const (First String) [(String, [String])]
forall s a. Snoc s s a a => Traversal' s a
_last (((String, [String]) -> Const (First String) (String, [String]))
-> [(String, [String])]
-> Const (First String) [(String, [String])])
-> ((String -> Const (First String) String)
-> (String, [String]) -> Const (First String) (String, [String]))
-> Getting (First String) [(String, [String])] String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> Const (First String) [String])
-> (String, [String]) -> Const (First String) (String, [String])
forall s t a b. Field2 s t a b => Lens s t a b
_2 (([String] -> Const (First String) [String])
-> (String, [String]) -> Const (First String) (String, [String]))
-> ((String -> Const (First String) String)
-> [String] -> Const (First String) [String])
-> (String -> Const (First String) String)
-> (String, [String])
-> Const (First String) (String, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Const (First String) String)
-> [String] -> Const (First String) [String]
forall s a. Snoc s s a a => Traversal' s a
_last)
in Char
'{' Char -> ShowS
forall a. a -> [a] -> [a]
: (if String -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null String
ret then String
s else String
ret) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"}"
topMessageExtractRe :: RH.Regex
= [RH.re|^.*\{([^}]+)\}.*?|]
data Unwrap deriving Int -> Unwrap -> ShowS
[Unwrap] -> ShowS
Unwrap -> String
(Int -> Unwrap -> ShowS)
-> (Unwrap -> String) -> ([Unwrap] -> ShowS) -> Show Unwrap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unwrap] -> ShowS
$cshowList :: [Unwrap] -> ShowS
show :: Unwrap -> String
$cshow :: Unwrap -> String
showsPrec :: Int -> Unwrap -> ShowS
$cshowsPrec :: Int -> Unwrap -> ShowS
Show
instance ( Show x
, Show (Unwrapped x)
, Wrapped x
) => P Unwrap x where
type PP Unwrap x = Unwrapped x
eval :: proxy Unwrap -> POpts -> x -> m (TT (PP Unwrap x))
eval proxy Unwrap
_ POpts
opts x
x =
let msg0 :: String
msg0 = String
"Unwrap"
d :: Unwrapped x
d = x
x x -> Getting (Unwrapped x) x (Unwrapped x) -> Unwrapped x
forall s a. s -> Getting a s a -> a
^. Getting (Unwrapped x) x (Unwrapped x)
forall s. Wrapped s => Iso' s (Unwrapped s)
_Wrapped'
in TT (Unwrapped x) -> m (TT (Unwrapped x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Unwrapped x) -> m (TT (Unwrapped x)))
-> TT (Unwrapped x) -> m (TT (Unwrapped x))
forall a b. (a -> b) -> a -> b
$ POpts
-> Val (Unwrapped x) -> String -> [Tree PE] -> TT (Unwrapped x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Unwrapped x -> Val (Unwrapped x)
forall a. a -> Val a
Val Unwrapped x
d) (POpts -> String -> Unwrapped x -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 Unwrapped x
d x
x) []
data Wrap' t p deriving Int -> Wrap' t p -> ShowS
[Wrap' t p] -> ShowS
Wrap' t p -> String
(Int -> Wrap' t p -> ShowS)
-> (Wrap' t p -> String)
-> ([Wrap' t p] -> ShowS)
-> Show (Wrap' t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (p :: k). Int -> Wrap' t p -> ShowS
forall k (t :: k) k (p :: k). [Wrap' t p] -> ShowS
forall k (t :: k) k (p :: k). Wrap' t p -> String
showList :: [Wrap' t p] -> ShowS
$cshowList :: forall k (t :: k) k (p :: k). [Wrap' t p] -> ShowS
show :: Wrap' t p -> String
$cshow :: forall k (t :: k) k (p :: k). Wrap' t p -> String
showsPrec :: Int -> Wrap' t p -> ShowS
$cshowsPrec :: forall k (t :: k) k (p :: k). Int -> Wrap' t p -> ShowS
Show
instance ( Show (PP p x)
, P p x
, Unwrapped (PP s x) ~ PP p x
, Wrapped (PP s x)
, Show (PP s x)
) => P (Wrap' s p) x where
type PP (Wrap' s p) x = PP s x
eval :: proxy (Wrap' s p) -> POpts -> x -> m (TT (PP (Wrap' s p) x))
eval proxy (Wrap' s p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Wrap"
TT (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
TT (PP s x) -> m (TT (PP s x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP s x) -> m (TT (PP s x))) -> TT (PP s x) -> m (TT (PP s x))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT (PP s x)) (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 p x)
pp [] of
Left TT (PP s x)
e -> TT (PP s x)
e
Right PP p x
p ->
let d :: PP s x
d = PP p x
p PP p x -> Getting (PP s x) (PP p x) (PP s x) -> PP s x
forall s a. s -> Getting a s a -> a
^. Getting (PP s x) (PP p x) (PP s x)
forall s. Wrapped s => Iso' (Unwrapped s) s
_Unwrapped'
in POpts -> Val (PP s x) -> String -> [Tree PE] -> TT (PP s x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP s x -> Val (PP s x)
forall a. a -> Val a
Val PP s x
d) (POpts -> String -> PP s x -> PP p x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 PP s x
d PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]
data Wrap (t :: Type) p deriving Int -> Wrap t p -> ShowS
[Wrap t p] -> ShowS
Wrap t p -> String
(Int -> Wrap t p -> ShowS)
-> (Wrap t p -> String) -> ([Wrap t p] -> ShowS) -> Show (Wrap t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t k (p :: k). Int -> Wrap t p -> ShowS
forall t k (p :: k). [Wrap t p] -> ShowS
forall t k (p :: k). Wrap t p -> String
showList :: [Wrap t p] -> ShowS
$cshowList :: forall t k (p :: k). [Wrap t p] -> ShowS
show :: Wrap t p -> String
$cshow :: forall t k (p :: k). Wrap t p -> String
showsPrec :: Int -> Wrap t p -> ShowS
$cshowsPrec :: forall t k (p :: k). Int -> Wrap t p -> ShowS
Show
type WrapT (t :: Type) p = Wrap' (Hole t) p
instance P (WrapT t p) x => P (Wrap t p) x where
type PP (Wrap t p) x = PP (WrapT t p) x
eval :: proxy (Wrap t p) -> POpts -> x -> m (TT (PP (Wrap t p) x))
eval proxy (Wrap t p)
_ = Proxy (WrapT t p) -> POpts -> x -> m (TT (PP (WrapT t 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 (WrapT t p)
forall k (t :: k). Proxy t
Proxy @(WrapT t p))
data UnproxyT deriving Int -> UnproxyT -> ShowS
[UnproxyT] -> ShowS
UnproxyT -> String
(Int -> UnproxyT -> ShowS)
-> (UnproxyT -> String) -> ([UnproxyT] -> ShowS) -> Show UnproxyT
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnproxyT] -> ShowS
$cshowList :: [UnproxyT] -> ShowS
show :: UnproxyT -> String
$cshow :: UnproxyT -> String
showsPrec :: Int -> UnproxyT -> ShowS
$cshowsPrec :: Int -> UnproxyT -> ShowS
Show
instance Typeable t => P UnproxyT (Proxy (t :: Type)) where
type PP UnproxyT (Proxy t) = t
eval :: proxy UnproxyT
-> POpts -> Proxy t -> m (TT (PP UnproxyT (Proxy t)))
eval proxy UnproxyT
_ POpts
opts Proxy t
_ =
let msg0 :: String
msg0 = String
"UnproxyT(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Typeable t => String
forall t. Typeable t => String
showT @t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
in TT t -> m (TT t)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT t -> m (TT t)) -> TT t -> m (TT t)
forall a b. (a -> b) -> a -> b
$ POpts -> Val t -> String -> [Tree PE] -> TT t
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val t
forall a. String -> Val a
Fail String
msg0) String
"you probably meant to get access to the type of PP only and not evaluate (see Pop0)" []
data Len deriving Int -> Len -> ShowS
[Len] -> ShowS
Len -> String
(Int -> Len -> ShowS)
-> (Len -> String) -> ([Len] -> ShowS) -> Show Len
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Len] -> ShowS
$cshowList :: [Len] -> ShowS
show :: Len -> String
$cshow :: Len -> String
showsPrec :: Int -> Len -> ShowS
$cshowsPrec :: Int -> Len -> ShowS
Show
instance ( x ~ [a]
, Show a
) => P Len x where
type PP Len x = Int
eval :: proxy Len -> POpts -> x -> m (TT (PP Len x))
eval proxy Len
_ POpts
opts x
as' =
let msg0 :: String
msg0 = String
"Len"
in TT Int -> m (TT Int)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Int -> m (TT Int)) -> TT Int -> m (TT Int)
forall a b. (a -> b) -> a -> b
$ case POpts -> String -> [a] -> [Tree PE] -> Either (TT Int) (Int, [a])
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) (Int, [a])
chkSize POpts
opts { oLarge :: HKD Identity Bool
oLarge = Bool
HKD Identity Bool
True } String
msg0 x
[a]
as' [] of
Left TT Int
e -> TT Int
e
Right (Int
asLen,[a]
_) ->
POpts -> Val Int -> String -> [Tree PE] -> TT Int
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Int -> Val Int
forall a. a -> Val a
Val Int
asLen) (POpts -> String -> Int -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 Int
asLen x
as') []
data Length p deriving Int -> Length p -> ShowS
[Length p] -> ShowS
Length p -> String
(Int -> Length p -> ShowS)
-> (Length p -> String) -> ([Length p] -> ShowS) -> Show (Length p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> Length p -> ShowS
forall k (p :: k). [Length p] -> ShowS
forall k (p :: k). Length p -> String
showList :: [Length p] -> ShowS
$cshowList :: forall k (p :: k). [Length p] -> ShowS
show :: Length p -> String
$cshow :: forall k (p :: k). Length p -> String
showsPrec :: Int -> Length p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> Length p -> ShowS
Show
instance ( PP p x ~ t a
, P p x
, Foldable t
) => P (Length p) x where
type PP (Length p) x = Int
eval :: proxy (Length p) -> POpts -> x -> m (TT (PP (Length p) x))
eval proxy (Length p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Length"
TT (t a)
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
TT Int -> m (TT Int)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Int -> m (TT Int)) -> TT Int -> m (TT Int)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (t a)
-> [Tree PE]
-> Either (TT Int) (t a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (t a)
pp [] of
Left TT Int
e -> TT Int
e
Right t a
p' ->
case POpts -> String -> t a -> [Tree PE] -> Either (TT Int) (Int, [a])
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) (Int, [a])
chkSize POpts
opts { oLarge :: HKD Identity Bool
oLarge = Bool
HKD Identity Bool
True } String
msg0 t a
p' [] of
Left TT Int
e -> TT Int
e
Right (Int
pLen,[a]
_) ->
POpts -> Val Int -> String -> [Tree PE] -> TT Int
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Int -> Val Int
forall a. a -> Val a
Val Int
pLen) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
pLen) [TT (t a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (t a)
pp]
data Not p deriving Int -> Not p -> ShowS
[Not p] -> ShowS
Not p -> String
(Int -> Not p -> ShowS)
-> (Not p -> String) -> ([Not p] -> ShowS) -> Show (Not p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> Not p -> ShowS
forall k (p :: k). [Not p] -> ShowS
forall k (p :: k). Not p -> String
showList :: [Not p] -> ShowS
$cshowList :: forall k (p :: k). [Not p] -> ShowS
show :: Not p -> String
$cshow :: forall k (p :: k). Not p -> String
showsPrec :: Int -> Not p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> Not p -> ShowS
Show
instance ( PP p x ~ Bool
, P p x
) => P (Not p) x where
type PP (Not p) x = Bool
eval :: proxy (Not p) -> POpts -> x -> m (TT (PP (Not p) x))
eval proxy (Not p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Not"
TT Bool
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Bool -> m (TT Bool)) -> TT Bool -> m (TT Bool)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts -> String -> TT Bool -> [Tree PE] -> Either (TT Bool) Bool
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT Bool
pp [] of
Left TT Bool
e -> TT Bool
e
Right Bool
p ->
let b :: Bool
b = Bool -> Bool
not Bool
p
in POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts Bool
b (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> ShowS
litVerbose POpts
opts String
" " (TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
pp)) [TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
pp]
data IdBool deriving Int -> IdBool -> ShowS
[IdBool] -> ShowS
IdBool -> String
(Int -> IdBool -> ShowS)
-> (IdBool -> String) -> ([IdBool] -> ShowS) -> Show IdBool
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IdBool] -> ShowS
$cshowList :: [IdBool] -> ShowS
show :: IdBool -> String
$cshow :: IdBool -> String
showsPrec :: Int -> IdBool -> ShowS
$cshowsPrec :: Int -> IdBool -> ShowS
Show
instance x ~ Bool
=> P IdBool x where
type PP IdBool x = Bool
eval :: proxy IdBool -> POpts -> x -> m (TT (PP IdBool x))
eval proxy IdBool
_ POpts
opts x
x =
let msg0 :: String
msg0 = String
"IdBool"
in TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Bool -> m (TT Bool)) -> TT Bool -> m (TT Bool)
forall a b. (a -> b) -> a -> b
$ POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts x
Bool
x String
msg0 []
data Fail t prt deriving Int -> Fail t prt -> ShowS
[Fail t prt] -> ShowS
Fail t prt -> String
(Int -> Fail t prt -> ShowS)
-> (Fail t prt -> String)
-> ([Fail t prt] -> ShowS)
-> Show (Fail t prt)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (prt :: k). Int -> Fail t prt -> ShowS
forall k (t :: k) k (prt :: k). [Fail t prt] -> ShowS
forall k (t :: k) k (prt :: k). Fail t prt -> String
showList :: [Fail t prt] -> ShowS
$cshowList :: forall k (t :: k) k (prt :: k). [Fail t prt] -> ShowS
show :: Fail t prt -> String
$cshow :: forall k (t :: k) k (prt :: k). Fail t prt -> String
showsPrec :: Int -> Fail t prt -> ShowS
$cshowsPrec :: forall k (t :: k) k (prt :: k). Int -> Fail t prt -> ShowS
Show
instance ( P prt a
, PP prt a ~ String
) => P (Fail t prt) a where
type PP (Fail t prt) a = PP t a
eval :: proxy (Fail t prt) -> POpts -> a -> m (TT (PP (Fail t prt) a))
eval proxy (Fail t prt)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"Fail"
TT String
pp <- Proxy prt -> POpts -> a -> m (TT (PP prt 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 prt
forall k (t :: k). Proxy t
Proxy @prt) POpts
opts a
a
TT (PP t a) -> m (TT (PP t a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP t a) -> m (TT (PP t a))) -> TT (PP t a) -> m (TT (PP t a))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT String
-> [Tree PE]
-> Either (TT (PP t a)) String
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT String
pp [] of
Left TT (PP t a)
e -> TT (PP t a)
e
Right String
s -> POpts -> Val (PP t a) -> String -> [Tree PE] -> TT (PP t a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP t a)
forall a. String -> Val a
Fail String
s) String
"" (POpts -> TT String -> [Tree PE]
forall a. POpts -> TT a -> [Tree PE]
verboseList POpts
opts TT String
pp)
data FailS p deriving Int -> FailS p -> ShowS
[FailS p] -> ShowS
FailS p -> String
(Int -> FailS p -> ShowS)
-> (FailS p -> String) -> ([FailS p] -> ShowS) -> Show (FailS p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> FailS p -> ShowS
forall k (p :: k). [FailS p] -> ShowS
forall k (p :: k). FailS p -> String
showList :: [FailS p] -> ShowS
$cshowList :: forall k (p :: k). [FailS p] -> ShowS
show :: FailS p -> String
$cshow :: forall k (p :: k). FailS p -> String
showsPrec :: Int -> FailS p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> FailS p -> ShowS
Show
instance P (Fail Id p) x => P (FailS p) x where
type PP (FailS p) x = PP (Fail Id p) x
eval :: proxy (FailS p) -> POpts -> x -> m (TT (PP (FailS p) x))
eval proxy (FailS p)
_ = Proxy (Fail Id p) -> POpts -> x -> m (TT (PP (Fail Id 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 (Fail Id p)
forall k (t :: k). Proxy t
Proxy @(Fail Id p))
data FailT (t :: Type) p deriving Int -> FailT t p -> ShowS
[FailT t p] -> ShowS
FailT t p -> String
(Int -> FailT t p -> ShowS)
-> (FailT t p -> String)
-> ([FailT t p] -> ShowS)
-> Show (FailT t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t k (p :: k). Int -> FailT t p -> ShowS
forall t k (p :: k). [FailT t p] -> ShowS
forall t k (p :: k). FailT t p -> String
showList :: [FailT t p] -> ShowS
$cshowList :: forall t k (p :: k). [FailT t p] -> ShowS
show :: FailT t p -> String
$cshow :: forall t k (p :: k). FailT t p -> String
showsPrec :: Int -> FailT t p -> ShowS
$cshowsPrec :: forall t k (p :: k). Int -> FailT t p -> ShowS
Show
instance P (Fail (Hole t) p) x => P (FailT t p) x where
type PP (FailT t p) x = PP (Fail (Hole t) p) x
eval :: proxy (FailT t p) -> POpts -> x -> m (TT (PP (FailT t p) x))
eval proxy (FailT t p)
_ = Proxy (Fail (Hole t) p)
-> POpts -> x -> m (TT (PP (Fail (Hole t) 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 (Fail (Hole t) p)
forall k (t :: k). Proxy t
Proxy @(Fail (Hole t) p))
data FailP p deriving Int -> FailP p -> ShowS
[FailP p] -> ShowS
FailP p -> String
(Int -> FailP p -> ShowS)
-> (FailP p -> String) -> ([FailP p] -> ShowS) -> Show (FailP p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> FailP p -> ShowS
forall k (p :: k). [FailP p] -> ShowS
forall k (p :: k). FailP p -> String
showList :: [FailP p] -> ShowS
$cshowList :: forall k (p :: k). [FailP p] -> ShowS
show :: FailP p -> String
$cshow :: forall k (p :: k). FailP p -> String
showsPrec :: Int -> FailP p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> FailP p -> ShowS
Show
instance P (Fail UnproxyT p) x => P (FailP p) x where
type PP (FailP p) x = PP (Fail UnproxyT p) x
eval :: proxy (FailP p) -> POpts -> x -> m (TT (PP (FailP p) x))
eval proxy (FailP p)
_ = Proxy (Fail UnproxyT p)
-> POpts -> x -> m (TT (PP (Fail UnproxyT 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 (Fail UnproxyT p)
forall k (t :: k). Proxy t
Proxy @(Fail UnproxyT p))
data OneP deriving Int -> OneP -> ShowS
[OneP] -> ShowS
OneP -> String
(Int -> OneP -> ShowS)
-> (OneP -> String) -> ([OneP] -> ShowS) -> Show OneP
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OneP] -> ShowS
$cshowList :: [OneP] -> ShowS
show :: OneP -> String
$cshow :: OneP -> String
showsPrec :: Int -> OneP -> ShowS
$cshowsPrec :: Int -> OneP -> ShowS
Show
instance ( Foldable t
, x ~ t a
) => P OneP x where
type PP OneP x = ExtractAFromTA x
eval :: proxy OneP -> POpts -> x -> m (TT (PP OneP x))
eval proxy OneP
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"OneP"
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 t a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList x
t a
x of
[] -> POpts -> Val a -> String -> [Tree PE] -> TT a
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val a
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":expected one element(empty)")) String
"" []
[a
a] -> 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 []
[a]
as' -> case POpts -> String -> [a] -> [Tree PE] -> Either (TT a) (Int, [a])
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) (Int, [a])
chkSize POpts
opts String
msg0 [a]
as' [] of
Left TT a
e -> TT a
e
Right (Int
asLen,[a]
_) ->
POpts -> Val a -> String -> [Tree PE] -> TT a
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val a
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":expected one element(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
asLen String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")")) String
"" []
data Between p q r deriving Int -> Between p q r -> ShowS
[Between p q r] -> ShowS
Between p q r -> String
(Int -> Between p q r -> ShowS)
-> (Between p q r -> String)
-> ([Between p q r] -> ShowS)
-> Show (Between 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 -> Between p q r -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). [Between p q r] -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). Between p q r -> String
showList :: [Between p q r] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k) k (r :: k). [Between p q r] -> ShowS
show :: Between p q r -> String
$cshow :: forall k (p :: k) k (q :: k) k (r :: k). Between p q r -> String
showsPrec :: Int -> Between p q r -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k) k (r :: k).
Int -> Between p q r -> ShowS
Show
instance ( Ord (PP p x)
, Show (PP p x)
, PP r x ~ PP p x
, PP r x ~ PP q x
, P p x
, P q x
, P r x
) => P (Between p q r) x where
type PP (Between p q r) x = Bool
eval :: proxy (Between p q r)
-> POpts -> x -> m (TT (PP (Between p q r) x))
eval proxy (Between p q r)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Between"
TT (PP p x)
rr <- Proxy r -> POpts -> x -> m (TT (PP 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 r
forall k (t :: k). Proxy t
Proxy @r) POpts
opts x
x
case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT Bool) (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 p x)
rr [] of
Left TT Bool
e -> TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT Bool
e
Right PP p x
r -> do
Either (TT Bool) (PP p x, PP p x, TT (PP p x), TT (PP p x))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT Bool) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k k (p :: k) a (q :: k) (m :: Type -> Type)
(proxy1 :: k -> Type) (proxy2 :: k -> 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 (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
rr]
TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Bool -> m (TT Bool)) -> TT Bool -> m (TT Bool)
forall a b. (a -> b) -> a -> b
$ case Either (TT Bool) (PP p x, PP p x, TT (PP p x), TT (PP p x))
lr of
Left TT Bool
e -> TT Bool
e
Right (PP p x
p,PP p x
q,TT (PP p x)
pp,TT (PP p x)
qq) ->
let hhs :: [Tree PE]
hhs = [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
rr, TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp, TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
qq]
in if PP p x
p PP p x -> PP p x -> Bool
forall a. Ord a => a -> a -> Bool
<= PP p x
r Bool -> Bool -> Bool
&& PP p x
r PP p x -> PP p x -> Bool
forall a. Ord a => a -> a -> Bool
<= PP p x
q then POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts Bool
True (POpts -> PP p x -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP p x
p 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
r 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
q) [Tree PE]
hhs
else if PP p x
p PP p x -> PP p x -> Bool
forall a. Ord a => a -> a -> Bool
> PP p x
r then POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts Bool
False (POpts -> PP p x -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP p x
p 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
r) [Tree PE]
hhs
else POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts Bool
False (POpts -> PP p x -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP p x
r 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
q) [Tree PE]
hhs
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
infix 4 <..>
type BetweenOpT p q = Between p q Id
instance P (BetweenOpT p q) x => P (p <..> q) x where
type PP (p <..> q) x = PP (BetweenOpT p q) x
eval :: proxy (p <..> q) -> POpts -> x -> m (TT (PP (p <..> q) x))
eval proxy (p <..> q)
_ = Proxy (BetweenOpT p q)
-> POpts -> x -> m (TT (PP (BetweenOpT p q) x))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy (BetweenOpT p q)
forall k (t :: k). Proxy t
Proxy @(BetweenOpT p q))
data All p deriving Int -> All p -> ShowS
[All p] -> ShowS
All p -> String
(Int -> All p -> ShowS)
-> (All p -> String) -> ([All p] -> ShowS) -> Show (All p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> All p -> ShowS
forall k (p :: k). [All p] -> ShowS
forall k (p :: k). All p -> String
showList :: [All p] -> ShowS
$cshowList :: forall k (p :: k). [All p] -> ShowS
show :: All p -> String
$cshow :: forall k (p :: k). All p -> String
showsPrec :: Int -> All p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> All p -> ShowS
Show
instance ( P p a
, PP p a ~ Bool
, x ~ f a
, Show a
, Foldable f
) => P (All p) x where
type PP (All p) x = Bool
eval :: proxy (All p) -> POpts -> x -> m (TT (PP (All p) x))
eval proxy (All p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"All"
case POpts -> String -> f a -> [Tree PE] -> Either (TT Bool) (Int, [a])
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) (Int, [a])
chkSize POpts
opts String
msg0 x
f a
x [] of
Left TT Bool
e -> TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT Bool
e
Right (Int
xsLen,[a]
xs) -> do
[((Int, a), TT Bool)]
ts <- (Int -> a -> m ((Int, a), TT Bool))
-> [Int] -> [a] -> m [((Int, a), TT Bool)]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Int
i a
a -> ((Int
i, a
a),) (TT Bool -> ((Int, a), TT Bool))
-> m (TT Bool) -> m ((Int, a), TT Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
POpts -> a -> m (TT (PP p a))
evalBoolHide @p POpts
opts a
a) [Int
0::Int ..] [a]
xs
TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Bool -> m (TT Bool)) -> TT Bool -> m (TT Bool)
forall a b. (a -> b) -> a -> b
$ case POpts
-> String
-> [((Int, a), TT Bool)]
-> Either (TT Bool) [(Bool, (Int, a), TT Bool)]
forall x a w.
Show x =>
POpts
-> String
-> [((Int, x), TT a)]
-> Either (TT w) [(a, (Int, x), TT a)]
splitAndAlign POpts
opts String
msg0 [((Int, a), TT Bool)]
ts of
Left TT Bool
e -> TT Bool
e
Right [(Bool, (Int, a), TT Bool)]
abcs ->
let hhs :: [Tree PE]
hhs = (((Int, a), TT Bool) -> Tree PE)
-> [((Int, a), TT Bool)] -> [Tree PE]
forall a b. (a -> b) -> [a] -> [b]
map (TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh (TT Bool -> Tree PE)
-> (((Int, a), TT Bool) -> TT Bool)
-> ((Int, a), TT Bool)
-> Tree PE
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, a), TT Bool) -> TT Bool
forall x a. ((Int, x), TT a) -> TT a
prefixNumberToTT) [((Int, a), TT Bool)]
ts
msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ POpts -> Int -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Int
xsLen String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
in case ((Bool, (Int, a), TT Bool) -> Bool)
-> [(Bool, (Int, a), TT Bool)] -> Maybe (Bool, (Int, a), TT Bool)
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Maybe a
find (Bool -> Bool
not (Bool -> Bool)
-> ((Bool, (Int, a), TT Bool) -> Bool)
-> (Bool, (Int, a), TT Bool)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Bool (Bool, (Int, a), TT Bool) Bool
-> (Bool, (Int, a), TT Bool) -> Bool
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting Bool (Bool, (Int, a), TT Bool) Bool
forall s t a b. Field1 s t a b => Lens s t a b
_1) [(Bool, (Int, a), TT Bool)]
abcs of
Maybe (Bool, (Int, a), TT Bool)
Nothing -> POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts Bool
True String
msg1 [Tree PE]
hhs
Just (Bool
_,(Int
i,a
_),TT Bool
tt) ->
POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts Bool
False (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" i=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
tt) [Tree PE]
hhs
data Any p deriving Int -> Any p -> ShowS
[Any p] -> ShowS
Any p -> String
(Int -> Any p -> ShowS)
-> (Any p -> String) -> ([Any p] -> ShowS) -> Show (Any p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> Any p -> ShowS
forall k (p :: k). [Any p] -> ShowS
forall k (p :: k). Any p -> String
showList :: [Any p] -> ShowS
$cshowList :: forall k (p :: k). [Any p] -> ShowS
show :: Any p -> String
$cshow :: forall k (p :: k). Any p -> String
showsPrec :: Int -> Any p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> Any p -> ShowS
Show
instance ( P p a
, PP p a ~ Bool
, x ~ f a
, Show a
, Foldable f
) => P (Any p) x where
type PP (Any p) x = Bool
eval :: proxy (Any p) -> POpts -> x -> m (TT (PP (Any p) x))
eval proxy (Any p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Any"
case POpts -> String -> f a -> [Tree PE] -> Either (TT Bool) (Int, [a])
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) (Int, [a])
chkSize POpts
opts String
msg0 x
f a
x [] of
Left TT Bool
e -> TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT Bool
e
Right (Int
xsLen,[a]
xs) -> do
[((Int, a), TT Bool)]
ts <- (Int -> a -> m ((Int, a), TT Bool))
-> [Int] -> [a] -> m [((Int, a), TT Bool)]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Int
i a
a -> ((Int
i, a
a),) (TT Bool -> ((Int, a), TT Bool))
-> m (TT Bool) -> m ((Int, a), TT Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
POpts -> a -> m (TT (PP p a))
evalBoolHide @p POpts
opts a
a) [Int
0::Int ..] [a]
xs
TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Bool -> m (TT Bool)) -> TT Bool -> m (TT Bool)
forall a b. (a -> b) -> a -> b
$ case POpts
-> String
-> [((Int, a), TT Bool)]
-> Either (TT Bool) [(Bool, (Int, a), TT Bool)]
forall x a w.
Show x =>
POpts
-> String
-> [((Int, x), TT a)]
-> Either (TT w) [(a, (Int, x), TT a)]
splitAndAlign POpts
opts String
msg0 [((Int, a), TT Bool)]
ts of
Left TT Bool
e -> TT Bool
e
Right [(Bool, (Int, a), TT Bool)]
abcs ->
let hhs :: [Tree PE]
hhs = (((Int, a), TT Bool) -> Tree PE)
-> [((Int, a), TT Bool)] -> [Tree PE]
forall a b. (a -> b) -> [a] -> [b]
map (TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh (TT Bool -> Tree PE)
-> (((Int, a), TT Bool) -> TT Bool)
-> ((Int, a), TT Bool)
-> Tree PE
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, a), TT Bool) -> TT Bool
forall x a. ((Int, x), TT a) -> TT a
prefixNumberToTT) [((Int, a), TT Bool)]
ts
msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ POpts -> Int -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Int
xsLen String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
in case ((Bool, (Int, a), TT Bool) -> Bool)
-> [(Bool, (Int, a), TT Bool)] -> Maybe (Bool, (Int, a), TT Bool)
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Maybe a
find (Getting Bool (Bool, (Int, a), TT Bool) Bool
-> (Bool, (Int, a), TT Bool) -> Bool
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting Bool (Bool, (Int, a), TT Bool) Bool
forall s t a b. Field1 s t a b => Lens s t a b
_1) [(Bool, (Int, a), TT Bool)]
abcs of
Maybe (Bool, (Int, a), TT Bool)
Nothing -> POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts Bool
False String
msg1 [Tree PE]
hhs
Just (Bool
_,(Int
i,a
_),TT Bool
tt) ->
POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts Bool
True (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" i=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
tt) [Tree PE]
hhs
data L1 p deriving Int -> L1 p -> ShowS
[L1 p] -> ShowS
L1 p -> String
(Int -> L1 p -> ShowS)
-> (L1 p -> String) -> ([L1 p] -> ShowS) -> Show (L1 p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> L1 p -> ShowS
forall k (p :: k). [L1 p] -> ShowS
forall k (p :: k). L1 p -> String
showList :: [L1 p] -> ShowS
$cshowList :: forall k (p :: k). [L1 p] -> ShowS
show :: L1 p -> String
$cshow :: forall k (p :: k). L1 p -> String
showsPrec :: Int -> L1 p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> L1 p -> ShowS
Show
instance ( Show (ExtractL1T (PP p x))
, ExtractL1C (PP p x)
, P p x
, Show (PP p x)
) => P (L1 p) x where
type PP (L1 p) x = ExtractL1T (PP p x)
eval :: proxy (L1 p) -> POpts -> x -> m (TT (PP (L1 p) x))
eval proxy (L1 p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Fst"
TT (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
TT (ExtractL1T (PP p x)) -> m (TT (ExtractL1T (PP p x)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (ExtractL1T (PP p x)) -> m (TT (ExtractL1T (PP p x))))
-> TT (ExtractL1T (PP p x)) -> m (TT (ExtractL1T (PP p x)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT (ExtractL1T (PP p x))) (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 p x)
pp [] of
Left TT (ExtractL1T (PP p x))
e -> TT (ExtractL1T (PP p x))
e
Right PP p x
p ->
let b :: ExtractL1T (PP p x)
b = PP p x -> ExtractL1T (PP p x)
forall tp. ExtractL1C tp => tp -> ExtractL1T tp
extractL1C PP p x
p
in POpts
-> Val (ExtractL1T (PP p x))
-> String
-> [Tree PE]
-> TT (ExtractL1T (PP p x))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (ExtractL1T (PP p x) -> Val (ExtractL1T (PP p x))
forall a. a -> Val a
Val ExtractL1T (PP p x)
b) (POpts -> String -> ExtractL1T (PP p x) -> PP p x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 ExtractL1T (PP p x)
b PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]
data Fst deriving Int -> Fst -> ShowS
[Fst] -> ShowS
Fst -> String
(Int -> Fst -> ShowS)
-> (Fst -> String) -> ([Fst] -> ShowS) -> Show Fst
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fst] -> ShowS
$cshowList :: [Fst] -> ShowS
show :: Fst -> String
$cshow :: Fst -> String
showsPrec :: Int -> Fst -> ShowS
$cshowsPrec :: Int -> Fst -> ShowS
Show
type FstT = L1 Id
instance P FstT x => P Fst x where
type PP Fst x = PP FstT x
eval :: proxy Fst -> POpts -> x -> m (TT (PP Fst x))
eval proxy Fst
_ = Proxy FstT -> POpts -> x -> m (TT (PP FstT 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 FstT
forall k (t :: k). Proxy t
Proxy @FstT)
data L2 p deriving Int -> L2 p -> ShowS
[L2 p] -> ShowS
L2 p -> String
(Int -> L2 p -> ShowS)
-> (L2 p -> String) -> ([L2 p] -> ShowS) -> Show (L2 p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> L2 p -> ShowS
forall k (p :: k). [L2 p] -> ShowS
forall k (p :: k). L2 p -> String
showList :: [L2 p] -> ShowS
$cshowList :: forall k (p :: k). [L2 p] -> ShowS
show :: L2 p -> String
$cshow :: forall k (p :: k). L2 p -> String
showsPrec :: Int -> L2 p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> L2 p -> ShowS
Show
instance ( Show (ExtractL2T (PP p x))
, ExtractL2C (PP p x)
, P p x
, Show (PP p x)
) => P (L2 p) x where
type PP (L2 p) x = ExtractL2T (PP p x)
eval :: proxy (L2 p) -> POpts -> x -> m (TT (PP (L2 p) x))
eval proxy (L2 p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Snd"
TT (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
TT (ExtractL2T (PP p x)) -> m (TT (ExtractL2T (PP p x)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (ExtractL2T (PP p x)) -> m (TT (ExtractL2T (PP p x))))
-> TT (ExtractL2T (PP p x)) -> m (TT (ExtractL2T (PP p x)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT (ExtractL2T (PP p x))) (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 p x)
pp [] of
Left TT (ExtractL2T (PP p x))
e -> TT (ExtractL2T (PP p x))
e
Right PP p x
p ->
let b :: ExtractL2T (PP p x)
b = PP p x -> ExtractL2T (PP p x)
forall tp. ExtractL2C tp => tp -> ExtractL2T tp
extractL2C PP p x
p
in POpts
-> Val (ExtractL2T (PP p x))
-> String
-> [Tree PE]
-> TT (ExtractL2T (PP p x))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (ExtractL2T (PP p x) -> Val (ExtractL2T (PP p x))
forall a. a -> Val a
Val ExtractL2T (PP p x)
b) (POpts -> String -> ExtractL2T (PP p x) -> PP p x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 ExtractL2T (PP p x)
b PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]
data Snd deriving Int -> Snd -> ShowS
[Snd] -> ShowS
Snd -> String
(Int -> Snd -> ShowS)
-> (Snd -> String) -> ([Snd] -> ShowS) -> Show Snd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Snd] -> ShowS
$cshowList :: [Snd] -> ShowS
show :: Snd -> String
$cshow :: Snd -> String
showsPrec :: Int -> Snd -> ShowS
$cshowsPrec :: Int -> Snd -> ShowS
Show
type SndT = L2 Id
instance P SndT x => P Snd x where
type PP Snd x = PP SndT x
eval :: proxy Snd -> POpts -> x -> m (TT (PP Snd x))
eval proxy Snd
_ = Proxy SndT -> POpts -> x -> m (TT (PP SndT 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 SndT
forall k (t :: k). Proxy t
Proxy @SndT)
data L3 p deriving Int -> L3 p -> ShowS
[L3 p] -> ShowS
L3 p -> String
(Int -> L3 p -> ShowS)
-> (L3 p -> String) -> ([L3 p] -> ShowS) -> Show (L3 p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> L3 p -> ShowS
forall k (p :: k). [L3 p] -> ShowS
forall k (p :: k). L3 p -> String
showList :: [L3 p] -> ShowS
$cshowList :: forall k (p :: k). [L3 p] -> ShowS
show :: L3 p -> String
$cshow :: forall k (p :: k). L3 p -> String
showsPrec :: Int -> L3 p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> L3 p -> ShowS
Show
instance ( Show (ExtractL3T (PP p x))
, ExtractL3C (PP p x)
, P p x
, Show (PP p x)
) => P (L3 p) x where
type PP (L3 p) x = ExtractL3T (PP p x)
eval :: proxy (L3 p) -> POpts -> x -> m (TT (PP (L3 p) x))
eval proxy (L3 p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Thd"
TT (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
TT (ExtractL3T (PP p x)) -> m (TT (ExtractL3T (PP p x)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (ExtractL3T (PP p x)) -> m (TT (ExtractL3T (PP p x))))
-> TT (ExtractL3T (PP p x)) -> m (TT (ExtractL3T (PP p x)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT (ExtractL3T (PP p x))) (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 p x)
pp [] of
Left TT (ExtractL3T (PP p x))
e -> TT (ExtractL3T (PP p x))
e
Right PP p x
p ->
let b :: ExtractL3T (PP p x)
b = PP p x -> ExtractL3T (PP p x)
forall tp. ExtractL3C tp => tp -> ExtractL3T tp
extractL3C PP p x
p
in POpts
-> Val (ExtractL3T (PP p x))
-> String
-> [Tree PE]
-> TT (ExtractL3T (PP p x))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (ExtractL3T (PP p x) -> Val (ExtractL3T (PP p x))
forall a. a -> Val a
Val ExtractL3T (PP p x)
b) (POpts -> String -> ExtractL3T (PP p x) -> PP p x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 ExtractL3T (PP p x)
b PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]
data Thd deriving Int -> Thd -> ShowS
[Thd] -> ShowS
Thd -> String
(Int -> Thd -> ShowS)
-> (Thd -> String) -> ([Thd] -> ShowS) -> Show Thd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Thd] -> ShowS
$cshowList :: [Thd] -> ShowS
show :: Thd -> String
$cshow :: Thd -> String
showsPrec :: Int -> Thd -> ShowS
$cshowsPrec :: Int -> Thd -> ShowS
Show
type ThdT = L3 Id
instance P ThdT x => P Thd x where
type PP Thd x = PP ThdT x
eval :: proxy Thd -> POpts -> x -> m (TT (PP Thd x))
eval proxy Thd
_ = Proxy ThdT -> POpts -> x -> m (TT (PP ThdT 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 ThdT
forall k (t :: k). Proxy t
Proxy @ThdT)
data L4 p deriving Int -> L4 p -> ShowS
[L4 p] -> ShowS
L4 p -> String
(Int -> L4 p -> ShowS)
-> (L4 p -> String) -> ([L4 p] -> ShowS) -> Show (L4 p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> L4 p -> ShowS
forall k (p :: k). [L4 p] -> ShowS
forall k (p :: k). L4 p -> String
showList :: [L4 p] -> ShowS
$cshowList :: forall k (p :: k). [L4 p] -> ShowS
show :: L4 p -> String
$cshow :: forall k (p :: k). L4 p -> String
showsPrec :: Int -> L4 p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> L4 p -> ShowS
Show
instance ( Show (ExtractL4T (PP p x))
, ExtractL4C (PP p x)
, P p x
, Show (PP p x)
) => P (L4 p) x where
type PP (L4 p) x = ExtractL4T (PP p x)
eval :: proxy (L4 p) -> POpts -> x -> m (TT (PP (L4 p) x))
eval proxy (L4 p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"L4"
TT (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
TT (ExtractL4T (PP p x)) -> m (TT (ExtractL4T (PP p x)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (ExtractL4T (PP p x)) -> m (TT (ExtractL4T (PP p x))))
-> TT (ExtractL4T (PP p x)) -> m (TT (ExtractL4T (PP p x)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT (ExtractL4T (PP p x))) (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 p x)
pp [] of
Left TT (ExtractL4T (PP p x))
e -> TT (ExtractL4T (PP p x))
e
Right PP p x
p ->
let b :: ExtractL4T (PP p x)
b = PP p x -> ExtractL4T (PP p x)
forall tp. ExtractL4C tp => tp -> ExtractL4T tp
extractL4C PP p x
p
in POpts
-> Val (ExtractL4T (PP p x))
-> String
-> [Tree PE]
-> TT (ExtractL4T (PP p x))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (ExtractL4T (PP p x) -> Val (ExtractL4T (PP p x))
forall a. a -> Val a
Val ExtractL4T (PP p x)
b) (POpts -> String -> ExtractL4T (PP p x) -> PP p x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 ExtractL4T (PP p x)
b PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]
data L5 p deriving Int -> L5 p -> ShowS
[L5 p] -> ShowS
L5 p -> String
(Int -> L5 p -> ShowS)
-> (L5 p -> String) -> ([L5 p] -> ShowS) -> Show (L5 p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> L5 p -> ShowS
forall k (p :: k). [L5 p] -> ShowS
forall k (p :: k). L5 p -> String
showList :: [L5 p] -> ShowS
$cshowList :: forall k (p :: k). [L5 p] -> ShowS
show :: L5 p -> String
$cshow :: forall k (p :: k). L5 p -> String
showsPrec :: Int -> L5 p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> L5 p -> ShowS
Show
instance ( Show (ExtractL5T (PP p x))
, ExtractL5C (PP p x)
, P p x
, Show (PP p x)
) => P (L5 p) x where
type PP (L5 p) x = ExtractL5T (PP p x)
eval :: proxy (L5 p) -> POpts -> x -> m (TT (PP (L5 p) x))
eval proxy (L5 p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"L5"
TT (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
TT (ExtractL5T (PP p x)) -> m (TT (ExtractL5T (PP p x)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (ExtractL5T (PP p x)) -> m (TT (ExtractL5T (PP p x))))
-> TT (ExtractL5T (PP p x)) -> m (TT (ExtractL5T (PP p x)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT (ExtractL5T (PP p x))) (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 p x)
pp [] of
Left TT (ExtractL5T (PP p x))
e -> TT (ExtractL5T (PP p x))
e
Right PP p x
p ->
let b :: ExtractL5T (PP p x)
b = PP p x -> ExtractL5T (PP p x)
forall tp. ExtractL5C tp => tp -> ExtractL5T tp
extractL5C PP p x
p
in POpts
-> Val (ExtractL5T (PP p x))
-> String
-> [Tree PE]
-> TT (ExtractL5T (PP p x))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (ExtractL5T (PP p x) -> Val (ExtractL5T (PP p x))
forall a. a -> Val a
Val ExtractL5T (PP p x)
b) (POpts -> String -> ExtractL5T (PP p x) -> PP p x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 ExtractL5T (PP p x)
b PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]
data L6 p deriving Int -> L6 p -> ShowS
[L6 p] -> ShowS
L6 p -> String
(Int -> L6 p -> ShowS)
-> (L6 p -> String) -> ([L6 p] -> ShowS) -> Show (L6 p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> L6 p -> ShowS
forall k (p :: k). [L6 p] -> ShowS
forall k (p :: k). L6 p -> String
showList :: [L6 p] -> ShowS
$cshowList :: forall k (p :: k). [L6 p] -> ShowS
show :: L6 p -> String
$cshow :: forall k (p :: k). L6 p -> String
showsPrec :: Int -> L6 p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> L6 p -> ShowS
Show
instance ( Show (ExtractL6T (PP p x))
, ExtractL6C (PP p x)
, P p x
, Show (PP p x)
) => P (L6 p) x where
type PP (L6 p) x = ExtractL6T (PP p x)
eval :: proxy (L6 p) -> POpts -> x -> m (TT (PP (L6 p) x))
eval proxy (L6 p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"L6"
TT (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
TT (ExtractL6T (PP p x)) -> m (TT (ExtractL6T (PP p x)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (ExtractL6T (PP p x)) -> m (TT (ExtractL6T (PP p x))))
-> TT (ExtractL6T (PP p x)) -> m (TT (ExtractL6T (PP p x)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT (ExtractL6T (PP p x))) (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 p x)
pp [] of
Left TT (ExtractL6T (PP p x))
e -> TT (ExtractL6T (PP p x))
e
Right PP p x
p ->
let b :: ExtractL6T (PP p x)
b = PP p x -> ExtractL6T (PP p x)
forall tp. ExtractL6C tp => tp -> ExtractL6T tp
extractL6C PP p x
p
in POpts
-> Val (ExtractL6T (PP p x))
-> String
-> [Tree PE]
-> TT (ExtractL6T (PP p x))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (ExtractL6T (PP p x) -> Val (ExtractL6T (PP p x))
forall a. a -> Val a
Val ExtractL6T (PP p x)
b) (POpts -> String -> ExtractL6T (PP p x) -> PP p x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 ExtractL6T (PP p x)
b PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]
data L7 p deriving Int -> L7 p -> ShowS
[L7 p] -> ShowS
L7 p -> String
(Int -> L7 p -> ShowS)
-> (L7 p -> String) -> ([L7 p] -> ShowS) -> Show (L7 p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> L7 p -> ShowS
forall k (p :: k). [L7 p] -> ShowS
forall k (p :: k). L7 p -> String
showList :: [L7 p] -> ShowS
$cshowList :: forall k (p :: k). [L7 p] -> ShowS
show :: L7 p -> String
$cshow :: forall k (p :: k). L7 p -> String
showsPrec :: Int -> L7 p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> L7 p -> ShowS
Show
instance ( Show (ExtractL7T (PP p x))
, ExtractL7C (PP p x)
, P p x
, Show (PP p x)
) => P (L7 p) x where
type PP (L7 p) x = ExtractL7T (PP p x)
eval :: proxy (L7 p) -> POpts -> x -> m (TT (PP (L7 p) x))
eval proxy (L7 p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"L7"
TT (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
TT (ExtractL7T (PP p x)) -> m (TT (ExtractL7T (PP p x)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (ExtractL7T (PP p x)) -> m (TT (ExtractL7T (PP p x))))
-> TT (ExtractL7T (PP p x)) -> m (TT (ExtractL7T (PP p x)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT (ExtractL7T (PP p x))) (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 p x)
pp [] of
Left TT (ExtractL7T (PP p x))
e -> TT (ExtractL7T (PP p x))
e
Right PP p x
p ->
let b :: ExtractL7T (PP p x)
b = PP p x -> ExtractL7T (PP p x)
forall tp. ExtractL7C tp => tp -> ExtractL7T tp
extractL7C PP p x
p
in POpts
-> Val (ExtractL7T (PP p x))
-> String
-> [Tree PE]
-> TT (ExtractL7T (PP p x))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (ExtractL7T (PP p x) -> Val (ExtractL7T (PP p x))
forall a. a -> Val a
Val ExtractL7T (PP p x)
b) (POpts -> String -> ExtractL7T (PP p x) -> PP p x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 ExtractL7T (PP p x)
b PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]
data L8 p deriving Int -> L8 p -> ShowS
[L8 p] -> ShowS
L8 p -> String
(Int -> L8 p -> ShowS)
-> (L8 p -> String) -> ([L8 p] -> ShowS) -> Show (L8 p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> L8 p -> ShowS
forall k (p :: k). [L8 p] -> ShowS
forall k (p :: k). L8 p -> String
showList :: [L8 p] -> ShowS
$cshowList :: forall k (p :: k). [L8 p] -> ShowS
show :: L8 p -> String
$cshow :: forall k (p :: k). L8 p -> String
showsPrec :: Int -> L8 p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> L8 p -> ShowS
Show
instance ( Show (ExtractL8T (PP p x))
, ExtractL8C (PP p x)
, P p x
, Show (PP p x)
) => P (L8 p) x where
type PP (L8 p) x = ExtractL8T (PP p x)
eval :: proxy (L8 p) -> POpts -> x -> m (TT (PP (L8 p) x))
eval proxy (L8 p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"L8"
TT (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
TT (ExtractL8T (PP p x)) -> m (TT (ExtractL8T (PP p x)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (ExtractL8T (PP p x)) -> m (TT (ExtractL8T (PP p x))))
-> TT (ExtractL8T (PP p x)) -> m (TT (ExtractL8T (PP p x)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT (ExtractL8T (PP p x))) (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 p x)
pp [] of
Left TT (ExtractL8T (PP p x))
e -> TT (ExtractL8T (PP p x))
e
Right PP p x
p ->
let b :: ExtractL8T (PP p x)
b = PP p x -> ExtractL8T (PP p x)
forall tp. ExtractL8C tp => tp -> ExtractL8T tp
extractL8C PP p x
p
in POpts
-> Val (ExtractL8T (PP p x))
-> String
-> [Tree PE]
-> TT (ExtractL8T (PP p x))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (ExtractL8T (PP p x) -> Val (ExtractL8T (PP p x))
forall a. a -> Val a
Val ExtractL8T (PP p x)
b) (POpts -> String -> ExtractL8T (PP p x) -> PP p x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 ExtractL8T (PP p x)
b PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]
data Map' p q deriving Int -> Map' p q -> ShowS
[Map' p q] -> ShowS
Map' p q -> String
(Int -> Map' p q -> ShowS)
-> (Map' p q -> String) -> ([Map' p q] -> ShowS) -> Show (Map' p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Map' p q -> ShowS
forall k (p :: k) k (q :: k). [Map' p q] -> ShowS
forall k (p :: k) k (q :: k). Map' p q -> String
showList :: [Map' p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Map' p q] -> ShowS
show :: Map' p q -> String
$cshow :: forall k (p :: k) k (q :: k). Map' p q -> String
showsPrec :: Int -> Map' p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Map' p q -> ShowS
Show
instance ( Show (PP p a)
, P p a
, PP q x ~ f a
, P q x
, Show a
, Show (f a)
, Foldable f
) => P (Map' p q) x where
type PP (Map' p q) x = [PP p (ExtractAFromTA (PP q x))]
eval :: proxy (Map' p q) -> POpts -> x -> m (TT (PP (Map' p q) x))
eval proxy (Map' p q)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Map"
TT (f a)
qq <- Proxy q -> POpts -> x -> m (TT (PP 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 q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x
case Inline
-> POpts
-> String
-> TT (f a)
-> [Tree PE]
-> Either (TT [PP p a]) (f a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (f a)
qq [] of
Left TT [PP p a]
e -> TT [PP p a] -> m (TT [PP p a])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT [PP p a]
e
Right f a
q -> do
case POpts
-> String -> f a -> [Tree PE] -> Either (TT [PP p a]) (Int, [a])
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) (Int, [a])
chkSize POpts
opts String
msg0 f a
q [TT (f a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (f a)
qq] of
Left TT [PP p a]
e -> TT [PP p a] -> m (TT [PP p a])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT [PP p a]
e
Right (Int
_,[a]
xs) -> do
[((Int, a), TT (PP p a))]
ts <- (Int -> a -> m ((Int, a), TT (PP p a)))
-> [Int] -> [a] -> m [((Int, a), TT (PP p a))]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Int
i a
a -> ((Int
i, a
a),) (TT (PP p a) -> ((Int, a), TT (PP p a)))
-> m (TT (PP p a)) -> m ((Int, a), TT (PP p a))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type).
(MonadEval m, P p a) =>
POpts -> a -> m (TT (PP p a))
evalHide @p POpts
opts a
a) [Int
0::Int ..] [a]
xs
TT [PP p a] -> m (TT [PP p a])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [PP p a] -> m (TT [PP p a])) -> TT [PP p a] -> m (TT [PP p a])
forall a b. (a -> b) -> a -> b
$ case POpts
-> String
-> [((Int, a), TT (PP p a))]
-> Either (TT [PP p a]) [(PP p a, (Int, a), TT (PP p a))]
forall x a w.
Show x =>
POpts
-> String
-> [((Int, x), TT a)]
-> Either (TT w) [(a, (Int, x), TT a)]
splitAndAlign POpts
opts String
msg0 [((Int, a), TT (PP p a))]
ts of
Left TT [PP p a]
e -> TT [PP p a]
e
Right [(PP p a, (Int, a), TT (PP p a))]
abcs ->
let vals :: [PP p a]
vals = ((PP p a, (Int, a), TT (PP p a)) -> PP p a)
-> [(PP p a, (Int, a), TT (PP p a))] -> [PP p a]
forall a b. (a -> b) -> [a] -> [b]
map (Getting (PP p a) (PP p a, (Int, a), TT (PP p a)) (PP p a)
-> (PP p a, (Int, a), TT (PP p a)) -> PP p a
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting (PP p a) (PP p a, (Int, a), TT (PP p a)) (PP p a)
forall s t a b. Field1 s t a b => Lens s t a b
_1) [(PP p a, (Int, a), TT (PP p a))]
abcs
in POpts -> Val [PP p a] -> String -> [Tree PE] -> TT [PP p a]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([PP p a] -> Val [PP p a]
forall a. a -> Val a
Val [PP p a]
vals) (POpts -> String -> [PP p a] -> f a -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 [PP p a]
vals f a
q) (TT (f a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (f a)
qq Tree PE -> [Tree PE] -> [Tree PE]
forall a. a -> [a] -> [a]
: (((Int, a), TT (PP p a)) -> Tree PE)
-> [((Int, a), TT (PP p a))] -> [Tree PE]
forall a b. (a -> b) -> [a] -> [b]
map (TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh (TT (PP p a) -> Tree PE)
-> (((Int, a), TT (PP p a)) -> TT (PP p a))
-> ((Int, a), TT (PP p a))
-> Tree PE
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, a), TT (PP p a)) -> TT (PP p a)
forall x a. ((Int, x), TT a) -> TT a
prefixNumberToTT) [((Int, a), TT (PP p a))]
ts)
data Map p deriving Int -> Map p -> ShowS
[Map p] -> ShowS
Map p -> String
(Int -> Map p -> ShowS)
-> (Map p -> String) -> ([Map p] -> ShowS) -> Show (Map p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> Map p -> ShowS
forall k (p :: k). [Map p] -> ShowS
forall k (p :: k). Map p -> String
showList :: [Map p] -> ShowS
$cshowList :: forall k (p :: k). [Map p] -> ShowS
show :: Map p -> String
$cshow :: forall k (p :: k). Map p -> String
showsPrec :: Int -> Map p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> Map p -> ShowS
Show
instance ( Show (PP p a)
, P p a
, x ~ [a]
, Show a
) => P (Map p) x where
type PP (Map p) x = [PP p (ExtractAFromTA x)]
eval :: proxy (Map p) -> POpts -> x -> m (TT (PP (Map p) x))
eval proxy (Map p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Map"
case POpts
-> String -> [a] -> [Tree PE] -> Either (TT [PP p a]) (Int, [a])
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) (Int, [a])
chkSize POpts
opts String
msg0 x
[a]
x [] of
Left TT [PP p a]
e -> TT [PP p a] -> m (TT [PP p a])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT [PP p a]
e
Right (Int
_,[a]
xs) -> do
[((Int, a), TT (PP p a))]
ts <- (Int -> a -> m ((Int, a), TT (PP p a)))
-> [Int] -> [a] -> m [((Int, a), TT (PP p a))]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Int
i a
a -> ((Int
i, a
a),) (TT (PP p a) -> ((Int, a), TT (PP p a)))
-> m (TT (PP p a)) -> m ((Int, a), TT (PP p a))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type).
(MonadEval m, P p a) =>
POpts -> a -> m (TT (PP p a))
evalHide @p POpts
opts a
a) [Int
0::Int ..] [a]
xs
TT [PP p a] -> m (TT [PP p a])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [PP p a] -> m (TT [PP p a])) -> TT [PP p a] -> m (TT [PP p a])
forall a b. (a -> b) -> a -> b
$ case POpts
-> String
-> [((Int, a), TT (PP p a))]
-> Either (TT [PP p a]) [(PP p a, (Int, a), TT (PP p a))]
forall x a w.
Show x =>
POpts
-> String
-> [((Int, x), TT a)]
-> Either (TT w) [(a, (Int, x), TT a)]
splitAndAlign POpts
opts String
msg0 [((Int, a), TT (PP p a))]
ts of
Left TT [PP p a]
e -> TT [PP p a]
e
Right [(PP p a, (Int, a), TT (PP p a))]
abcs ->
let vals :: [PP p a]
vals = ((PP p a, (Int, a), TT (PP p a)) -> PP p a)
-> [(PP p a, (Int, a), TT (PP p a))] -> [PP p a]
forall a b. (a -> b) -> [a] -> [b]
map (Getting (PP p a) (PP p a, (Int, a), TT (PP p a)) (PP p a)
-> (PP p a, (Int, a), TT (PP p a)) -> PP p a
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting (PP p a) (PP p a, (Int, a), TT (PP p a)) (PP p a)
forall s t a b. Field1 s t a b => Lens s t a b
_1) [(PP p a, (Int, a), TT (PP p a))]
abcs
in POpts -> Val [PP p a] -> String -> [Tree PE] -> TT [PP p a]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([PP p a] -> Val [PP p a]
forall a. a -> Val a
Val [PP p a]
vals) (POpts -> String -> [PP p a] -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 [PP p a]
vals x
x) ((((Int, a), TT (PP p a)) -> Tree PE)
-> [((Int, a), TT (PP p a))] -> [Tree PE]
forall a b. (a -> b) -> [a] -> [b]
map (TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh (TT (PP p a) -> Tree PE)
-> (((Int, a), TT (PP p a)) -> TT (PP p a))
-> ((Int, a), TT (PP p a))
-> Tree PE
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, a), TT (PP p a)) -> TT (PP p a)
forall x a. ((Int, x), TT a) -> TT a
prefixNumberToTT) [((Int, a), TT (PP p a))]
ts)
data Do (ps :: [k]) deriving Int -> Do ps -> ShowS
[Do ps] -> ShowS
Do ps -> String
(Int -> Do ps -> ShowS)
-> (Do ps -> String) -> ([Do ps] -> ShowS) -> Show (Do ps)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (ps :: [k]). Int -> Do ps -> ShowS
forall k (ps :: [k]). [Do ps] -> ShowS
forall k (ps :: [k]). Do ps -> String
showList :: [Do ps] -> ShowS
$cshowList :: forall k (ps :: [k]). [Do ps] -> ShowS
show :: Do ps -> String
$cshow :: forall k (ps :: [k]). Do ps -> String
showsPrec :: Int -> Do ps -> ShowS
$cshowsPrec :: forall k (ps :: [k]). Int -> Do ps -> ShowS
Show
instance (P (DoExpandT ps) a) => P (Do ps) a where
type PP (Do ps) a = PP (DoExpandT ps) a
eval :: proxy (Do ps) -> POpts -> a -> m (TT (PP (Do ps) a))
eval proxy (Do ps)
_ = Proxy (DoExpandT ps) -> POpts -> a -> m (TT (PP (DoExpandT ps) 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 (DoExpandT ps)
forall k (t :: k). Proxy t
Proxy @(DoExpandT ps))
type family DoExpandT (ps :: [k]) :: Type where
DoExpandT '[] = GL.TypeError ('GL.Text "DoExpandT '[] invalid: requires at least one predicate in the list")
DoExpandT '[p] = W p
DoExpandT (p ': p1 ': ps) = p >> DoExpandT (p1 ': ps)
data DoL (ps :: [k]) deriving Int -> DoL ps -> ShowS
[DoL ps] -> ShowS
DoL ps -> String
(Int -> DoL ps -> ShowS)
-> (DoL ps -> String) -> ([DoL ps] -> ShowS) -> Show (DoL ps)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (ps :: [k]). Int -> DoL ps -> ShowS
forall k (ps :: [k]). [DoL ps] -> ShowS
forall k (ps :: [k]). DoL ps -> String
showList :: [DoL ps] -> ShowS
$cshowList :: forall k (ps :: [k]). [DoL ps] -> ShowS
show :: DoL ps -> String
$cshow :: forall k (ps :: [k]). DoL ps -> String
showsPrec :: Int -> DoL ps -> ShowS
$cshowsPrec :: forall k (ps :: [k]). Int -> DoL ps -> ShowS
Show
instance (P (DoExpandLT ps) a) => P (DoL ps) a where
type PP (DoL ps) a = PP (DoExpandLT ps) a
eval :: proxy (DoL ps) -> POpts -> a -> m (TT (PP (DoL ps) a))
eval proxy (DoL ps)
_ = Proxy (DoExpandLT ps)
-> POpts -> a -> m (TT (PP (DoExpandLT ps) 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 (DoExpandLT ps)
forall k (t :: k). Proxy t
Proxy @(DoExpandLT ps))
type family DoExpandLT (ps :: [k]) :: Type where
DoExpandLT '[] = GL.TypeError ('GL.Text "DoExpandT '[] invalid: requires at least one predicate in the list")
DoExpandLT '[p] = W p
DoExpandLT (p ': p1 ': '[]) = p >> p1
DoExpandLT (p ': p1 ': p2 ': ps) = (p >> p1) >> DoExpandLT (p2 ': ps)
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
infixr 3 &&
instance ( P p a
, P q a
, PP p a ~ Bool
, PP q a ~ Bool
) => P (p && q) a where
type PP (p && q) a = Bool
eval :: proxy (p && q) -> POpts -> a -> m (TT (PP (p && q) a))
eval proxy (p && q)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"&&"
Either (TT Bool) (Bool, Bool, TT Bool, TT Bool)
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT Bool) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k k (p :: k) a (q :: k) (m :: Type -> Type)
(proxy1 :: k -> Type) (proxy2 :: k -> Type) x.
(P p a, PP p a ~ Bool, P q a, PP q a ~ Bool, 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)))
runPQBool 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 Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Bool -> m (TT Bool)) -> TT Bool -> m (TT Bool)
forall a b. (a -> b) -> a -> b
$ case Either (TT Bool) (Bool, Bool, TT Bool, TT Bool)
lr of
Left TT Bool
e -> TT Bool
e
Right (Bool
p,Bool
q,TT Bool
pp,TT Bool
qq) ->
let zz :: String
zz = case (Bool
p,Bool
q) of
(Bool
True, Bool
True) -> String
""
(Bool
False, Bool
True) -> TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
pp
(Bool
True, Bool
False) -> TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
qq
(Bool
False, Bool
False) -> TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
pp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
qq
in POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts (Bool
pBool -> Bool -> Bool
&&Bool
q) (POpts -> Bool -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Bool
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> ShowS
joinStrings (POpts -> Bool -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Bool
q) String
zz) [TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
pp, TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
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
infixr 3 &&~
instance ( P p a
, P q a
, PP p a ~ Bool
, PP q a ~ Bool
) => P (p &&~ q) a where
type PP (p &&~ q) a = Bool
eval :: proxy (p &&~ q) -> POpts -> a -> m (TT (PP (p &&~ q) a))
eval proxy (p &&~ q)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"&&~"
TT Bool
pp <- Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
a
case Inline
-> POpts -> String -> TT Bool -> [Tree PE] -> Either (TT Bool) Bool
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT Bool
pp [] of
Left TT Bool
e -> TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT Bool
e
Right Bool
False ->
TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Bool -> m (TT Bool)) -> TT Bool -> m (TT Bool)
forall a b. (a -> b) -> a -> b
$ POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts Bool
False (String
"False " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" _" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> ShowS
litVerbose POpts
opts String
" | " (TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
pp)) [TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
pp]
Right Bool
True -> do
TT Bool
qq <- Proxy q -> POpts -> a -> m (TT (PP q a))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a
TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Bool -> m (TT Bool)) -> TT Bool -> m (TT Bool)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts -> String -> TT Bool -> [Tree PE] -> Either (TT Bool) Bool
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT Bool
qq [TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
pp] of
Left TT Bool
e -> TT Bool
e
Right Bool
q ->
let zz :: String
zz = if Bool
q then String
""
else String
" | " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
qq
in POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts Bool
q (String
"True " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Bool -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Bool
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> ShowS
litVerbose POpts
opts String
"" String
zz) [TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
pp, TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
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
infixr 2 ||
instance ( P p a
, P q a
, PP p a ~ Bool
, PP q a ~ Bool
) => P (p || q) a where
type PP (p || q) a = Bool
eval :: proxy (p || q) -> POpts -> a -> m (TT (PP (p || q) a))
eval proxy (p || q)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"||"
Either (TT Bool) (Bool, Bool, TT Bool, TT Bool)
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT Bool) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k k (p :: k) a (q :: k) (m :: Type -> Type)
(proxy1 :: k -> Type) (proxy2 :: k -> Type) x.
(P p a, PP p a ~ Bool, P q a, PP q a ~ Bool, 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)))
runPQBool 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 Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Bool -> m (TT Bool)) -> TT Bool -> m (TT Bool)
forall a b. (a -> b) -> a -> b
$ case Either (TT Bool) (Bool, Bool, TT Bool, TT Bool)
lr of
Left TT Bool
e -> TT Bool
e
Right (Bool
p,Bool
q,TT Bool
pp,TT Bool
qq) ->
let zz :: String
zz = case (Bool
p,Bool
q) of
(Bool
False,Bool
False) -> String
" | " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
pp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
qq
(Bool, Bool)
_ -> String
""
in POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts (Bool
pBool -> Bool -> Bool
||Bool
q) (POpts -> Bool -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Bool
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Bool -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Bool
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
zz) [TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
pp, TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
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
infixr 2 ||~
instance ( P p a
, P q a
, PP p a ~ Bool
, PP q a ~ Bool
) => P (p ||~ q) a where
type PP (p ||~ q) a = Bool
eval :: proxy (p ||~ q) -> POpts -> a -> m (TT (PP (p ||~ q) a))
eval proxy (p ||~ q)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"||~"
TT Bool
pp <- Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
a
case Inline
-> POpts -> String -> TT Bool -> [Tree PE] -> Either (TT Bool) Bool
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT Bool
pp [] of
Left TT Bool
e -> TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT Bool
e
Right Bool
False -> do
TT Bool
qq <- Proxy q -> POpts -> a -> m (TT (PP q a))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a
TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Bool -> m (TT Bool)) -> TT Bool -> m (TT Bool)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts -> String -> TT Bool -> [Tree PE] -> Either (TT Bool) Bool
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT Bool
qq [TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
pp] of
Left TT Bool
e -> TT Bool
e
Right Bool
q ->
let zz :: String
zz = if Bool
q then String
""
else String
" | " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
pp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
qq
in POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts Bool
q (String
"False " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Bool -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Bool
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> ShowS
litVerbose POpts
opts String
"" String
zz) [TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
pp, TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
qq]
Right Bool
True ->
TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Bool -> m (TT Bool)) -> TT Bool -> m (TT Bool)
forall a b. (a -> b) -> a -> b
$ POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts Bool
True (String
"True " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" _" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> ShowS
litVerbose POpts
opts String
" | " (TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
pp)) [TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
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
infixr 1 ~>
instance ( P p a
, P q a
, PP p a ~ Bool
, PP q a ~ Bool
) => P (p ~> q) a where
type PP (p ~> q) a = Bool
eval :: proxy (p ~> q) -> POpts -> a -> m (TT (PP (p ~> q) a))
eval proxy (p ~> q)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"~>"
Either (TT Bool) (Bool, Bool, TT Bool, TT Bool)
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT Bool) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k k (p :: k) a (q :: k) (m :: Type -> Type)
(proxy1 :: k -> Type) (proxy2 :: k -> Type) x.
(P p a, PP p a ~ Bool, P q a, PP q a ~ Bool, 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)))
runPQBool 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 Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Bool -> m (TT Bool)) -> TT Bool -> m (TT Bool)
forall a b. (a -> b) -> a -> b
$ case Either (TT Bool) (Bool, Bool, TT Bool, TT Bool)
lr of
Left TT Bool
e -> TT Bool
e
Right (Bool
p,Bool
q,TT Bool
pp,TT Bool
qq) ->
let zz :: String
zz = case (Bool
p,Bool
q) of
(Bool
True,Bool
False) -> TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
pp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
qq
(Bool, Bool)
_ -> String
""
in POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts (Bool
pBool -> Bool -> Bool
~>Bool
q) (POpts -> Bool -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Bool
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> ShowS
joinStrings (POpts -> Bool -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Bool
q) String
zz) [TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
pp, TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
qq]
data Swap deriving Int -> Swap -> ShowS
[Swap] -> ShowS
Swap -> String
(Int -> Swap -> ShowS)
-> (Swap -> String) -> ([Swap] -> ShowS) -> Show Swap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Swap] -> ShowS
$cshowList :: [Swap] -> ShowS
show :: Swap -> String
$cshow :: Swap -> String
showsPrec :: Int -> Swap -> ShowS
$cshowsPrec :: Int -> Swap -> ShowS
Show
instance ( Show (p a b)
, SwapC p
, Show (p b a)
) => P Swap (p a b) where
type PP Swap (p a b) = p b a
eval :: proxy Swap -> POpts -> p a b -> m (TT (PP Swap (p a b)))
eval proxy Swap
_ POpts
opts p a b
pabx =
let msg0 :: String
msg0 = String
"Swap"
d :: p b a
d = p a b -> p b a
forall (p :: Type -> Type -> Type) a b. SwapC p => p a b -> p b a
swapC p a b
pabx
in TT (p b a) -> m (TT (p b a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (p b a) -> m (TT (p b a))) -> TT (p b a) -> m (TT (p b a))
forall a b. (a -> b) -> a -> b
$ POpts -> Val (p b a) -> String -> [Tree PE] -> TT (p b a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (p b a -> Val (p b a)
forall a. a -> Val a
Val p b a
d) (POpts -> String -> p b a -> p a b -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 p b a
d p a b
pabx) []
data (p :: k -> k1) $ (q :: k) 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 k1 k (p :: k -> k1) (q :: k). Int -> (p $ q) -> ShowS
forall k1 k (p :: k -> k1) (q :: k). [p $ q] -> ShowS
forall k1 k (p :: k -> k1) (q :: k). (p $ q) -> String
showList :: [p $ q] -> ShowS
$cshowList :: forall k1 k (p :: k -> k1) (q :: k). [p $ q] -> ShowS
show :: (p $ q) -> String
$cshow :: forall k1 k (p :: k -> k1) (q :: k). (p $ q) -> String
showsPrec :: Int -> (p $ q) -> ShowS
$cshowsPrec :: forall k1 k (p :: k -> k1) (q :: k). Int -> (p $ q) -> ShowS
Show
infixr 0 $
instance P (p q) a => P (p $ q) a where
type PP (p $ q) a = PP (p q) a
eval :: proxy (p $ q) -> POpts -> a -> m (TT (PP (p $ q) a))
eval proxy (p $ q)
_ = Proxy (p q) -> POpts -> a -> m (TT (PP (p 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 (p q)
forall k (t :: k). Proxy t
Proxy @(p q))
data (q :: k) & (p :: k -> k1) 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) k1 (p :: k -> k1). Int -> (q & p) -> ShowS
forall k (q :: k) k1 (p :: k -> k1). [q & p] -> ShowS
forall k (q :: k) k1 (p :: k -> k1). (q & p) -> String
showList :: [q & p] -> ShowS
$cshowList :: forall k (q :: k) k1 (p :: k -> k1). [q & p] -> ShowS
show :: (q & p) -> String
$cshow :: forall k (q :: k) k1 (p :: k -> k1). (q & p) -> String
showsPrec :: Int -> (q & p) -> ShowS
$cshowsPrec :: forall k (q :: k) k1 (p :: k -> k1). Int -> (q & p) -> ShowS
Show
infixl 1 &
instance P (p q) a => P (q & p) a where
type PP (q & p) a = PP (p q) a
eval :: proxy (q & p) -> POpts -> a -> m (TT (PP (q & p) a))
eval proxy (q & p)
_ = Proxy (p q) -> POpts -> a -> m (TT (PP (p 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 (p q)
forall k (t :: k). Proxy t
Proxy @(p q))
data L11 deriving Int -> L11 -> ShowS
[L11] -> ShowS
L11 -> String
(Int -> L11 -> ShowS)
-> (L11 -> String) -> ([L11] -> ShowS) -> Show L11
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [L11] -> ShowS
$cshowList :: [L11] -> ShowS
show :: L11 -> String
$cshow :: L11 -> String
showsPrec :: Int -> L11 -> ShowS
$cshowsPrec :: Int -> L11 -> ShowS
Show
type L11T = MsgI "L11:" (L1 (L1 Id))
instance P L11T x => P L11 x where
type PP L11 x = PP L11T x
eval :: proxy L11 -> POpts -> x -> m (TT (PP L11 x))
eval proxy L11
_ = Proxy L11T -> POpts -> x -> m (TT (PP L11T 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 L11T
forall k (t :: k). Proxy t
Proxy @L11T)
data L12 deriving Int -> L12 -> ShowS
[L12] -> ShowS
L12 -> String
(Int -> L12 -> ShowS)
-> (L12 -> String) -> ([L12] -> ShowS) -> Show L12
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [L12] -> ShowS
$cshowList :: [L12] -> ShowS
show :: L12 -> String
$cshow :: L12 -> String
showsPrec :: Int -> L12 -> ShowS
$cshowsPrec :: Int -> L12 -> ShowS
Show
type L12T = MsgI "L12:" (L2 (L1 Id))
instance P L12T x => P L12 x where
type PP L12 x = PP L12T x
eval :: proxy L12 -> POpts -> x -> m (TT (PP L12 x))
eval proxy L12
_ = Proxy L12T -> POpts -> x -> m (TT (PP L12T 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 L12T
forall k (t :: k). Proxy t
Proxy @L12T)
data L13 deriving Int -> L13 -> ShowS
[L13] -> ShowS
L13 -> String
(Int -> L13 -> ShowS)
-> (L13 -> String) -> ([L13] -> ShowS) -> Show L13
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [L13] -> ShowS
$cshowList :: [L13] -> ShowS
show :: L13 -> String
$cshow :: L13 -> String
showsPrec :: Int -> L13 -> ShowS
$cshowsPrec :: Int -> L13 -> ShowS
Show
type L13T = MsgI "L13:" (L3 (L1 Id))
instance P L13T x => P L13 x where
type PP L13 x = PP L13T x
eval :: proxy L13 -> POpts -> x -> m (TT (PP L13 x))
eval proxy L13
_ = Proxy L13T -> POpts -> x -> m (TT (PP L13T 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 L13T
forall k (t :: k). Proxy t
Proxy @L13T)
data L21 deriving Int -> L21 -> ShowS
[L21] -> ShowS
L21 -> String
(Int -> L21 -> ShowS)
-> (L21 -> String) -> ([L21] -> ShowS) -> Show L21
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [L21] -> ShowS
$cshowList :: [L21] -> ShowS
show :: L21 -> String
$cshow :: L21 -> String
showsPrec :: Int -> L21 -> ShowS
$cshowsPrec :: Int -> L21 -> ShowS
Show
type L21T = MsgI "L21:" (L1 (L2 Id))
instance P L21T x => P L21 x where
type PP L21 x = PP L21T x
eval :: proxy L21 -> POpts -> x -> m (TT (PP L21 x))
eval proxy L21
_ = Proxy L21T -> POpts -> x -> m (TT (PP L21T 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 L21T
forall k (t :: k). Proxy t
Proxy @L21T)
data L22 deriving Int -> L22 -> ShowS
[L22] -> ShowS
L22 -> String
(Int -> L22 -> ShowS)
-> (L22 -> String) -> ([L22] -> ShowS) -> Show L22
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [L22] -> ShowS
$cshowList :: [L22] -> ShowS
show :: L22 -> String
$cshow :: L22 -> String
showsPrec :: Int -> L22 -> ShowS
$cshowsPrec :: Int -> L22 -> ShowS
Show
type L22T = MsgI "L22:" (L2 (L2 Id))
instance P L22T x => P L22 x where
type PP L22 x = PP L22T x
eval :: proxy L22 -> POpts -> x -> m (TT (PP L22 x))
eval proxy L22
_ = Proxy L22T -> POpts -> x -> m (TT (PP L22T 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 L22T
forall k (t :: k). Proxy t
Proxy @L22T)
data L23 deriving Int -> L23 -> ShowS
[L23] -> ShowS
L23 -> String
(Int -> L23 -> ShowS)
-> (L23 -> String) -> ([L23] -> ShowS) -> Show L23
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [L23] -> ShowS
$cshowList :: [L23] -> ShowS
show :: L23 -> String
$cshow :: L23 -> String
showsPrec :: Int -> L23 -> ShowS
$cshowsPrec :: Int -> L23 -> ShowS
Show
type L23T = MsgI "L23:" (L3 (L2 Id))
instance P L23T x => P L23 x where
type PP L23 x = PP L23T x
eval :: proxy L23 -> POpts -> x -> m (TT (PP L23 x))
eval proxy L23
_ = Proxy L23T -> POpts -> x -> m (TT (PP L23T 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 L23T
forall k (t :: k). Proxy t
Proxy @L23T)
data L31 deriving Int -> L31 -> ShowS
[L31] -> ShowS
L31 -> String
(Int -> L31 -> ShowS)
-> (L31 -> String) -> ([L31] -> ShowS) -> Show L31
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [L31] -> ShowS
$cshowList :: [L31] -> ShowS
show :: L31 -> String
$cshow :: L31 -> String
showsPrec :: Int -> L31 -> ShowS
$cshowsPrec :: Int -> L31 -> ShowS
Show
type L31T = MsgI "L31:" (L1 (L3 Id))
instance P L31T x => P L31 x where
type PP L31 x = PP L31T x
eval :: proxy L31 -> POpts -> x -> m (TT (PP L31 x))
eval proxy L31
_ = Proxy L31T -> POpts -> x -> m (TT (PP L31T 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 L31T
forall k (t :: k). Proxy t
Proxy @L31T)
data L32 deriving Int -> L32 -> ShowS
[L32] -> ShowS
L32 -> String
(Int -> L32 -> ShowS)
-> (L32 -> String) -> ([L32] -> ShowS) -> Show L32
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [L32] -> ShowS
$cshowList :: [L32] -> ShowS
show :: L32 -> String
$cshow :: L32 -> String
showsPrec :: Int -> L32 -> ShowS
$cshowsPrec :: Int -> L32 -> ShowS
Show
type L32T = MsgI "L32:" (L2 (L3 Id))
instance P L32T x => P L32 x where
type PP L32 x = PP L32T x
eval :: proxy L32 -> POpts -> x -> m (TT (PP L32 x))
eval proxy L32
_ = Proxy L32T -> POpts -> x -> m (TT (PP L32T 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 L32T
forall k (t :: k). Proxy t
Proxy @L32T)
data L33 deriving Int -> L33 -> ShowS
[L33] -> ShowS
L33 -> String
(Int -> L33 -> ShowS)
-> (L33 -> String) -> ([L33] -> ShowS) -> Show L33
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [L33] -> ShowS
$cshowList :: [L33] -> ShowS
show :: L33 -> String
$cshow :: L33 -> String
showsPrec :: Int -> L33 -> ShowS
$cshowsPrec :: Int -> L33 -> ShowS
Show
type L33T = MsgI "L33:" (L3 (L3 Id))
instance P L33T x => P L33 x where
type PP L33 x = PP L33T x
eval :: proxy L33 -> POpts -> x -> m (TT (PP L33 x))
eval proxy L33
_ = Proxy L33T -> POpts -> x -> m (TT (PP L33T 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 L33T
forall k (t :: k). Proxy t
Proxy @L33T)
unsafeEval :: forall opts p a
. ( HasCallStack
, OptC opts
, Show (PP p a)
, P p a
)
=> a
-> PP p a
unsafeEval :: a -> PP p a
unsafeEval = (String -> PP p a)
-> (PP p a -> PP p a) -> Either String (PP p a) -> PP p a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> PP p a
forall a. HasCallStack => String -> a
error (String -> PP p a) -> ShowS -> String -> PP p a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>)) PP p a -> PP p a
forall a. a -> a
id (Either String (PP p a) -> PP p a)
-> (a -> Either String (PP p a)) -> a -> PP p a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(OptC opts, Show (PP p a), P p a) =>
a -> Either String (PP p a)
forall k (opts :: Opt) (p :: k) a.
(OptC opts, Show (PP p a), P p a) =>
a -> Either String (PP p a)
evalEither @opts @p
evalEither :: forall opts p a
. ( OptC opts
, Show (PP p a)
, P p a
)
=> a
-> Either String (PP p a)
evalEither :: a -> Either String (PP p a)
evalEither a
a =
let opts :: POpts
opts = OptC opts => POpts
forall (o :: Opt). OptC o => POpts
getOpt @opts
pp :: TT (PP p a)
pp = Identity (TT (PP p a)) -> TT (PP p a)
forall a. Identity a -> a
runIdentity (Identity (TT (PP p a)) -> TT (PP p a))
-> Identity (TT (PP p a)) -> TT (PP p a)
forall a b. (a -> b) -> a -> b
$ Proxy p -> POpts -> a -> Identity (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
in case TT (PP p a)
pp TT (PP p a)
-> Getting (Val (PP p a)) (TT (PP p a)) (Val (PP p a))
-> Val (PP p a)
forall s a. s -> Getting a s a -> a
^. Getting (Val (PP p a)) (TT (PP p a)) (Val (PP p a))
forall a b. Lens (TT a) (TT b) (Val a) (Val b)
ttVal of
Val PP p a
r -> PP p a -> Either String (PP p a)
forall a b. b -> Either a b
Right PP p a
r
Fail {} -> String -> Either String (PP p a)
forall a b. a -> Either a b
Left (String -> Either String (PP p a))
-> String -> Either String (PP p a)
forall a b. (a -> b) -> a -> b
$ POpts -> TT (PP p a) -> String
forall x. Show x => POpts -> TT x -> String
prtTree POpts
opts TT (PP p a)
pp
instance ( P p x
, P q x
, Show (PP p x)
, Show (PP q x)
) => P ('SG.Arg p q) x where
type PP ('SG.Arg p q) x = SG.Arg (PP p x) (PP q x)
eval :: proxy ('Arg p q) -> POpts -> x -> m (TT (PP ('Arg p q) x))
eval proxy ('Arg p q)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"'Arg"
Either
(TT (Arg (PP p x) (PP q x)))
(PP p x, PP q x, TT (PP p x), TT (PP q x))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either
(TT (Arg (PP p x) (PP q x)))
(PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k k (p :: k) a (q :: k) (m :: Type -> Type)
(proxy1 :: k -> Type) (proxy2 :: k -> 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 (Arg (PP p x) (PP q x)) -> m (TT (Arg (PP p x) (PP q x)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Arg (PP p x) (PP q x)) -> m (TT (Arg (PP p x) (PP q x))))
-> TT (Arg (PP p x) (PP q x)) -> m (TT (Arg (PP p x) (PP q x)))
forall a b. (a -> b) -> a -> b
$ case Either
(TT (Arg (PP p x) (PP q x)))
(PP p x, PP q x, TT (PP p x), TT (PP q x))
lr of
Left TT (Arg (PP p x) (PP q x))
e -> TT (Arg (PP p x) (PP q x))
e
Right (PP p x
p,PP q x
q,TT (PP p x)
pp,TT (PP q x)
qq) ->
let hhs :: [Tree PE]
hhs = [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp, TT (PP q x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q x)
qq]
ret :: Arg (PP p x) (PP q x)
ret = PP p x -> PP q x -> Arg (PP p x) (PP q x)
forall a b. a -> b -> Arg a b
SG.Arg PP p x
p PP q x
q
in POpts
-> Val (Arg (PP p x) (PP q x))
-> String
-> [Tree PE]
-> TT (Arg (PP p x) (PP q x))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Arg (PP p x) (PP q x) -> Val (Arg (PP p x) (PP q x))
forall a. a -> Val a
Val Arg (PP p x) (PP q x)
ret) (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 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q x -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q x
q) [Tree PE]
hhs
data Arg' deriving Int -> Arg' -> ShowS
[Arg'] -> ShowS
Arg' -> String
(Int -> Arg' -> ShowS)
-> (Arg' -> String) -> ([Arg'] -> ShowS) -> Show Arg'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Arg'] -> ShowS
$cshowList :: [Arg'] -> ShowS
show :: Arg' -> String
$cshow :: Arg' -> String
showsPrec :: Int -> Arg' -> ShowS
$cshowsPrec :: Int -> Arg' -> ShowS
Show
instance x ~ SG.Arg a b => P Arg' x where
type PP Arg' x = ArgT x
eval :: proxy Arg' -> POpts -> x -> m (TT (PP Arg' x))
eval proxy Arg'
_ POpts
opts (SG.Arg a b) =
let msg0 :: String
msg0 = String
"Arg'"
ret :: (a, b)
ret = (a
a,b
b)
in TT (a, b) -> m (TT (a, b))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (a, b) -> m (TT (a, b))) -> TT (a, b) -> m (TT (a, b))
forall a b. (a -> b) -> a -> b
$ POpts -> Val (a, b) -> String -> [Tree PE] -> TT (a, b)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ((a, b) -> Val (a, b)
forall a. a -> Val a
Val (a, b)
ret) String
msg0 []
type family ArgT (x :: Type) where
ArgT (SG.Arg a b) = (a,b)
ArgT o = GL.TypeError (
'GL.Text "ArgT: expected 'SG.Arg a b' "
':$$: 'GL.Text "o = "
':<>: 'GL.ShowType o)
instance x ~ Elr a b => P 'ENone x where
type PP 'ENone x = ()
eval :: proxy 'ENone -> POpts -> x -> m (TT (PP 'ENone x))
eval proxy 'ENone
_ POpts
opts x
x =
let msg0 :: String
msg0 = String
"'ENone"
in TT () -> m (TT ())
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT () -> m (TT ())) -> TT () -> m (TT ())
forall a b. (a -> b) -> a -> b
$ case x
x of
ELeft {} -> POpts -> Val () -> String -> [Tree PE] -> TT ()
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val ()
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found ELeft")) String
"" []
x
ENone -> POpts -> Val () -> String -> [Tree PE] -> TT ()
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (() -> Val ()
forall a. a -> Val a
Val ()) String
msg0 []
ERight {} -> POpts -> Val () -> String -> [Tree PE] -> TT ()
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val ()
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found ERight")) String
"" []
EBoth {} -> POpts -> Val () -> String -> [Tree PE] -> TT ()
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val ()
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found EBoth")) String
"" []
instance ( PP p x ~ Elr a b
, P p x
)
=> P ('ELeft p) x where
type PP ('ELeft p) x = ELeftT (PP p x)
eval :: proxy ('ELeft p) -> POpts -> x -> m (TT (PP ('ELeft p) x))
eval proxy ('ELeft p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"'ELeft"
TT (Elr a b)
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
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 (Elr a b)
-> [Tree PE]
-> Either (TT a) (Elr a b)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (Elr a b)
pp [] of
Left TT a
e -> TT a
e
Right Elr a b
p ->
case Elr a b
p of
Elr a b
ENone -> POpts -> Val a -> String -> [Tree PE] -> TT a
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val a
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found ENone")) String
"" [TT (Elr a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Elr a b)
pp]
ELeft a
a -> 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 [TT (Elr a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Elr a b)
pp]
ERight {} -> POpts -> Val a -> String -> [Tree PE] -> TT a
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val a
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found ERight")) String
"" [TT (Elr a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Elr a b)
pp]
EBoth {} -> POpts -> Val a -> String -> [Tree PE] -> TT a
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val a
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found EBoth")) String
"" [TT (Elr a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Elr a b)
pp]
instance ( PP p x ~ Elr a b
, P p x
)
=> P ('ERight p) x where
type PP ('ERight p) x = ERightT (PP p x)
eval :: proxy ('ERight p) -> POpts -> x -> m (TT (PP ('ERight p) x))
eval proxy ('ERight p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"'ERight"
TT (Elr a b)
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
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 Inline
-> POpts
-> String
-> TT (Elr a b)
-> [Tree PE]
-> Either (TT b) (Elr a b)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (Elr a b)
pp [] of
Left TT b
e -> TT b
e
Right Elr a b
p ->
case Elr a b
p of
Elr a b
ENone -> POpts -> Val b -> String -> [Tree PE] -> TT b
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val b
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found ENone")) String
"" [TT (Elr a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Elr a b)
pp]
ELeft {} -> POpts -> Val b -> String -> [Tree PE] -> TT b
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val b
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found ELeft")) String
"" [TT (Elr a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Elr a b)
pp]
ERight b
b -> 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
b) String
msg0 [TT (Elr a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Elr a b)
pp]
EBoth {} -> POpts -> Val b -> String -> [Tree PE] -> TT b
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val b
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found EBoth")) String
"" [TT (Elr a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Elr a b)
pp]
instance ( Show a
, Show b
, P p a
, P q b
, Show (PP p a)
, Show (PP q b)
) => P ('EBoth p q) (Elr a b) where
type PP ('EBoth p q) (Elr a b) = (PP p a, PP q b)
eval :: proxy ('EBoth p q)
-> POpts -> Elr a b -> m (TT (PP ('EBoth p q) (Elr a b)))
eval proxy ('EBoth p q)
_ POpts
opts Elr a b
th = do
let msg0 :: String
msg0 = String
"'EBoth"
case Elr a b
th of
EBoth a
a b
b -> do
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
case Inline
-> POpts
-> String
-> TT (PP p a)
-> [Tree PE]
-> Either (TT (PP p a, PP q b)) (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 (PP p a, PP q b)
e -> TT (PP p a, PP q b) -> m (TT (PP p a, PP q b))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP p a, PP q b)
e
Right PP p a
p -> do
TT (PP q b)
qq <- 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
forall k (t :: k). Proxy t
Proxy @q) POpts
opts b
b
TT (PP p a, PP q b) -> m (TT (PP p a, PP q b))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p a, PP q b) -> m (TT (PP p a, PP q b)))
-> TT (PP p a, PP q b) -> m (TT (PP p a, PP q b))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP q b)
-> [Tree PE]
-> Either (TT (PP p a, PP q b)) (PP q b)
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
" q failed p=" 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 q b)
qq [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp] of
Left TT (PP p a, PP q b)
e -> TT (PP p a, PP q b)
e
Right PP q b
q ->
let ret :: (PP p a, PP q b)
ret = (PP p a
p,PP q b
q)
in POpts
-> Val (PP p a, PP q b)
-> String
-> [Tree PE]
-> TT (PP p a, PP q b)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ((PP p a, PP q b) -> Val (PP p a, PP q b)
forall a. a -> Val a
Val (PP p a, PP q b)
ret) (POpts -> String -> (PP p a, PP q b) -> Elr a b -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 (PP p a, PP q b)
ret (a -> b -> Elr a b
forall a b. a -> b -> Elr a b
EBoth a
a b
b)) [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp, TT (PP q b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q b)
qq]
Elr a b
_ -> TT (PP p a, PP q b) -> m (TT (PP p a, PP q b))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p a, PP q b) -> m (TT (PP p a, PP q b)))
-> TT (PP p a, PP q b) -> m (TT (PP p a, PP q b))
forall a b. (a -> b) -> a -> b
$ POpts
-> Val (PP p a, PP q b)
-> String
-> [Tree PE]
-> TT (PP p a, PP q b)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP p a, PP q b)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Elr a b -> String
forall a b. Elr a b -> String
showElr Elr a b
th)) String
"" []