{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE EmptyDataDeriving #-}
-- | promoted 'Either' functions

module Predicate.Data.Either (

 -- ** predicates

    IsLeft
  , IsRight

 -- ** constructors

  , MkLeft
  , MkLeft'
  , MkRight
  , MkRight'

 -- ** get rid of Either

  , Left'
  , Right'
  , LeftDef
  , LeftFail
  , RightDef
  , RightFail
  , EitherBool
  , PartitionEithers

 -- ** miscellaneous

  , type (|||)
  , type (+++)
  , EitherIn
  , EitherId
  , LeftDef'
  , RightDef'

 -- ** type families

  , EitherInT
 ) where
import Predicate.Core
import Predicate.Misc
import Predicate.Util
import GHC.TypeLits (ErrorMessage((:$$:),(:<>:)))
import qualified GHC.TypeLits as GL
import Data.Proxy (Proxy(Proxy))
import Data.Kind (Type)
import Data.Either (isLeft, isRight, partitionEithers)

-- $setup

-- >>> :set -XDataKinds

-- >>> :set -XTypeApplications

-- >>> :set -XTypeOperators

-- >>> :set -XOverloadedStrings

-- >>> import qualified Data.Text as T

-- >>> import Predicate

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


-- | extracts the left value from an 'Either'

--

-- >>> pz @(Left' >> Succ) (Left 20)

-- Val 21

--

-- >>> pz @(Left' >> Succ) (Right 'a')

-- Fail "Left' found Right"

--

data Left' deriving Int -> Left' -> ShowS
[Left'] -> ShowS
Left' -> String
(Int -> Left' -> ShowS)
-> (Left' -> String) -> ([Left'] -> ShowS) -> Show Left'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Left'] -> ShowS
$cshowList :: [Left'] -> ShowS
show :: Left' -> String
$cshow :: Left' -> String
showsPrec :: Int -> Left' -> ShowS
$cshowsPrec :: Int -> Left' -> ShowS
Show
instance Show a => P Left' (Either a x) where
  type PP Left' (Either a x) = a
  eval :: proxy Left'
-> POpts -> Either a x -> m (TT (PP Left' (Either a x)))
eval proxy Left'
_ POpts
opts Either a x
lr =
    let msg0 :: String
msg0 = String
"Left'"
    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
$ case Either a x
lr of
         Right x
_ -> 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
"" []
         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
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) []

-- | extracts the right value from an 'Either'

--

-- >>> pz @(Right' >> Succ) (Right 20)

-- Val 21

--

-- >>> pz @(Right' >> Succ) (Left 'a')

-- Fail "Right' found Left"

--

data Right' deriving Int -> Right' -> ShowS
[Right'] -> ShowS
Right' -> String
(Int -> Right' -> ShowS)
-> (Right' -> String) -> ([Right'] -> ShowS) -> Show Right'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Right'] -> ShowS
$cshowList :: [Right'] -> ShowS
show :: Right' -> String
$cshow :: Right' -> String
showsPrec :: Int -> Right' -> ShowS
$cshowsPrec :: Int -> Right' -> ShowS
Show
instance Show a => P Right' (Either x a) where
  type PP Right' (Either x a) = a
  eval :: proxy Right'
-> POpts -> Either x a -> m (TT (PP Right' (Either x a)))
eval proxy Right'
_ POpts
opts Either x a
lr =
    let msg0 :: String
msg0 = String
"Right'"
    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
$ case Either x a
lr of
         Left x
_ -> 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 Left")) String
"" []
         Right 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 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) []

-- | similar 'Control.Arrow.|||'

--

-- >>> pz @(Pred ||| Id) (Left 13)

-- Val 12

--

-- >>> pz @(ShowP Id ||| Id) (Right "hello")

-- Val "hello"

--

-- >>> pl @('True ||| 'False) (Left "someval")

-- True ((|||) Left True | "someval")

-- Val True

--

-- >>> pl @('True ||| 'False) (Right "someval")

-- False ((|||) Right False | "someval")

-- Val False

--

-- >>> pl @(ShowP Succ ||| ShowP Id) (Left 123)

-- Present "124" ((|||) Left "124" | 123)

-- Val "124"

--

-- >>> pl @(ShowP Succ ||| ShowP Id) (Right True)

-- Present "True" ((|||) Right "True" | True)

-- Val "True"

--

-- >>> pl @(Not Id ||| Id) (Right True)

-- Present True ((|||) Right True | True)

-- Val True

--

-- >>> pl @(Not Id ||| Id) (Left True)

-- False ((|||) Left False | True)

-- 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 ( Show (PP p a)
         , P p a
         , P q b
         , PP p a ~ PP q b
         , Show a
         , Show b
         ) => P (p ||| q) (Either a b) where
  type PP (p ||| q) (Either a b) = PP p a
  eval :: proxy (p ||| q)
-> POpts -> Either a b -> m (TT (PP (p ||| q) (Either a b)))
eval proxy (p ||| q)
_ POpts
opts Either a b
lr = do
    let msg0 :: String
msg0 = String
"(|||)"
    case Either a b
lr of
      Left a
a -> do
        TT (PP q b)
pp <- Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
a
        TT (PP q b) -> m (TT (PP q b))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q b) -> m (TT (PP q b))) -> TT (PP q b) -> m (TT (PP q b))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP q b)
-> [Tree PE]
-> Either (TT (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 TT (PP q b)
pp [] of
          Left TT (PP q b)
e -> TT (PP q b)
e
          Right PP q b
a1 -> let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" Left"
                      in POpts -> TT (PP q b) -> String -> [Tree PE] -> TT (PP q b)
forall a. POpts -> TT a -> String -> [Tree PE] -> TT a
mkNodeCopy POpts
opts TT (PP q b)
pp (POpts -> String -> PP q b -> a -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg1 PP q b
a1 a
a) []
      Right b
a -> 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
a
        TT (PP q b) -> m (TT (PP q b))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q b) -> m (TT (PP q b))) -> TT (PP q b) -> m (TT (PP q b))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP q b)
-> [Tree PE]
-> Either (TT (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 TT (PP q b)
qq [] of
          Left TT (PP q b)
e -> TT (PP q b)
e
          Right PP q b
a1 ->
            let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" Right"
            in POpts -> TT (PP q b) -> String -> [Tree PE] -> TT (PP q b)
forall a. POpts -> TT a -> String -> [Tree PE] -> TT a
mkNodeCopy POpts
opts TT (PP q b)
qq (POpts -> String -> PP q b -> b -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg1 PP q b
a1 b
a) []

-- | similar to 'isLeft'

--

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

-- Val False

--

-- >>> pz @IsLeft (Left 'a')

-- Val True

--

data IsLeft deriving Int -> IsLeft -> ShowS
[IsLeft] -> ShowS
IsLeft -> String
(Int -> IsLeft -> ShowS)
-> (IsLeft -> String) -> ([IsLeft] -> ShowS) -> Show IsLeft
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsLeft] -> ShowS
$cshowList :: [IsLeft] -> ShowS
show :: IsLeft -> String
$cshow :: IsLeft -> String
showsPrec :: Int -> IsLeft -> ShowS
$cshowsPrec :: Int -> IsLeft -> ShowS
Show

instance x ~ Either a b
       => P IsLeft x where
  type PP IsLeft x = Bool
  eval :: proxy IsLeft -> POpts -> x -> m (TT (PP IsLeft x))
eval proxy IsLeft
_ 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
$ POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts (Either a b -> Bool
forall a b. Either a b -> Bool
isLeft x
Either a b
x) String
"IsLeft" []

-- | similar to 'isRight'

--

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

-- Val True

--

-- >>> pz @IsRight (Left "aa")

-- Val False

--

data IsRight deriving Int -> IsRight -> ShowS
[IsRight] -> ShowS
IsRight -> String
(Int -> IsRight -> ShowS)
-> (IsRight -> String) -> ([IsRight] -> ShowS) -> Show IsRight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsRight] -> ShowS
$cshowList :: [IsRight] -> ShowS
show :: IsRight -> String
$cshow :: IsRight -> String
showsPrec :: Int -> IsRight -> ShowS
$cshowsPrec :: Int -> IsRight -> ShowS
Show

instance x ~ Either a b
         => P IsRight x where
  type PP IsRight x = Bool
  eval :: proxy IsRight -> POpts -> x -> m (TT (PP IsRight x))
eval proxy IsRight
_ 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
$ POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts (Either a b -> Bool
forall a b. Either a b -> Bool
isRight x
Either a b
x) String
"IsRight" []


-- | similar 'Control.Arrow.+++'

--

-- >>> pz @(Pred +++ Id) (Left 13)

-- Val (Left 12)

--

-- >>> pz @(ShowP Id +++ Reverse) (Right "hello")

-- Val (Right "olleh")

--

-- >>> pl @(HeadDef 'False Id +++ Id) (Right @[Bool] 1) -- need @[Bool] to match with 'False

-- Present Right 1 ((+++) Right 1 | 1)

-- Val (Right 1)

--

-- >>> pl @(HeadDef 'False Id +++ Id) (Left [True,False]) -- need @[Bool] to match with 'False!

-- Present Left True ((+++) Left True | [True,False])

-- Val (Left True)

--

-- >>> pl @(Not Id +++ Id) (Right True)

-- Present Right True ((+++) Right True | True)

-- Val (Right True)

--

-- >>> pl @(Not Id +++ Id) (Right 12)

-- Present Right 12 ((+++) Right 12 | 12)

-- Val (Right 12)

--

-- >>> pl @(HeadDef () Id +++ Id) (Right @[()] 1) -- breaks otherwise: Id says () -> () so has to be a list of [()]

-- Present Right 1 ((+++) Right 1 | 1)

-- Val (Right 1)

--

-- >>> pl @(HeadDef () Id +++ Id) (Right @[()] 1) -- this breaks! as Left doesnt have a type

-- Present Right 1 ((+++) Right 1 | 1)

-- Val (Right 1)

--

-- >>> pl @(Not Id +++ Id) (Right @Bool 12)

-- Present Right 12 ((+++) Right 12 | 12)

-- Val (Right 12)

--

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 ( Show (PP p a)
         , Show (PP q b)
         , P p a
         , P q b
         , Show a
         , Show b
         ) => P (p +++ q) (Either a b) where
  type PP (p +++ q) (Either a b) = Either (PP p a) (PP q b)
  eval :: proxy (p +++ q)
-> POpts -> Either a b -> m (TT (PP (p +++ q) (Either a b)))
eval proxy (p +++ q)
_ POpts
opts Either a b
lr = do
    let msg0 :: String
msg0 = String
"(+++)"
    case Either a b
lr of
      Left 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
        TT (Either (PP p a) (PP q b)) -> m (TT (Either (PP p a) (PP q b)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Either (PP p a) (PP q b))
 -> m (TT (Either (PP p a) (PP q b))))
-> TT (Either (PP p a) (PP q b))
-> m (TT (Either (PP p a) (PP q b)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p a)
-> [Tree PE]
-> Either (TT (Either (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 (Either (PP p a) (PP q b))
e -> TT (Either (PP p a) (PP q b))
e
          Right PP p a
p ->
            let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" Left"
            in POpts
-> Val (Either (PP p a) (PP q b))
-> String
-> [Tree PE]
-> TT (Either (PP p a) (PP q b))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Either (PP p a) (PP q b) -> Val (Either (PP p a) (PP q b))
forall a. a -> Val a
Val (PP p a -> Either (PP p a) (PP q b)
forall a b. a -> Either a b
Left PP p a
p)) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP p a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP p a
p 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]
      Right b
a -> 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
a
        TT (Either (PP p a) (PP q b)) -> m (TT (Either (PP p a) (PP q b)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Either (PP p a) (PP q b))
 -> m (TT (Either (PP p a) (PP q b))))
-> TT (Either (PP p a) (PP q b))
-> m (TT (Either (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 (Either (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 TT (PP q b)
qq [] of
          Left TT (Either (PP p a) (PP q b))
e -> TT (Either (PP p a) (PP q b))
e
          Right PP q b
q ->
            let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" Right"
            in POpts
-> Val (Either (PP p a) (PP q b))
-> String
-> [Tree PE]
-> TT (Either (PP p a) (PP q b))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Either (PP p a) (PP q b) -> Val (Either (PP p a) (PP q b))
forall a. a -> Val a
Val (PP q b -> Either (PP p a) (PP q b)
forall a b. b -> Either a b
Right PP q b
q)) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q b -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q b
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> b -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " b
a) [TT (PP q b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q b)
qq]

-- | similar to 'partitionEithers'

--

-- >>> pz @PartitionEithers [Left 'a',Right 2,Left 'c',Right 4,Right 99]

-- Val ("ac",[2,4,99])

--

-- >>> pz @PartitionEithers [Right 2,Right 4,Right 99]

-- Val ([],[2,4,99])

--

-- >>> pz @PartitionEithers [Left 'a',Left 'c']

-- Val ("ac",[])

--

-- >>> pz @PartitionEithers ([] :: [Either () Int])

-- Val ([],[])

--

-- >>> pl @PartitionEithers [Left 4, Right 'x', Right 'y',Left 99]

-- Present ([4,99],"xy") (PartitionEithers ([4,99],"xy") | [Left 4,Right 'x',Right 'y',Left 99])

-- Val ([4,99],"xy")

--

-- >>> pl @PartitionEithers [Left 'x', Right 1,Left 'a', Left 'b',Left 'z', Right 10]

-- Present ("xabz",[1,10]) (PartitionEithers ("xabz",[1,10]) | [Left 'x',Right 1,Left 'a',Left 'b',Left 'z',Right 10])

-- Val ("xabz",[1,10])

--

data PartitionEithers deriving Int -> PartitionEithers -> ShowS
[PartitionEithers] -> ShowS
PartitionEithers -> String
(Int -> PartitionEithers -> ShowS)
-> (PartitionEithers -> String)
-> ([PartitionEithers] -> ShowS)
-> Show PartitionEithers
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartitionEithers] -> ShowS
$cshowList :: [PartitionEithers] -> ShowS
show :: PartitionEithers -> String
$cshow :: PartitionEithers -> String
showsPrec :: Int -> PartitionEithers -> ShowS
$cshowsPrec :: Int -> PartitionEithers -> ShowS
Show

instance ( Show a
         , Show b
         ) => P PartitionEithers [Either a b] where
  type PP PartitionEithers [Either a b] = ([a], [b])
  eval :: proxy PartitionEithers
-> POpts
-> [Either a b]
-> m (TT (PP PartitionEithers [Either a b]))
eval proxy PartitionEithers
_ POpts
opts [Either a b]
as =
    let msg0 :: String
msg0 = String
"PartitionEithers"
        b :: ([a], [b])
b = [Either a b] -> ([a], [b])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either a b]
as
    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])
b) (POpts -> String -> ([a], [b]) -> [Either a b] -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 ([a], [b])
b [Either a b]
as) []

-- | Convenient method to convert a @p@ or @q@ to a 'Either' based on a predicate @b@

--   if @b@ then Right @p@ else Left @q@

--

-- >>> pz @(EitherBool (Fst > 4) L21 L22) (24,(-1,999))

-- Val (Right 999)

--

-- >>> pz @(EitherBool (Fst > 4) L21 L22) (1,(-1,999))

-- Val (Left (-1))

--

-- >>> pl @(EitherBool (Fst > 10) L21 L22) (7,('x',99))

-- Present Left 'x' (EitherBool(False) Left 'x')

-- Val (Left 'x')

--

-- >>> pl @(EitherBool (Fst > 10) L21 L22) (11,('x',99))

-- Present Right 99 (EitherBool(True) Right 99)

-- Val (Right 99)

--

-- >>> pl @(EitherBool (Gt 10) "found left" 99) 12

-- Present Right 99 (EitherBool(True) Right 99)

-- Val (Right 99)

--

-- >>> pl @(EitherBool (Gt 10) "found left" 99) 7

-- Present Left "found left" (EitherBool(False) Left "found left")

-- Val (Left "found left")

--

data EitherBool b p q deriving Int -> EitherBool b p q -> ShowS
[EitherBool b p q] -> ShowS
EitherBool b p q -> String
(Int -> EitherBool b p q -> ShowS)
-> (EitherBool b p q -> String)
-> ([EitherBool b p q] -> ShowS)
-> Show (EitherBool b p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (b :: k) k (p :: k) k (q :: k).
Int -> EitherBool b p q -> ShowS
forall k (b :: k) k (p :: k) k (q :: k).
[EitherBool b p q] -> ShowS
forall k (b :: k) k (p :: k) k (q :: k). EitherBool b p q -> String
showList :: [EitherBool b p q] -> ShowS
$cshowList :: forall k (b :: k) k (p :: k) k (q :: k).
[EitherBool b p q] -> ShowS
show :: EitherBool b p q -> String
$cshow :: forall k (b :: k) k (p :: k) k (q :: k). EitherBool b p q -> String
showsPrec :: Int -> EitherBool b p q -> ShowS
$cshowsPrec :: forall k (b :: k) k (p :: k) k (q :: k).
Int -> EitherBool b p q -> ShowS
Show

instance ( Show (PP p a)
         , P p a
         , Show (PP q a)
         , P q a
         , P b a
         , PP b a ~ Bool
         ) => P (EitherBool b p q) a where
  type PP (EitherBool b p q) a = Either (PP p a) (PP q a)
  eval :: proxy (EitherBool b p q)
-> POpts -> a -> m (TT (PP (EitherBool b p q) a))
eval proxy (EitherBool b p q)
_ POpts
opts a
z = do
    let msg0 :: String
msg0 = String
"EitherBool"
    TT Bool
bb <- Proxy b -> POpts -> a -> m (TT (PP b 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 b
forall k (t :: k). Proxy t
Proxy @b) POpts
opts a
z
    case Inline
-> POpts
-> String
-> TT Bool
-> [Tree PE]
-> Either (TT (Either (PP p a) (PP q a))) Bool
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
" b failed") TT Bool
bb [] of
      Left TT (Either (PP p a) (PP q a))
e -> TT (Either (PP p a) (PP q a)) -> m (TT (Either (PP p a) (PP q a)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (Either (PP p a) (PP q a))
e
      Right Bool
False -> 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
z
        TT (Either (PP p a) (PP q a)) -> m (TT (Either (PP p a) (PP q a)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Either (PP p a) (PP q a))
 -> m (TT (Either (PP p a) (PP q a))))
-> TT (Either (PP p a) (PP q a))
-> m (TT (Either (PP p a) (PP q a)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p a)
-> [Tree PE]
-> Either (TT (Either (PP p a) (PP q 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 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" p failed") TT (PP p a)
pp [TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
bb] of
          Left TT (Either (PP p a) (PP q a))
e -> TT (Either (PP p a) (PP q a))
e
          Right PP p a
p -> POpts
-> Val (Either (PP p a) (PP q a))
-> String
-> [Tree PE]
-> TT (Either (PP p a) (PP q a))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Either (PP p a) (PP q a) -> Val (Either (PP p a) (PP q a))
forall a. a -> Val a
Val (PP p a -> Either (PP p a) (PP q a)
forall a b. a -> Either a b
Left PP p a
p)) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"(False) Left " 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 Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
bb, TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp]
      Right Bool
True -> do
        TT (PP q a)
qq <- Proxy q -> POpts -> a -> m (TT (PP q a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
z
        TT (Either (PP p a) (PP q a)) -> m (TT (Either (PP p a) (PP q a)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Either (PP p a) (PP q a))
 -> m (TT (Either (PP p a) (PP q a))))
-> TT (Either (PP p a) (PP q a))
-> m (TT (Either (PP p a) (PP q a)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP q a)
-> [Tree PE]
-> Either (TT (Either (PP p a) (PP q a))) (PP q a)
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") TT (PP q a)
qq [TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
bb] of
          Left TT (Either (PP p a) (PP q a))
e -> TT (Either (PP p a) (PP q a))
e
          Right PP q a
q -> POpts
-> Val (Either (PP p a) (PP q a))
-> String
-> [Tree PE]
-> TT (Either (PP p a) (PP q a))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Either (PP p a) (PP q a) -> Val (Either (PP p a) (PP q a))
forall a. a -> Val a
Val (PP q a -> Either (PP p a) (PP q a)
forall a b. b -> Either a b
Right PP q a
q)) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"(True) Right " 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) [TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
bb, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]

-- | 'Data.Either.Left' constructor

data MkLeft' t p deriving Int -> MkLeft' t p -> ShowS
[MkLeft' t p] -> ShowS
MkLeft' t p -> String
(Int -> MkLeft' t p -> ShowS)
-> (MkLeft' t p -> String)
-> ([MkLeft' t p] -> ShowS)
-> Show (MkLeft' t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (p :: k). Int -> MkLeft' t p -> ShowS
forall k (t :: k) k (p :: k). [MkLeft' t p] -> ShowS
forall k (t :: k) k (p :: k). MkLeft' t p -> String
showList :: [MkLeft' t p] -> ShowS
$cshowList :: forall k (t :: k) k (p :: k). [MkLeft' t p] -> ShowS
show :: MkLeft' t p -> String
$cshow :: forall k (t :: k) k (p :: k). MkLeft' t p -> String
showsPrec :: Int -> MkLeft' t p -> ShowS
$cshowsPrec :: forall k (t :: k) k (p :: k). Int -> MkLeft' t p -> ShowS
Show

instance ( Show (PP p x)
         , P p x
         ) => P (MkLeft' t p) x where
  type PP (MkLeft' t p) x = Either (PP p x) (PP t x)
  eval :: proxy (MkLeft' t p) -> POpts -> x -> m (TT (PP (MkLeft' t p) x))
eval proxy (MkLeft' t p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"MkLeft"
    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 (Either (PP p x) (PP t x)) -> m (TT (Either (PP p x) (PP t x)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Either (PP p x) (PP t x))
 -> m (TT (Either (PP p x) (PP t x))))
-> TT (Either (PP p x) (PP t x))
-> m (TT (Either (PP p x) (PP t x)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT (Either (PP p x) (PP t 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 (Either (PP p x) (PP t x))
e -> TT (Either (PP p x) (PP t x))
e
      Right PP p x
p ->
        let d :: Either (PP p x) (PP t x)
d = PP p x -> Either (PP p x) (PP t x)
forall a b. a -> Either a b
Left PP p x
p
        in POpts
-> Val (Either (PP p x) (PP t x))
-> String
-> [Tree PE]
-> TT (Either (PP p x) (PP t x))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Either (PP p x) (PP t x) -> Val (Either (PP p x) (PP t x))
forall a. a -> Val a
Val Either (PP p x) (PP t x)
d) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Left " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP p x -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]

-- | 'Data.Either.Left' constructor

--

-- >>> pz @(MkLeft _ Id) 44

-- Val (Left 44)

--

data MkLeft (t :: Type) p deriving Int -> MkLeft t p -> ShowS
[MkLeft t p] -> ShowS
MkLeft t p -> String
(Int -> MkLeft t p -> ShowS)
-> (MkLeft t p -> String)
-> ([MkLeft t p] -> ShowS)
-> Show (MkLeft t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t k (p :: k). Int -> MkLeft t p -> ShowS
forall t k (p :: k). [MkLeft t p] -> ShowS
forall t k (p :: k). MkLeft t p -> String
showList :: [MkLeft t p] -> ShowS
$cshowList :: forall t k (p :: k). [MkLeft t p] -> ShowS
show :: MkLeft t p -> String
$cshow :: forall t k (p :: k). MkLeft t p -> String
showsPrec :: Int -> MkLeft t p -> ShowS
$cshowsPrec :: forall t k (p :: k). Int -> MkLeft t p -> ShowS
Show
type MkLeftT (t :: Type) p = MkLeft' (Hole t) p

instance P (MkLeftT t p) x => P (MkLeft t p) x where
  type PP (MkLeft t p) x = PP (MkLeftT t p) x
  eval :: proxy (MkLeft t p) -> POpts -> x -> m (TT (PP (MkLeft t p) x))
eval proxy (MkLeft t p)
_ = Proxy (MkLeftT t p) -> POpts -> x -> m (TT (PP (MkLeftT 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 (MkLeftT t p)
forall k (t :: k). Proxy t
Proxy @(MkLeftT t p))

-- | 'Data.Either.Right' constructor

data MkRight' t p deriving Int -> MkRight' t p -> ShowS
[MkRight' t p] -> ShowS
MkRight' t p -> String
(Int -> MkRight' t p -> ShowS)
-> (MkRight' t p -> String)
-> ([MkRight' t p] -> ShowS)
-> Show (MkRight' t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (p :: k). Int -> MkRight' t p -> ShowS
forall k (t :: k) k (p :: k). [MkRight' t p] -> ShowS
forall k (t :: k) k (p :: k). MkRight' t p -> String
showList :: [MkRight' t p] -> ShowS
$cshowList :: forall k (t :: k) k (p :: k). [MkRight' t p] -> ShowS
show :: MkRight' t p -> String
$cshow :: forall k (t :: k) k (p :: k). MkRight' t p -> String
showsPrec :: Int -> MkRight' t p -> ShowS
$cshowsPrec :: forall k (t :: k) k (p :: k). Int -> MkRight' t p -> ShowS
Show

instance ( Show (PP p x)
         , P p x
         ) => P (MkRight' t p) x where
  type PP (MkRight' t p) x = Either (PP t x) (PP p x)
  eval :: proxy (MkRight' t p) -> POpts -> x -> m (TT (PP (MkRight' t p) x))
eval proxy (MkRight' t p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"MkRight"
    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 (Either (PP t x) (PP p x)) -> m (TT (Either (PP t x) (PP p x)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Either (PP t x) (PP p x))
 -> m (TT (Either (PP t x) (PP p x))))
-> TT (Either (PP t x) (PP p x))
-> m (TT (Either (PP t x) (PP p x)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT (Either (PP t x) (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 (Either (PP t x) (PP p x))
e -> TT (Either (PP t x) (PP p x))
e
      Right PP p x
p ->
        let d :: Either (PP t x) (PP p x)
d = PP p x -> Either (PP t x) (PP p x)
forall a b. b -> Either a b
Right PP p x
p
        in POpts
-> Val (Either (PP t x) (PP p x))
-> String
-> [Tree PE]
-> TT (Either (PP t x) (PP p x))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Either (PP t x) (PP p x) -> Val (Either (PP t x) (PP p x))
forall a. a -> Val a
Val Either (PP t x) (PP p x)
d) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Right " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP p x -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]

-- | 'Data.Either.Right' constructor

--

-- >>> pz @(MkRight _ Id) 44

-- Val (Right 44)

--

data MkRight (t :: Type) p deriving Int -> MkRight t p -> ShowS
[MkRight t p] -> ShowS
MkRight t p -> String
(Int -> MkRight t p -> ShowS)
-> (MkRight t p -> String)
-> ([MkRight t p] -> ShowS)
-> Show (MkRight t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t k (p :: k). Int -> MkRight t p -> ShowS
forall t k (p :: k). [MkRight t p] -> ShowS
forall t k (p :: k). MkRight t p -> String
showList :: [MkRight t p] -> ShowS
$cshowList :: forall t k (p :: k). [MkRight t p] -> ShowS
show :: MkRight t p -> String
$cshow :: forall t k (p :: k). MkRight t p -> String
showsPrec :: Int -> MkRight t p -> ShowS
$cshowsPrec :: forall t k (p :: k). Int -> MkRight t p -> ShowS
Show
type MkRightT (t :: Type) p = MkRight' (Hole t) p

instance P (MkRightT t p) x => P (MkRight t p) x where
  type PP (MkRight t p) x = PP (MkRightT t p) x
  eval :: proxy (MkRight t p) -> POpts -> x -> m (TT (PP (MkRight t p) x))
eval proxy (MkRight t p)
_ = Proxy (MkRightT t p) -> POpts -> x -> m (TT (PP (MkRightT 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 (MkRightT t p)
forall k (t :: k). Proxy t
Proxy @(MkRightT t p))

-- | extract the Left value from an 'Either' otherwise use the default value: similar to 'Data.Either.fromLeft'

--

-- if there is no Left value then @p@ is passed the Right value and the whole context

--

-- >>> pz @(LeftDef (1 % 4) Id) (Left 20.4)

-- Val (102 % 5)

--

-- >>> pz @(LeftDef (1 % 4) Id) (Right "aa")

-- Val (1 % 4)

--

-- >>> pz @(LeftDef (PrintT "found right=%s fst=%d" '(Fst,L21)) Snd) (123,Right "xy")

-- Val "found right=xy fst=123"

--

-- >>> pz @(LeftDef (MEmptyT _) Id) (Right 222)

-- Val ()

--

-- >>> pz @(LeftDef (MEmptyT (SG.Sum _)) Id) (Right 222)

-- Val (Sum {getSum = 0})

--

data LeftDef p q deriving Int -> LeftDef p q -> ShowS
[LeftDef p q] -> ShowS
LeftDef p q -> String
(Int -> LeftDef p q -> ShowS)
-> (LeftDef p q -> String)
-> ([LeftDef p q] -> ShowS)
-> Show (LeftDef p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> LeftDef p q -> ShowS
forall k (p :: k) k (q :: k). [LeftDef p q] -> ShowS
forall k (p :: k) k (q :: k). LeftDef p q -> String
showList :: [LeftDef p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [LeftDef p q] -> ShowS
show :: LeftDef p q -> String
$cshow :: forall k (p :: k) k (q :: k). LeftDef p q -> String
showsPrec :: Int -> LeftDef p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> LeftDef p q -> ShowS
Show

instance ( PP q x ~ Either a b
         , PP p (b,x) ~ a
         , P q x
         , P p (b,x)
    ) => P (LeftDef p q) x where
  type PP (LeftDef p q) x = LeftT (PP q x)
  eval :: proxy (LeftDef p q) -> POpts -> x -> m (TT (PP (LeftDef p q) x))
eval proxy (LeftDef p q)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"LeftDef"
    TT (Either a b)
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 (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)
qq [] of
      Left TT a
e -> TT a -> m (TT a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT a
e
      Right Either a b
q ->
        case Either a b
q of
          Left a
a -> TT a -> m (TT a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT a -> m (TT a)) -> TT a -> m (TT a)
forall a b. (a -> b) -> a -> b
$ 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
" Left") [TT (Either a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Either a b)
qq]
          Right b
b -> do
            TT a
pp <- Proxy p -> POpts -> (b, x) -> m (TT (PP p (b, 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 (b
b,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 a -> [Tree PE] -> Either (TT a) a
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT a
pp [TT (Either a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Either a b)
qq] of
              Left TT a
e -> TT a
e
              Right a
_ -> POpts -> TT a -> String -> [Tree PE] -> TT a
forall a. POpts -> TT a -> String -> [Tree PE] -> TT a
mkNodeCopy POpts
opts TT a
pp (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Right") [TT (Either a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Either a b)
qq]

-- | extract the Right value from an 'Either': similar to 'Data.Either.fromRight'

--

-- if there is no Right value then @p@ is passed the Left value and the whole context

--

-- >>> pz @(RightDef (1 % 4) Id) (Right 20.4)

-- Val (102 % 5)

--

-- >>> pz @(RightDef (1 % 4) Id) (Left "aa")

-- Val (1 % 4)

--

-- >>> pz @(RightDef (PrintT "found left=%s fst=%d" '(Fst,L21)) Snd) (123,Left "xy")

-- Val "found left=xy fst=123"

--

-- >>> pz @(RightDef (MEmptyT _) Id) (Left 222)

-- Val ()

--

-- >>> pz @(RightDef (MEmptyT (SG.Sum _)) Id) (Left 222)

-- Val (Sum {getSum = 0})

--

data RightDef p q deriving Int -> RightDef p q -> ShowS
[RightDef p q] -> ShowS
RightDef p q -> String
(Int -> RightDef p q -> ShowS)
-> (RightDef p q -> String)
-> ([RightDef p q] -> ShowS)
-> Show (RightDef p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> RightDef p q -> ShowS
forall k (p :: k) k (q :: k). [RightDef p q] -> ShowS
forall k (p :: k) k (q :: k). RightDef p q -> String
showList :: [RightDef p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [RightDef p q] -> ShowS
show :: RightDef p q -> String
$cshow :: forall k (p :: k) k (q :: k). RightDef p q -> String
showsPrec :: Int -> RightDef p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> RightDef p q -> ShowS
Show

instance ( PP q x ~ Either a b
         , PP p (a,x) ~ b
         , P q x
         , P p (a,x)
    ) => P (RightDef p q) x where
  type PP (RightDef p q) x = RightT (PP q x)
  eval :: proxy (RightDef p q) -> POpts -> x -> m (TT (PP (RightDef p q) x))
eval proxy (RightDef p q)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"RightDef"
    TT (Either a b)
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 (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)
qq [] of
      Left TT b
e -> TT b -> m (TT b)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT b
e
      Right Either a b
q ->
        case Either a b
q of
          Right b
b -> 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
$ 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 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Right") [TT (Either a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Either a b)
qq]
          Left a
a -> do
            TT b
pp <- Proxy p -> POpts -> (a, x) -> m (TT (PP p (a, 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 (a
a,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 b -> [Tree PE] -> Either (TT b) b
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT b
pp [TT (Either a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Either a b)
qq] of
              Left TT b
e -> TT b
e
              Right b
_ -> POpts -> TT b -> String -> [Tree PE] -> TT b
forall a. POpts -> TT a -> String -> [Tree PE] -> TT a
mkNodeCopy POpts
opts TT b
pp (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Left") [TT (Either a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Either a b)
qq]

-- | extract the Left value from an 'Either' otherwise fail with a message

--

-- if there is no Left value then @p@ is passed the Right value and the whole context

--

-- >>> pz @(LeftFail "oops" Id) (Left 20.4)

-- Val 20.4

--

-- >>> pz @(LeftFail "oops" Id) (Right "aa")

-- Fail "oops"

--

-- >>> pz @(LeftFail (PrintT "found right=%s fst=%d" '(Fst,L21)) Snd) (123,Right "xy")

-- Fail "found right=xy fst=123"

--

-- >>> pz @(LeftFail (MEmptyT _) Id) (Right 222)

-- Fail ""

--

-- >>> pl @(LeftFail (PrintF "someval=%d" L21) Snd) (13::Int,Right @(SG.Sum Int) "abc")

-- Error someval=13 (LeftFail Right)

-- Fail "someval=13"

--

-- >>> pl @(LeftFail (PrintF "someval=%s" Fst) Id) (Right @(SG.Sum Int) "abc")

-- Error someval=abc (LeftFail Right)

-- Fail "someval=abc"

--

-- >>> pl @(LeftFail (PrintF "found rhs=%d" Fst) Id) (Right @String @Int 10)

-- Error found rhs=10 (LeftFail Right)

-- Fail "found rhs=10"

--

-- >>> pl @(LeftFail (PrintF "found rhs=%d" (Snd >> L22)) L21) ('x',(Right 10,23))

-- Error found rhs=23 (LeftFail Right)

-- Fail "found rhs=23"

--

-- >>> pl @(LeftFail (PrintF "found rhs=%d" (L2 L22)) L21) ('x',(Left "abc",23))

-- Present "abc" (Left)

-- Val "abc"

--

data LeftFail p q deriving Int -> LeftFail p q -> ShowS
[LeftFail p q] -> ShowS
LeftFail p q -> String
(Int -> LeftFail p q -> ShowS)
-> (LeftFail p q -> String)
-> ([LeftFail p q] -> ShowS)
-> Show (LeftFail p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> LeftFail p q -> ShowS
forall k (p :: k) k (q :: k). [LeftFail p q] -> ShowS
forall k (p :: k) k (q :: k). LeftFail p q -> String
showList :: [LeftFail p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [LeftFail p q] -> ShowS
show :: LeftFail p q -> String
$cshow :: forall k (p :: k) k (q :: k). LeftFail p q -> String
showsPrec :: Int -> LeftFail p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> LeftFail p q -> ShowS
Show

instance ( PP p (b,x) ~ String
         , PP q x ~ Either a b
         , P p (b,x)
         , P q x
         )
    => P (LeftFail p q) x where
  type PP (LeftFail p q) x = LeftT (PP q x)
  eval :: proxy (LeftFail p q) -> POpts -> x -> m (TT (PP (LeftFail p q) x))
eval proxy (LeftFail p q)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"LeftFail"
    TT (Either a b)
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 (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)
qq [] of
      Left TT a
e -> TT a -> m (TT a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT a
e
      Right Either a b
q ->
        case Either a b
q of
          Left a
a -> TT a -> m (TT a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT a -> m (TT a)) -> TT a -> m (TT a)
forall a b. (a -> b) -> a -> b
$ 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)
qq]
          Right b
b -> do
            TT String
pp <- Proxy p -> POpts -> (b, x) -> m (TT (PP p (b, 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 (b
b,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 String
-> [Tree PE]
-> Either (TT 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 [TT (Either a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Either a b)
qq] of
              Left TT a
e -> TT a
e
              Right String
p -> 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
p) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Right") [TT (Either a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Either a b)
qq, TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]


-- | extract the Right value from an 'Either' otherwise fail with a message

--

-- if there is no Right value then @p@ is passed the Left value and the whole context

--

-- >>> pz @(RightFail "oops" Id) (Right 20.4)

-- Val 20.4

--

-- >>> pz @(RightFail "oops" Id) (Left "aa")

-- Fail "oops"

--

-- >>> pz @(RightFail (PrintT "found left=%s fst=%d" '(Fst,L21)) Snd) (123,Left "xy")

-- Fail "found left=xy fst=123"

--

-- >>> pz @(RightFail (MEmptyT _) Id) (Left 222)

-- Fail ""

--

data RightFail p q deriving Int -> RightFail p q -> ShowS
[RightFail p q] -> ShowS
RightFail p q -> String
(Int -> RightFail p q -> ShowS)
-> (RightFail p q -> String)
-> ([RightFail p q] -> ShowS)
-> Show (RightFail p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> RightFail p q -> ShowS
forall k (p :: k) k (q :: k). [RightFail p q] -> ShowS
forall k (p :: k) k (q :: k). RightFail p q -> String
showList :: [RightFail p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [RightFail p q] -> ShowS
show :: RightFail p q -> String
$cshow :: forall k (p :: k) k (q :: k). RightFail p q -> String
showsPrec :: Int -> RightFail p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> RightFail p q -> ShowS
Show

instance ( PP p (a,x) ~ String
         , PP q x ~ Either a b
         , P p (a,x)
         , P q x
         )
    => P (RightFail p q) x where
  type PP (RightFail p q) x = RightT (PP q x)
  eval :: proxy (RightFail p q)
-> POpts -> x -> m (TT (PP (RightFail p q) x))
eval proxy (RightFail p q)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"RightFail"
    TT (Either a b)
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 (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)
qq [] of
      Left TT b
e -> TT b -> m (TT b)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT b
e
      Right Either a b
q ->
        case Either a b
q of
          Right b
b -> 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
$ 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)
qq]
          Left a
a -> do
            TT String
pp <- Proxy p -> POpts -> (a, x) -> m (TT (PP p (a, 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 (a
a,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 String
-> [Tree PE]
-> Either (TT b) 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 [TT (Either a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Either a b)
qq] of
              Left TT b
e -> TT b
e
              Right String
p -> 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
p) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Left") [TT (Either a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Either a b)
qq, TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]


-- | destructor for Either (similar to 'Control.Arrow.|||' but with an extra environment @s@)

--   @p@ @Left a@ receives @(PP t x,a)@

--   @q@ @Right b@ receives @(PP t x,b)@

--   @s@ points to the environment you want to pass in

--   @t@ points to the Either value

--

-- >>> pz @(EitherIn (ShowP (Fst + Snd)) (ShowP Id) Fst Snd) (9,Left 123)

-- Val "132"

--

-- >>> pz @(EitherIn (ShowP (Fst + Snd)) (ShowP Id) Fst Snd) (9,Right 'x')

-- Val "(9,'x')"

--

-- >>> pz @(EitherIn (ShowP Id) (ShowP (Second Succ)) Fst Snd) (9,Right 'x')

-- Val "(9,'y')"

--

-- >>> pz @(EitherIn (FailT _ (PrintF ("found left=%d") Snd)) (Second Succ) Fst Snd) (9,Right 'x')

-- Val (9,'y')

--

-- >>> pz @(EitherIn (FailT _ (PrintF ("found left=%d") Snd)) (Second Succ) Fst Snd) (9,Left 13)

-- Fail "found left=13"

--

data EitherIn p q s t deriving Int -> EitherIn p q s t -> ShowS
[EitherIn p q s t] -> ShowS
EitherIn p q s t -> String
(Int -> EitherIn p q s t -> ShowS)
-> (EitherIn p q s t -> String)
-> ([EitherIn p q s t] -> ShowS)
-> Show (EitherIn p q s t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k) k (s :: k) k (t :: k).
Int -> EitherIn p q s t -> ShowS
forall k (p :: k) k (q :: k) k (s :: k) k (t :: k).
[EitherIn p q s t] -> ShowS
forall k (p :: k) k (q :: k) k (s :: k) k (t :: k).
EitherIn p q s t -> String
showList :: [EitherIn p q s t] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k) k (s :: k) k (t :: k).
[EitherIn p q s t] -> ShowS
show :: EitherIn p q s t -> String
$cshow :: forall k (p :: k) k (q :: k) k (s :: k) k (t :: k).
EitherIn p q s t -> String
showsPrec :: Int -> EitherIn p q s t -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k) k (s :: k) k (t :: k).
Int -> EitherIn p q s t -> ShowS
Show

instance ( Show a
         , Show b
         , Show (PP q (y,b))
         , P p (y,a)
         , P q (y,b)
         , PP p (y,a) ~ PP q (y,b)
         , P s x
         , P t x
         , PP s x ~ y
         , PP t x ~ Either a b
         )  => P (EitherIn p q s t) x where
  type PP (EitherIn p q s t) x = EitherInT p (PP s x) (PP t x)
  eval :: proxy (EitherIn p q s t)
-> POpts -> x -> m (TT (PP (EitherIn p q s t) x))
eval proxy (EitherIn p q s t)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"EitherIn"
    Either (TT (PP q (y, b))) (y, Either a b, TT y, TT (Either a b))
lr <- Inline
-> String
-> Proxy s
-> Proxy t
-> POpts
-> x
-> [Tree PE]
-> m (Either
        (TT (PP q (y, b))) (PP s x, PP t x, TT (PP s x), TT (PP t x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy s
forall k (t :: k). Proxy t
Proxy @s) (Proxy t
forall k (t :: k). Proxy t
Proxy @t) POpts
opts x
x []
    case Either (TT (PP q (y, b))) (y, Either a b, TT y, TT (Either a b))
lr of
      Left TT (PP q (y, b))
e -> TT (PP q (y, b)) -> m (TT (PP q (y, b)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP q (y, b))
e
      Right (y
s,Either a b
t,TT y
ss,TT (Either a b)
tt) -> do
         let hhs :: [Tree PE]
hhs = [TT y -> Tree PE
forall a. TT a -> Tree PE
hh TT y
ss, TT (Either a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (Either a b)
tt]
         case Either a b
t of
            Left a
a -> do
              let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"(Left)"
              TT (PP q (y, b))
pp <- Proxy p -> POpts -> (y, a) -> m (TT (PP p (y, 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 (y
s,a
a)
              TT (PP q (y, b)) -> m (TT (PP q (y, b)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q (y, b)) -> m (TT (PP q (y, b))))
-> TT (PP q (y, b)) -> m (TT (PP q (y, b)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP q (y, b))
-> [Tree PE]
-> Either (TT (PP q (y, b))) (PP q (y, b))
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" p failed") TT (PP q (y, b))
pp [Tree PE]
hhs of
                   Left TT (PP q (y, b))
e -> TT (PP q (y, b))
e
                   Right PP q (y, b)
c -> POpts
-> TT (PP q (y, b)) -> String -> [Tree PE] -> TT (PP q (y, b))
forall a. POpts -> TT a -> String -> [Tree PE] -> TT a
mkNodeCopy POpts
opts TT (PP q (y, b))
pp (POpts -> String -> PP q (y, b) -> a -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg1 PP q (y, b)
c a
a) [Tree PE]
hhs
            Right b
b -> do
              let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"(Right)"
              TT (PP q (y, b))
qq <- Proxy q -> POpts -> (y, b) -> m (TT (PP q (y, 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 (y
s,b
b)
              TT (PP q (y, b)) -> m (TT (PP q (y, b)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q (y, b)) -> m (TT (PP q (y, b))))
-> TT (PP q (y, b)) -> m (TT (PP q (y, b)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP q (y, b))
-> [Tree PE]
-> Either (TT (PP q (y, b))) (PP q (y, b))
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" q failed") TT (PP q (y, b))
qq [Tree PE]
hhs of
                   Left TT (PP q (y, b))
e -> TT (PP q (y, b))
e
                   Right PP q (y, b)
c -> POpts
-> TT (PP q (y, b)) -> String -> [Tree PE] -> TT (PP q (y, b))
forall a. POpts -> TT a -> String -> [Tree PE] -> TT a
mkNodeCopy POpts
opts TT (PP q (y, b))
qq (POpts -> String -> PP q (y, b) -> b -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg1 PP q (y, b)
c b
b) [Tree PE]
hhs

-- | calculate the return type for 'EitherIn'

type family EitherInT (p :: k) (y :: Type) (lr :: Type) where
  EitherInT p y (Either a _) = PP p (y,a)
  EitherInT _ _ o = GL.TypeError (
      'GL.Text "EitherInT: expected 'Either a b' "
      ':$$: 'GL.Text "o = "
      ':<>: 'GL.ShowType o)

-- | simple version of 'EitherIn' with Id as the Either value and the environment set to ()

--

-- >>> pz @(EitherId '(Id,"fromleft") '(888,Id)) (Right "ok")

-- Val (888,"ok")

--

-- >>> pz @(EitherId '(Id,"fromleft") '(888,Id)) (Left 123)

-- Val (123,"fromleft")

--

data EitherId p q deriving Int -> EitherId p q -> ShowS
[EitherId p q] -> ShowS
EitherId p q -> String
(Int -> EitherId p q -> ShowS)
-> (EitherId p q -> String)
-> ([EitherId p q] -> ShowS)
-> Show (EitherId p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> EitherId p q -> ShowS
forall k (p :: k) k (q :: k). [EitherId p q] -> ShowS
forall k (p :: k) k (q :: k). EitherId p q -> String
showList :: [EitherId p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [EitherId p q] -> ShowS
show :: EitherId p q -> String
$cshow :: forall k (p :: k) k (q :: k). EitherId p q -> String
showsPrec :: Int -> EitherId p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> EitherId p q -> ShowS
Show
type EitherIdT p q = EitherIn (Snd >> p) (Snd >> q) () Id

instance P (EitherIdT p q) x => P (EitherId p q) x where
  type PP (EitherId p q) x = PP (EitherIdT p q) x
  eval :: proxy (EitherId p q) -> POpts -> x -> m (TT (PP (EitherId p q) x))
eval proxy (EitherId p q)
_ = Proxy (EitherIdT p q)
-> POpts -> x -> m (TT (PP (EitherIdT 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 (EitherIdT p q)
forall k (t :: k). Proxy t
Proxy @(EitherIdT p q))


-- | get Left or use the default value @p@: @q@ is the environment and @r@ is the Elr value

--

-- >>> pz @(LeftDef' 999 () Id) (Right "sdf")

-- Val 999

--

-- >>> pz @(LeftDef' 999 () Id) (Left 1)

-- Val 1

--

data LeftDef' p q r deriving Int -> LeftDef' p q r -> ShowS
[LeftDef' p q r] -> ShowS
LeftDef' p q r -> String
(Int -> LeftDef' p q r -> ShowS)
-> (LeftDef' p q r -> String)
-> ([LeftDef' p q r] -> ShowS)
-> Show (LeftDef' 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 -> LeftDef' p q r -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). [LeftDef' p q r] -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). LeftDef' p q r -> String
showList :: [LeftDef' p q r] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k) k (r :: k). [LeftDef' p q r] -> ShowS
show :: LeftDef' p q r -> String
$cshow :: forall k (p :: k) k (q :: k) k (r :: k). LeftDef' p q r -> String
showsPrec :: Int -> LeftDef' p q r -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k) k (r :: k).
Int -> LeftDef' p q r -> ShowS
Show

type LeftDefT' p q r = EitherIn Snd (Fst >> p) q r

instance P (LeftDefT' p q r) x => P (LeftDef' p q r) x where
  type PP (LeftDef' p q r) x = PP (LeftDefT' p q r) x
  eval :: proxy (LeftDef' p q r)
-> POpts -> x -> m (TT (PP (LeftDef' p q r) x))
eval proxy (LeftDef' p q r)
_ = Proxy (LeftDefT' p q r)
-> POpts -> x -> m (TT (PP (LeftDefT' p q r) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (LeftDefT' p q r)
forall k (t :: k). Proxy t
Proxy @(LeftDefT' p q r))

-- | get Right or use the default value @p@: @q@ is the environment and @r@ is the Elr value

--

-- >>> pz @(RightDef' 999 () Id) (Left "sdf")

-- Val 999

--

-- >>> pz @(RightDef' 999 Fst Snd) (999,Right 1)

-- Val 1

--

data RightDef' p q r deriving Int -> RightDef' p q r -> ShowS
[RightDef' p q r] -> ShowS
RightDef' p q r -> String
(Int -> RightDef' p q r -> ShowS)
-> (RightDef' p q r -> String)
-> ([RightDef' p q r] -> ShowS)
-> Show (RightDef' 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 -> RightDef' p q r -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). [RightDef' p q r] -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). RightDef' p q r -> String
showList :: [RightDef' p q r] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k) k (r :: k). [RightDef' p q r] -> ShowS
show :: RightDef' p q r -> String
$cshow :: forall k (p :: k) k (q :: k) k (r :: k). RightDef' p q r -> String
showsPrec :: Int -> RightDef' p q r -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k) k (r :: k).
Int -> RightDef' p q r -> ShowS
Show

type RightDefT' p q r = EitherIn (Fst >> p) Snd q r

instance P (RightDefT' p q r) x => P (RightDef' p q r) x where
  type PP (RightDef' p q r) x = PP (RightDefT' p q r) x
  eval :: proxy (RightDef' p q r)
-> POpts -> x -> m (TT (PP (RightDef' p q r) x))
eval proxy (RightDef' p q r)
_ = Proxy (RightDefT' p q r)
-> POpts -> x -> m (TT (PP (RightDefT' p q r) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (RightDefT' p q r)
forall k (t :: k). Proxy t
Proxy @(RightDefT' p q r))