{-# 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 #-}
-- | a dsl for evaluating and displaying type level expressions

module Predicate.Core (
 -- ** basic types

    Id
  , IdT
  , W
  , Msg
  , MsgI
  , Hide
  , Width
  , Hole
  , UnproxyT
  , Len
  , Length
  , Map'
  , Map
  , Do
  , OneP
  , Swap
  , Arg'

  -- ** impure evaluation

  , pan
  , panv
  , pa
  , pu
  , pab
  , pub
  , pav
  , puv
  , pl
  , pz
  , run
  , runs
  , unsafeEval

  -- ** pure evaluation

  , runP
  , runPQ
  , runPQBool
  , evalBool
  , evalBoolHide
  , evalHide
  , evalQuick
  , evalEither

 -- ** wrap, unwrap

  , Wrap
  , Wrap'
  , Unwrap

 -- ** failure

  , Fail
  , FailP
  , FailT
  , FailS

 -- ** tuple

  , Fst
  , Snd
  , Thd
  , L1
  , L2
  , L3
  , L4
  , L5
  , L6
  , L7
  , L8
  , L11
  , L12
  , L13
  , L21
  , L22
  , L23
  , L31
  , L32
  , L33

  -- ** boolean

  , type (&&)
  , type (&&~)
  , type (||)
  , type (||~)
  , type (~>)
  , Not
  , Between
  , type (<..>)
  , All
  , Any
  , IdBool

 -- ** type application

  , type (>>)
  , type (>>>)
  , type (<<)
  , type ($)
  , type (&)
  , DoL

 -- ** core class

  , P(..)

 -- ** type families

  , 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
-- $setup

-- >>> :set -XDataKinds

-- >>> :set -XTypeApplications

-- >>> :set -XTypeOperators

-- >>> :set -XNoOverloadedLists

-- >>> import Predicate.Prelude

-- >>> import Data.Time

-- >>> :m + Control.Lens

-- >>> :m + Control.Lens.Action

-- >>> :m + Data.Typeable

-- >>> :m + Text.Show.Functions

-- >>> :m + Data.Ratio

-- >>> import qualified Data.Semigroup as SG


-- | This is the core class. Each instance of this class can be combined into a dsl using 'Predicate.Core.>>'

class P p a where
  type PP (p :: k) a :: Type -- PP is the output type

  eval :: MonadEval m
     => proxy p -- ^ proxy for the expression

     -> POpts  -- ^ display options

     -> a      -- ^ value

     -> m (TT (PP p a)) -- ^ returns a tree of results


-- | A specialised form of 'eval' that works only on predicates

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

-- | A specialised form of 'eval' that returns the result or the error string on failure

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)

-- | identity function

--

-- >>> pz @Id 23

-- Val 23

--

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) []

-- | identity function that also displays the type information for debugging

--

-- >>> pz @IdT 23

-- Val 23

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) []

-- | transparent wrapper to turn kind k into kind 'Type'

--   eg useful for putting in a promoted list (cant mix kinds) see 'Predicate.Core.Do'

--

-- >>> pz @'[W 123, Id] 99

-- Val [123,99]

--

-- >>> pz @'[W "abc", W "def", Id, Id] "ghi"

-- Val ["abc","def","ghi","ghi"]

--

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

-- | add a message to give more context to the evaluation tree

--

-- >>> pan @(Msg "[somemessage]" Id) 999

-- P [somemessage] Id 999

-- Val 999

--

-- >>> pan @(Msg Id 999) "info message:"

-- P info message: '999

-- Val 999

--

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

-- | add a message to give more context to the evaluation tree

--

-- >>> pan @(MsgI "[somemessage] " Id) 999

-- P [somemessage] Id 999

-- Val 999

--

-- >>> pan @(MsgI Id 999) "info message:"

-- P info message:'999

-- Val 999

--

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

-- | run the expression @p@ but remove the subtrees

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
-- type H p = Hide p -- doesnt work with %   -- unsaturated!


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
.~ []


-- | Acts as a proxy for a Type.

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 -- can only be Type not Type -> Type (can use Proxy but then we go down the rabbithole)

  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" []

-- | override the display width for the expression @p@

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

-- | 'const' () function

--

-- >>> pz @() "Asf"

-- Val ()

--

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 []

-- | 'const' [] function

--

-- >>> pz @[] "Asf"

-- Val []

--

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 []

-- | create a Proxy for a kind @t@

--

-- >>> pz @(Proxy 4) ()

-- Val Proxy

--

-- >>> pz @(Proxy Int) ()

-- Val Proxy

--

-- >>> pz @(Proxy "abc" >> Pop0 Id ()) ()

-- Val "abc"

--

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 []

-- | pulls the type level 'Bool' to the value level

--

-- >>> pz @'True "not used"

-- Val True

--

-- >>> pz @'False ()

-- Val False

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) []

-- | pulls the type level 'GHC.TypeLits.Symbol' to the value level as a 'GHC.Base.String'

--

-- >>> pz @"hello world" ()

-- Val "hello world"

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
"\"")) []

-- | run the predicates in a promoted 2-tuple; similar to 'Control.Arrow.&&&'

--

-- >>> pz @'(Id, 4) "hello"

-- Val ("hello",4)

--

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]

-- | run the predicates in a promoted 3-tuple

--

-- >>> pz @'(4, Id, "goodbye") "hello"

-- Val (4,"hello","goodbye")

--

-- >>> pan @'( 'True, 'False, 123) True

-- P '(,,)

-- |

-- +- True 'True

-- |

-- +- False 'False

-- |

-- `- P '123

-- Val (True,False,123)

--

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

-- | run the predicates in a promoted 4-tuple

--

-- >>> pz @'(4, Id, "inj", 999) "hello"

-- Val (4,"hello","inj",999)

--

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

-- | run the predicates in a promoted 5-tuple

--

-- >>> pz @'(4, Id, "inj", 999, 'LT) "hello"

-- Val (4,"hello","inj",999,LT)

--

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

-- | run the predicates in a promoted 6-tuple

--

-- >>> pz @'(4, Id, "inj", 999, 'LT, 1) "hello"

-- Val (4,"hello","inj",999,LT,1)

--

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

-- | run the predicates in a promoted 7-tuple

--

-- >>> pz @'(4, Id, "inj", 999, 'LT, 1, 2) "hello"

-- Val (4,"hello","inj",999,LT,1,2)

--

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

-- | run the predicates in a promoted 8-tuple

--

-- >>> pz @'(4, Id, "inj", 999, 'LT, 1, 2, 3) "hello"

-- Val (4,"hello","inj",999,LT,1,2,3)

--

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


-- | extracts the value level representation of the promoted 'Ordering'

--

-- >>> pz @'LT "not used"

-- Val LT

--

-- >>> pz @'EQ ()

-- Val EQ

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 []

-- | extracts the value level representation of the type level 'Nat'

--

-- >>> pz @123 ()

-- Val 123

--

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) []

-- | extracts the value level representation of the type level '()

--

-- >>> pz @'() ()

-- Val ()

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
"'()" []

-- the type has to be [a] so we still need type PP '[p] a = [PP p a] to keep the types in line


-- | extracts the value level representation of the type level '[]

--

-- >>> pz @'[] False

-- Val []

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
"'[]" []

-- | runs each predicate in turn from the promoted list

--

-- >>> pz @'[1, 2, 3] 999

-- Val [1,2,3]

--

-- >>> pz @'[W 1, W 2, W 3, Id] 999

-- Val [1,2,3,999]

--

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])

-- | tries to extract @a@ from @Maybe a@ otherwise it fails: similar to 'Data.Maybe.fromJust'

--

-- >>> pz @('Just Id) (Just "abc")

-- Val "abc"

--

-- >>> pl @('Just Id >> Id) (Just 123)

-- Present 123 ((>>) 123 | {Id 123})

-- Val 123

--

-- >>> pl @('Just Id) (Just [1,2,3])

-- Present [1,2,3] ('Just [1,2,3] | Just [1,2,3])

-- Val [1,2,3]

--

-- >>> pl @('Just Id) (Just 10)

-- Present 10 ('Just 10 | Just 10)

-- Val 10

--

-- >>> pl @('Just Id) Nothing

-- Error 'Just(empty)

-- Fail "'Just(empty)"

--

-- >>> pz @('Just Fst) (Just 123,'x')

-- Val 123

--

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]

-- | expects Nothing otherwise it fails

--   if the value is Nothing then it returns @Proxy a@ as this provides type information

--

-- >>> pz @'Nothing Nothing

-- Val Proxy

--

-- >>> pz @'Nothing (Just True)

-- Fail "'Nothing found Just"

--

instance P 'Nothing (Maybe a) where
  type PP 'Nothing (Maybe a) = Proxy a -- () gives us less information

  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
"" []

-- omitted Show x so we can have less ambiguity

-- | extracts the @a@ from type level @Either a b@ if the value exists

--

-- >>> pz @('Left Id) (Left 123)

-- Val 123

--

-- >>> pz @('Left Snd) ('x', Left 123)

-- Val 123

--

-- >>> pz @('Left Id) (Right "aaa")

-- Fail "'Left found Right"

--

-- >>> pl @('Left Id) (Left 123)

-- Present 123 (Left)

-- Val 123

--

-- >>> pl @('Left Id) (Right 123)

-- Error 'Left found Right

-- Fail "'Left found Right"

--


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]

-- | extracts the @b@ from type level @Either a b@ if the value exists

--

-- >>> pl @('Right Id) (Right 123)

-- Present 123 (Right)

-- Val 123

--

-- >>> pz @('Right Id >> Snd) (Right ('x',123))

-- Val 123

--

-- >>> pz @('Right Id) (Left "aaa")

-- Fail "'Right found Left"

--

-- >>> pl @('Right Id) (Left 123)

-- Error 'Right found Left

-- Fail "'Right found Left"

--

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]


-- removed Show x: else ambiguity errors in TestPredicate


-- | extracts the @a@ from type level @These a b@ if the value exists

--

-- >>> pl @('This Id) (This 12)

-- Present 12 (This)

-- Val 12

--

-- >>> pz @('This Id) (That "aaa")

-- Fail "'This found That"

--

-- >>> pz @('This Id) (These 999 "aaa")

-- Fail "'This found These"

--

-- >>> pl @('This Id) (That 12)

-- Error 'This found That

-- Fail "'This found That"

--


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]

-- | extracts the @b@ from type level @These a b@ if the value exists

--

-- >>> pz @('That Id) (That 123)

-- Val 123

--

-- >>> pz @('That Id) (This "aaa")

-- Fail "'That found This"

--

-- >>> pz @('That Id) (These 44 "aaa")

-- Fail "'That found These"

--


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]


-- | extracts the (a,b) from type level @These a b@ if the value exists

--

-- >>> pz @('These Id Id) (These 123 "abc")

-- Val (123,"abc")

--

-- >>> pz @('These Id 5) (These 123 "abcde")

-- Val (123,5)

--

-- >>> pz @('These Id Id) (This "aaa")

-- Fail "'These found This"

--

-- >>> pz @('These Id Id) (That "aaa")

-- Fail "'These found That"

--

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
"" []

-- | converts the type to the corresponding 'Proxy'

--

-- >>> pz @'Proxy 'x' ^!? acts . _Val . to typeRep

-- Just Char

--

-- >>> pz @'Proxy 45 ^!? acts . _Val . to typeRep

-- Just Integer

--

-- >>> pz @'Proxy "abc" ^!? acts . _Val . to typeRep

-- Just [Char]

--

-- >>> pz @(Pop1' (Proxy ToEnum) 'Proxy 2) LT

-- Val GT

--

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" []

-- | evaluate the type level expression in IO

--

-- >>> pl @(Between 4 10 Id) 7 & mapped . _Val %~ not

-- True (4 <= 7 <= 10)

-- Val False

--

-- >>> eval (Proxy @'True) defOpts 7 & mapped . ttValBool . _Val %~ not

-- TT {_ttValP = FalseP, _ttVal = Val False, _ttString = "'True", _ttForest = []}

--


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))
-- | skips the evaluation tree and just displays the end result

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
-- | same as 'pz' but adds context to the end result

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
-- | displays the evaluation tree in plain text without colors

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
-- | displays the evaluation tree in plain text without colors and verbose

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
-- | displays the evaluation tree using colors without background colors

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
-- | displays the evaluation tree using background colors

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
-- | 'pa' and verbose

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
-- | display the evaluation tree using unicode and colors

-- @

--   pu @'(Id, "abc", 'True) [1..4]

-- @

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
-- | displays the evaluation tree using unicode and colors with background colors

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
-- | 'pu' and verbose

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

-- | evaluate a typelevel expression (use type applications to pass in the options and the expression)

--

-- >>> run @OZ @Id 123

-- Val 123

--

-- >>> run @('OMsg "field1" ':# OL) @('Left Id) (Right 123)

-- field1 >>> Error 'Left found Right

-- Fail "'Left found Right"

--

-- >>> run @(OptT '[ 'OMsg "test", OU, 'OEmpty, OL, 'OMsg "field2"]) @(FailT _ "oops") ()

-- test | field2 >>> Error oops

-- Fail "oops"

--

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)

-- | run expression with multiple options in a list

--

-- >>> runs @'[OL, 'OMsg "field2"] @'( 'True, 'False) ()

-- field2 >>> Present (True,False) ('(True,False))

-- Val (True,False)

--

-- >>> runs @'[ 'OMsg "test", OU, 'OEmpty, OL, 'OMsg "field2"] @(FailT _ "oops") ()

-- test | field2 >>> Error oops

-- Fail "oops"

--

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

-- | convenience method to evaluate one expression

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

-- | convenience method to evaluate two expressions using the same input and return the results

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)

-- | convenience method to evaluate two boolean expressions using the same input and return the results

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)

-- | evaluate a boolean expressions but hide the results unless verbose

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

-- | evaluate a expressions but hide the results unless verbose

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


-- advantage of (>>) over 'Do [k] is we can use different kinds for (>>) without having to wrap with 'W'


-- | compose expressions

--

-- >>> pz @(L11 >> Not Id) ((True,12),'x')

-- Val False

--

-- >>> pz @(L12 >> Succ >> Dup) ((True,12),'x')

-- Val (13,13)

--

-- >>> pz @(10 >> '(Id,"abc") >> Second Len) ()

-- Val (10,3)

--

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
        -- need to look inside to see if there is already an exception in ttForest

          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]
:) -- we still need pp for context

                    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]

-- | infixl version of 'Predicate.Core.>>'

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))


-- | flipped version of 'Predicate.Core.>>'

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
topMessageExtractRe :: Regex
topMessageExtractRe = [RH.re|^.*\{([^}]+)\}.*?|]

-- | unwraps a value (see '_Wrapped'')

--

-- >>> pz @Unwrap (SG.Sum (-13))

-- Val (-13)

--

-- >>> pl @(Unwrap >> '(Id, 'True)) (SG.Sum 13)

-- Present (13,True) ((>>) (13,True) | {'(13,True)})

-- Val (13,True)

--

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) []

-- | similar to 'Wrap' where @t@ points to the type

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]

-- | wraps a value (see '_Wrapped'' and '_Unwrapped'')

--

-- >>> pz @(Wrap (SG.Sum _) Id) (-13)

-- Val (Sum {getSum = -13})

--

-- >>> pz @(Wrap SG.Any (Ge 4)) 13

-- Val (Any {getAny = True})

--

-- >>> import Data.List.NonEmpty (NonEmpty(..))

-- >>> pz @(Wrap (NonEmpty _) (Uncons >> 'Just Id)) "abcd"

-- Val ('a' :| "bcd")

--

-- >>> pl @(Wrap (SG.Sum _) Id) 13

-- Present Sum {getSum = 13} (Wrap Sum {getSum = 13} | 13)

-- Val (Sum {getSum = 13})

--

-- >>> pl @(Wrap (SG.Sum _) Id >> STimes 4 Id) 13

-- Present Sum {getSum = 52} ((>>) Sum {getSum = 52} | {getSum = 13})

-- Val (Sum {getSum = 52})

--

-- >>> pl @(Wrap _ 13 <> Id) (SG.Sum @Int 12)

-- Present Sum {getSum = 25} (Sum {getSum = 13} <> Sum {getSum = 12} = Sum {getSum = 25})

-- Val (Sum {getSum = 25})

--

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))

-- | used internally for type inference

--

-- >>> pz @(FromIntegral' (Proxy (SG.Sum _) >> UnproxyT) 23) ()

-- Val (Sum {getSum = 23})

--

-- >>> pz @(FromIntegral' (Hole (SG.Sum _)) 23) () -- equivalent to Proxy UnproxyT above

-- Val (Sum {getSum = 23})

--

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)" []

-- | similar to 'Length' but displays the input value and works only for lists

--

-- >>> pl @Len "abcd"

-- Present 4 (Len 4 | "abcd")

-- Val 4

--

-- >>> pl @Len [1..3000]

-- Present 3000 (Len 3000 | [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,7...)

-- Val 3000

--

-- >>> pz @Len [10,4,5,12,3,4]

-- Val 6

--

-- >>> pz @Len []

-- Val 0

--

-- >>> pz @(Pairs >> Len > 2) "abcdef"

-- Val True

--

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') []

-- | similar to 'length' for 'Foldable' instances

--

-- >>> pz @(Length Snd) (123,"abcdefg") -- if this breaks then get rid of Show a!

-- Val 7

--

-- >>> pz @(Length Id) (Left "aa")

-- Val 0

--

-- >>> pz @(Length Id) (Right "aa")

-- Val 1

--

-- >>> pz @(Length Right') (Right "abcd")

-- Val 4

--

-- >>> pz @(Length L23) (True,(23,'x',[10,9,1,3,4,2]))

-- Val 6

--

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]

-- | 'not' function

--

-- >>> pz @(Not Id) False

-- Val True

--

-- >>> pz @(Not Id) True

-- Val False

--

-- >>> pz @(Not Fst) (True,22)

-- Val False

--

-- >>> pl @(Not (Lt 3)) 13

-- True (Not (13 < 3))

-- Val True

--

-- >>> pl @(Not 'True) ()

-- False (Not ('True))

-- Val False

--

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]

-- | 'id' function on a boolean

--

-- >>> pz @('[ 'True] >> Head >> IdBool) ()

-- Val True

--

-- >>> pz @(Fst >> IdBool) (False,22)

-- Val False

--

-- >>> pl @(Head >> IdBool) [True]

-- True ((>>) True | {IdBool})

-- Val True

--

-- >>> pan @(Head >> Id) [True]

-- P (>>) True

-- |

-- +- P Head True

-- |

-- `- P Id True

-- Val True

--

-- >>> pan @(Head >> IdBool) [True]

-- True (>>) True

-- |

-- +- P Head True

-- |

-- `- True IdBool

-- Val True

--


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 []

-- | Fails the computation with a message but allows you to set the output type

--

-- >>> pz @('False || (Fail 'True "failed")) (99,"somedata")

-- Fail "failed"

--

-- >>> pz @('False || (Fail (Hole Bool) "failed")) (99,"somedata")

-- Fail "failed"

--

-- >>> pz @('False || (Fail (Hole _) "failed")) (99,"somedata")

-- Fail "failed"

--

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)

-- | Fails the computation with a message for simple failures: doesnt preserve types

--

-- >>> pz @(FailS (PrintT "value=%03d string=%s" Id)) (99,"somedata")

-- Fail "value=099 string=somedata"

--

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))

-- | Fails the computation with a message (wraps the type in 'Hole')

--

-- >>> pz @(FailT Int (PrintF "value=%03d" Id)) 99

-- Fail "value=099"

--

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))

-- | Fails the computation with a message where the input value is a Proxy

--

-- >>> pz @(Ix 3 (FailP "oops")) "abcd"

-- Val 'd'

--

-- >>> pz @(Ix 3 (FailP "oops")) "abc"

-- Fail "oops"

--

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))

-- | gets the singleton value from a foldable

--

-- >>> pl @OneP [10..15]

-- Error OneP:expected one element(6)

-- Fail "OneP:expected one element(6)"

--

-- >>> pl @OneP [10]

-- Present 10 (OneP)

-- Val 10

--

-- >>> pl @OneP []

-- Error OneP:expected one element(empty)

-- Fail "OneP:expected one element(empty)"

--

-- >>> pl @OneP (Just 10)

-- Present 10 (OneP)

-- Val 10

--

-- >>> pl @OneP Nothing

-- Error OneP:expected one element(empty)

-- Fail "OneP:expected one element(empty)"

--

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
"" []

--type OneP = Guard "expected list of length 1" (Len == 1) >> Head

--type OneP = Guard (PrintF "expected list of length 1 but found length=%d" Len) (Len == 1) >> Head


-- | A predicate that determines if the value is between @p@ and @q@

--

-- >>> pz @(Between 5 8 Len) [1,2,3,4,5,5,7]

-- Val True

--

-- >>> pl @(Between 5 8 Id) 9

-- False (9 <= 8)

-- Val False

--

-- >>> pl @(Between L11 L12 Snd) ((1,4),3)

-- True (1 <= 3 <= 4)

-- Val True

--

-- >>> pl @(Between L11 L12 Snd) ((1,4),10)

-- False (10 <= 4)

-- Val False

--

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


-- | A operator predicate that determines if the value is between @p@ and @q@

--

-- >>> pz @(5 <..> 8) 6

-- Val True

--

-- >>> pz @(10 % 4 <..> 40 % 5) 4

-- Val True

--

-- >>> pz @(10 % 4 <..> 40 % 5) 33

-- Val False

--

-- >>> pl @(Negate 7 <..> 20) (-4)

-- True (-7 <= -4 <= 20)

-- Val True

--

-- >>> pl @(Negate 7 <..> 20) 21

-- False (21 <= 20)

-- Val False

--

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))

-- | similar to 'all'

--

-- >>> pl @(All (Between 1 8 Id)) [7,3,4,1,2,9,0,1]

-- False (All(8) i=5 (9 <= 8))

-- Val False

--

-- >>> pz @(All Odd) [1,5,11,5,3]

-- Val True

--

-- >>> pz @(All Odd) []

-- Val True

--

-- >>> run @OANV @(All Even) [1,5,11,5,3]

-- False All(5) i=0 (1 == 0)

-- |

-- +- False i=0: 1 == 0

-- |  |

-- |  +- P 1 `mod` 2 = 1

-- |  |  |

-- |  |  +- P Id 1

-- |  |  |

-- |  |  `- P '2

-- |  |

-- |  `- P '0

-- |

-- +- False i=1: 1 == 0

-- |  |

-- |  +- P 5 `mod` 2 = 1

-- |  |  |

-- |  |  +- P Id 5

-- |  |  |

-- |  |  `- P '2

-- |  |

-- |  `- P '0

-- |

-- +- False i=2: 1 == 0

-- |  |

-- |  +- P 11 `mod` 2 = 1

-- |  |  |

-- |  |  +- P Id 11

-- |  |  |

-- |  |  `- P '2

-- |  |

-- |  `- P '0

-- |

-- +- False i=3: 1 == 0

-- |  |

-- |  +- P 5 `mod` 2 = 1

-- |  |  |

-- |  |  +- P Id 5

-- |  |  |

-- |  |  `- P '2

-- |  |

-- |  `- P '0

-- |

-- `- False i=4: 1 == 0

--    |

--    +- P 3 `mod` 2 = 1

--    |  |

--    |  +- P Id 3

--    |  |

--    |  `- P '2

--    |

--    `- P '0

-- Val False

--

-- >>> pl @(Fst >> All (Gt 3)) ([10,12,3,5],"ss")

-- False ((>>) False | {All(4) i=2 (3 > 3)})

-- Val False

--

-- >>> pl @(All (Lt 3)) [1 .. 10]

-- False (All(10) i=2 (3 < 3))

-- Val False

--

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

-- | similar to 'any'

--

-- >>> pl @(Any Even) [1,5,11,5,3]

-- False (Any(5))

-- Val False

--

-- >>> pl @(Any Even) [1,5,112,5,3]

-- True (Any(5) i=2 (0 == 0))

-- Val True

--

-- >>> pz @(Any Even) []

-- Val False

--

-- >>> pl @(Fst >> Any (Gt 3)) ([10,12,3,5],"ss")

-- True ((>>) True | {Any(4) i=0 (10 > 3)})

-- Val True

--

-- >>> pl @(Any (Same 2)) [1,4,5]

-- False (Any(3))

-- Val False

--

-- >>> pl @(Any (Same 2)) [1,4,5,2,1]

-- True (Any(5) i=3 (2 == 2))

-- Val True

--

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

-- | similar to 'fst'

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]

-- | similar to 'fst'

--

-- >>> pz @Fst (10,"Abc")

-- Val 10

--

-- >>> pz @Fst (10,"Abc",'x')

-- Val 10

--

-- >>> pz @Fst (10,"Abc",'x',False)

-- Val 10

--

-- >>> pl @Fst (99,'a',False,1.3)

-- Present 99 (Fst 99 | (99,'a',False,1.3))

-- Val 99

--

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)

-- | similar to 'snd'

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]

-- | similar to 'snd'

--

-- >>> pz @Snd (10,"Abc")

-- Val "Abc"

--

-- >>> pz @Snd (10,"Abc",True)

-- Val "Abc"

--

-- >>> pl @Snd (99,'a',False,1.3)

-- Present 'a' (Snd 'a' | (99,'a',False,1.3))

-- Val 'a'

--

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)

-- | similar to 3rd element in a n-tuple

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]

-- | similar to 3rd element in a n-tuple

--

-- >>> pz @Thd (10,"Abc",133)

-- Val 133

--

-- >>> pz @Thd (10,"Abc",133,True)

-- Val 133

--

-- >>> pl @Thd (99,'a',False,1.3)

-- Present False (Thd False | (99,'a',False,1.3))

-- Val False

--

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)

-- | similar to 4th element in a n-tuple

--

-- >>> pz @(L4 Id) (10,"Abc",'x',True)

-- Val True

--

-- >>> pz @(L4 L21) ('x',((10,"Abc",'x',999),"aa",1),9)

-- Val 999

--

-- >>> pl @(L4 Id) (99,'a',False,"someval")

-- Present "someval" (L4 "someval" | (99,'a',False,"someval"))

-- Val "someval"

--

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]

-- | similar to 5th element in a n-tuple

--

-- >>> pz @(L5 Id) (10,"Abc",'x',True,1)

-- Val 1

--

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]


-- | similar to 6th element in a n-tuple

--

-- >>> pz @(L6 Id) (10,"Abc",'x',True,1,99)

-- Val 99

--

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]

-- | similar to 7th element in a n-tuple

--

-- >>> pz @(L7 Id) (10,"Abc",'x',True,1,99,'a')

-- Val 'a'

--

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]

-- | similar to 8th element in a n-tuple

--

-- >>> pz @(L8 Id) (10,"Abc",'x',True,1,99,True,'a')

-- Val 'a'

--

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]

-- | similar to 'map' for Foldable types

--

-- >>> pz @(Map' Pred Id) [1..5]

-- Val [0,1,2,3,4]

--

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)

-- | similar to 'map'

--

-- >>> pz @(Map Pred) [1..5]

-- Val [0,1,2,3,4]

--

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)

-- | processes a type level list predicates running each in sequence with infixr: see 'Predicate.>>'

--

-- >>> pz @(Do [Pred, ShowP Id, Id &&& Len]) 9876543

-- Val ("9876542",7)

--

-- >>> pz @(Do '[W 123, W "xyz", Len &&& Id, Pred *** Id<>Id]) ()

-- Val (2,"xyzxyz")

--

-- >>> pl @(Do '[Succ,Id,ShowP Id,Ones,Map (ReadBase Int 8)]) 1239

-- Present [1,2,4,0] ((>>) [1,2,4,0] | {Map [1,2,4,0] | ["1","2","4","0"]})

-- Val [1,2,4,0]

--

-- >>> pl @(Do '[Pred,Id,ShowP Id,Ones,Map (ReadBase Int 8)]) 1239

-- Error invalid base 8 (Map(i=3, a="8") excnt=1)

-- Fail "invalid base 8"

--

-- >>> pl @(Do '[4,5,6]) ()

-- Present 6 ((>>) 6 | {'6})

-- Val 6

--

-- >>> pl @(Do '["abc", "Def", "ggg", "hhhhh"]) ()

-- Present "hhhhh" ((>>) "hhhhh" | {'"hhhhh"})

-- Val "hhhhh"

--

-- >>> pl @(Do '[ 'LT, 'EQ, 'GT ]) ()

-- Present GT ((>>) GT | {'GT})

-- Val GT

--

-- >>> pl @(Do '[4 % 4,22 % 1 ,12 -% 4]) ()

-- Present (-3) % 1 ((>>) (-3) % 1 | {Negate (-3) % 1 | 3 % 1})

-- Val ((-3) % 1)

--

-- >>> pl @(Do '[1,2,3]) ()

-- Present 3 ((>>) 3 | {'3})

-- Val 3

--

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
-- infixr same as >>


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))

-- need both :: Type and (Id >> p or W)

type family DoExpandT (ps :: [k]) :: Type where -- need Type not k else No instance for GN.KnownNat: pl @(Do '[4,5,6]) ()

  DoExpandT '[] = GL.TypeError ('GL.Text "DoExpandT '[] invalid: requires at least one predicate in the list")
  DoExpandT '[p] = W p -- need W or Id >> p else will fail with No instance for Show: pl @(Do '[4,5,6]) ()

  DoExpandT (p ': p1 ': ps) = p >> DoExpandT (p1 ': ps)

-- | processes a type level list predicates running each in sequence with infixl: see 'Predicate.>>'

--

-- >>> pz @(DoL [Pred, ShowP Id, Id &&& Len]) 9876543

-- Val ("9876542",7)

--

-- >>> pz @(DoL [2,3,4]) ()

-- Val 4

--

-- >>> pl @(DoL '[4,5,6]) ()

-- Present 6 ((>>) 6 | {'6})

-- Val 6

--

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
-- infixl unlike >>


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)

-- | similar to 'Prelude.&&'

--

-- >>> pz @(Fst && Snd) (True, True)

-- Val True

--

-- >>> pz @(Id > 15 && Id < 17) 16

-- Val True

--

-- >>> pz @(Id > 15 && Id < 17) 30

-- Val False

--

-- >>> pz @(Fst && (Length Snd >= 4)) (True,[11,12,13,14])

-- Val True

--

-- >>> pz @(Fst && (Length Snd == 4)) (True,[12,11,12,13,14])

-- Val False

--

-- >>> pz @(Uncurry (+:)) ([2..5],1)

-- Val [2,3,4,5,1]

--

-- >>> pz @(Uncurry (==!)) ('x','y')

-- Val LT

--

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]

-- | short circuit version of boolean And

--

-- >>> pl @(Id > 10 &&~ FailT _ "ss") 9

-- False (False &&~ _ | (9 > 10))

-- Val False

--

-- >>> pl @(Id > 10 &&~ Id == 12) 11

-- False (True &&~ False | (11 == 12))

-- Val False

--

-- >>> pl @(Id > 10 &&~ Id == 11) 11

-- True (True &&~ True)

-- Val True

--

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]

-- | similar to 'Prelude.||'

--

-- >>> pz @(Fst || (Length Snd >= 4)) (False,[11,12,13,14])

-- Val True

--

-- >>> pz @(Not Fst || (Length Snd == 4)) (True,[12,11,12,13,14])

-- Val False

--

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]

-- | short circuit version of boolean Or

--

-- >>> pl @(Id > 10 ||~ FailT _ "ss") 11

-- True (True ||~ _ | (11 > 10))

-- Val True

--

-- >>> pz @(Id > 10 ||~ Id == 9) 9

-- Val True

--

-- >>> pl @(Id > 10 ||~ Id > 9) 9

-- False (False ||~ False | (9 > 10) ||~ (9 > 9))

-- Val False

--

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]

-- | boolean implication

--

-- >>> pz @(Fst ~> (Length Snd >= 4)) (True,[11,12,13,14])

-- Val True

--

-- >>> pz @(Fst ~> (Length Snd == 4)) (True,[12,11,12,13,14])

-- Val False

--

-- >>> pz @(Fst ~> (Length Snd == 4)) (False,[12,11,12,13,14])

-- Val True

--

-- >>> pz @(Fst ~> (Length Snd >= 4)) (False,[11,12,13,14])

-- Val True

--

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]


-- | swaps using 'SwapC'

--

-- >>> pz @Swap (Left 123)

-- Val (Right 123)

--

-- >>> pz @Swap (Right 123)

-- Val (Left 123)

--

-- >>> pz @Swap (These 'x' 123)

-- Val (These 123 'x')

--

-- >>> pz @Swap (This 'x')

-- Val (That 'x')

--

-- >>> pz @Swap (That 123)

-- Val (This 123)

--

-- >>> pz @Swap (123,'x')

-- Val ('x',123)

--

-- >>> pz @Swap (Left "abc")

-- Val (Right "abc")

--

-- >>> pz @Swap (Right 123)

-- Val (Left 123)

--

-- >>> pl @Swap (Right "asfd")

-- Present Left "asfd" (Swap Left "asfd" | Right "asfd")

-- Val (Left "asfd")

--

-- >>> pl @Swap (12,"asfd")

-- Present ("asfd",12) (Swap ("asfd",12) | (12,"asfd"))

-- Val ("asfd",12)

--

-- >>> pz @Swap (True,12,"asfd")

-- Val (True,"asfd",12)

--

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) []

-- | like 'GHC.Base.$' for expressions taking exactly on argument (similar is 'Predicate.Misc.%%')

-- ie this doesnt work: pz @('(,) $ 4 $ 'True) ()

--

-- >>> pl @(L1 $ L2 $ Id) ((1,2),(3,4))

-- Present 3 (Fst 3 | (3,4))

-- Val 3

--

-- >>> pl @((<=) 4 $ L1 $ L2 $ Id) ((1,2),(3,4))

-- False (4 <= 3)

-- Val False

--

-- >>> pz @('(,) 4 $ 'True) ()

-- Val (4,True)

--

-- >>> pz @('(,) %% 'True %% 'False) () -- cant do this with $

-- Val (True,False)

--

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))

-- | similar to 'Control.Lens.&' for expressions taking exactly on argument

--

-- >>> pl @(Id & L1 & Singleton & Length) (13,"xyzw")

-- Present 1 (Length 1)

-- Val 1

--

-- >>> pl @(2 & (&&&) "abc") ()

-- Present ("abc",2) ('("abc",2))

-- Val ("abc",2)

--

-- >>> pl @(2 & '(,) "abc") ()

-- Present ("abc",2) ('("abc",2))

-- Val ("abc",2)

--

-- >>> pl @('(,) 4 $ '(,) 7 $ "aa") ()

-- Present (4,(7,"aa")) ('(4,(7,"aa")))

-- Val (4,(7,"aa"))

--

-- >>> pl @(L3 $ L2 $ Fst) ((1,("X",9,'a')),(3,4))

-- Present 'a' (Thd 'a' | ("X",9,'a'))

-- Val 'a'

--

-- >>> pz @('True %& 'False %& '(,)) ()

-- Val (False,True)

--

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))

-- | first element in a tuple followed by the first element

--

-- >>> pz @L11 ((10,"ss"),2)

-- Val 10

--

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)

-- | first element in a tuple followed by the second element

--

-- >>> pz @L12 ((10,"ss"),2)

-- Val "ss"

--

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)

-- | first element in a tuple followed by the third element

--

-- >>> pz @L13 ((10,"ss",4.5),2)

-- Val 4.5

--

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)

-- | second element in a tuple followed by the first element

--

-- >>> pz @L21 ('x',(10,"ss",4.5),2)

-- Val 10

--

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)

-- | second element in a tuple followed by the second element

--

-- >>> pz @L22 ('z',(10,"ss",4.5),2)

-- Val "ss"

--

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)

-- | second element in a tuple followed by the third element

--

-- >>> pz @L23 ('x',(10,"ss",4.5),2)

-- Val 4.5

--

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)

-- | third element in a tuple followed by the first element

--

-- >>> pz @L31 (1,2,('c',4))

-- Val 'c'

--

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)

-- | third element in a tuple followed by the second element

--

-- >>> pz @L32 (1,2,('c',4))

-- Val 4

--

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)

-- | third element in a tuple followed by the third element

--

-- >>> pz @L33 (1,2,('c',4,False))

-- Val False

--

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)

-- | for use with TH.Lift in a splice. returns a pure value or fails with a tree

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

-- | run a type level computation and returns the value or a tree with the error

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

-- | creates a 'Data.Semigroup.Arg' value using @p@ and @q@

--

-- >>> pz @('SG.Arg (C "S") 10) ()

-- Val (Arg 'S' 10)

--

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

-- | extracts a tuple from 'Data.Semigroup.Arg'

--

-- >>> pz @('SG.Arg (C "S") 10 >> Arg') ()

-- Val ('S',10)

--

-- >>> pz @Arg' (SG.Arg 'S' 10)

-- Val ('S',10)

--

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)

-- | extracts the () from type level @ENone@ if the value exists

--

-- >>> pl @'ENone ENone

-- Present () ('ENone)

-- Val ()

--

-- >>> pz @'ENone (ERight "aaa")

-- Fail "'ENone found ERight"

--

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
"" []

-- | extracts the @a@ from type level @ELeft a@ if the value exists

--

-- >>> pl @('ELeft Id) (ELeft 12)

-- Present 12 ('ELeft)

-- Val 12

--

-- >>> pz @('ELeft Id) (ERight "aaa")

-- Fail "'ELeft found ERight"

--

-- >>> pz @('ELeft Id) (EBoth 999 "aaa")

-- Fail "'ELeft found EBoth"

--

-- >>> pl @('ELeft Id) (ERight 12)

-- Error 'ELeft found ERight

-- Fail "'ELeft found ERight"

--

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]

-- | extracts the @b@ from type level @ERight b@ if the value exists

--

-- >>> pz @('ERight Id) (ERight 123)

-- Val 123

--

-- >>> pz @('ERight Id) (ELeft "aaa")

-- Fail "'ERight found ELeft"

--

-- >>> pz @('ERight Id) (EBoth 44 "aaa")

-- Fail "'ERight found EBoth"

--

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]

-- | extracts the (a,b) from type level @EBoth a b@ if the value exists

--

-- >>> pz @('EBoth Id Id) (EBoth 123 "abc")

-- Val (123,"abc")

--

-- >>> pz @('EBoth Id 5) (EBoth 123 "abcde")

-- Val (123,5)

--

-- >>> pz @('EBoth Id Id) (ELeft "aaa")

-- Fail "'EBoth found ELeft"

--

-- >>> pz @('EBoth Id Id) (ERight "aaa")

-- Fail "'EBoth found ERight"

--

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
"" []