{-# 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 'These' functions

module Predicate.Data.These (
 -- ** predicates

    IsThis
  , IsThat
  , IsThese

 -- ** constructors

  , MkThis
  , MkThis'
  , MkThat
  , MkThat'
  , MkThese

 -- ** destructors

  , This'
  , That'
  , These'
  , ThisDef
  , ThisFail
  , ThatDef
  , ThatFail
  , TheseDef
  , TheseFail
  , Thiss
  , Thats
  , Theses
  , Theres
  , Heres
  , TheseIn
  , TheseId
  , ThesePair
  , ThisDef'
  , ThatDef'
  , TheseDef'
  , TheseInSimple
  , PartitionThese

 -- ** miscellaneous

  , ZipThese

 -- ** type families

  , TheseInT
 ) where
import Predicate.Core
import Predicate.Misc
import Predicate.Util
import Data.Proxy (Proxy(Proxy))
import Data.Kind (Type)
import Data.These (partitionThese, These(..))
import qualified Data.These.Combinators as TheseC
import qualified GHC.TypeLits as GL
import GHC.TypeLits (ErrorMessage((:$$:),(:<>:)))

-- $setup

-- >>> :set -XDataKinds

-- >>> :set -XTypeApplications

-- >>> :set -XTypeOperators

-- >>> :set -XOverloadedStrings

-- >>> :set -XNoOverloadedLists

-- >>> import Predicate

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


-- | similar to 'Data.These.partitionThese'. returns a 3-tuple with the results so use 'Fst' 'Snd' 'Thd' to extract

--

-- >>> pz @PartitionThese [This 'a', That 2, This 'c', These 'z' 1, That 4, These 'a' 2, That 99]

-- Val ("ac",[2,4,99],[('z',1),('a',2)])

--

-- >>> pl @PartitionThese [This 4, That 'x', That 'y',These 3 'b', This 99, These 5 'x']

-- Present ([4,99],"xy",[(3,'b'),(5,'x')]) (PartitionThese ([4,99],"xy",[(3,'b'),(5,'x')]) | [This 4,That 'x',That 'y',These 3 'b',This 99,These 5 'x'])

-- Val ([4,99],"xy",[(3,'b'),(5,'x')])

--

-- >>> pl @PartitionThese [This 1,That 'x',This 4,That 'y',These 9 'z',This 10,These 8 'y']

-- Present ([1,4,10],"xy",[(9,'z'),(8,'y')]) (PartitionThese ([1,4,10],"xy",[(9,'z'),(8,'y')]) | [This 1,That 'x',This 4,That 'y',These 9 'z',This 10,These 8 'y'])

-- Val ([1,4,10],"xy",[(9,'z'),(8,'y')])

--

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

instance ( Show a
         , Show b
         ) => P PartitionThese [These a b] where
  type PP PartitionThese [These a b] = ([a], [b], [(a, b)])
  eval :: proxy PartitionThese
-> POpts -> [These a b] -> m (TT (PP PartitionThese [These a b]))
eval proxy PartitionThese
_ POpts
opts [These a b]
as =
    let msg0 :: String
msg0 = String
"PartitionThese"
        b :: ([a], [b], [(a, b)])
b = [These a b] -> ([a], [b], [(a, b)])
forall a b. [These a b] -> ([a], [b], [(a, b)])
partitionThese [These a b]
as
    in TT ([a], [b], [(a, b)]) -> m (TT ([a], [b], [(a, b)]))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT ([a], [b], [(a, b)]) -> m (TT ([a], [b], [(a, b)])))
-> TT ([a], [b], [(a, b)]) -> m (TT ([a], [b], [(a, b)]))
forall a b. (a -> b) -> a -> b
$ POpts
-> Val ([a], [b], [(a, b)])
-> String
-> [Tree PE]
-> TT ([a], [b], [(a, b)])
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (([a], [b], [(a, b)]) -> Val ([a], [b], [(a, b)])
forall a. a -> Val a
Val ([a], [b], [(a, b)])
b) (POpts -> String -> ([a], [b], [(a, b)]) -> [These a b] -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 ([a], [b], [(a, b)])
b [These a b]
as) []

-- | similar to 'Data.These.Combinators.catThis'

--

-- >>> pz @(Thiss) [That 1, This 'a', These 'b' 33, This 'd', That 4]

-- Val "ad"

--

-- >>> pz @(Thiss) [That 1, This 'a', These 'b' 33]

-- Val "a"

--

-- >>> pz @(Thiss) [That 1, That 9, These 1 33]

-- Val []

--

data Thiss deriving Int -> Thiss -> ShowS
[Thiss] -> ShowS
Thiss -> String
(Int -> Thiss -> ShowS)
-> (Thiss -> String) -> ([Thiss] -> ShowS) -> Show Thiss
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Thiss] -> ShowS
$cshowList :: [Thiss] -> ShowS
show :: Thiss -> String
$cshow :: Thiss -> String
showsPrec :: Int -> Thiss -> ShowS
$cshowsPrec :: Int -> Thiss -> ShowS
Show
type ThissT = PartitionThese >> Fst

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

-- | similar to 'Data.These.Combinators.catThat'

--

-- >>> pl @Thats [This 1, This 10,That 'x', This 99, That 'y']

-- Present "xy" ((>>) "xy" | {Snd "xy" | ([1,10,99],"xy",[])})

-- Val "xy"

--

data Thats deriving Int -> Thats -> ShowS
[Thats] -> ShowS
Thats -> String
(Int -> Thats -> ShowS)
-> (Thats -> String) -> ([Thats] -> ShowS) -> Show Thats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Thats] -> ShowS
$cshowList :: [Thats] -> ShowS
show :: Thats -> String
$cshow :: Thats -> String
showsPrec :: Int -> Thats -> ShowS
$cshowsPrec :: Int -> Thats -> ShowS
Show
type ThatsT = PartitionThese >> Snd

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

-- | similar to 'Data.These.Combinators.catThese'

--

-- >>> pz @(ZipThese Id Tail >> Theses) [1..10]

-- Val [(1,2),(2,3),(3,4),(4,5),(5,6),(6,7),(7,8),(8,9),(9,10)]

--

data Theses deriving Int -> Theses -> ShowS
[Theses] -> ShowS
Theses -> String
(Int -> Theses -> ShowS)
-> (Theses -> String) -> ([Theses] -> ShowS) -> Show Theses
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Theses] -> ShowS
$cshowList :: [Theses] -> ShowS
show :: Theses -> String
$cshow :: Theses -> String
showsPrec :: Int -> Theses -> ShowS
$cshowsPrec :: Int -> Theses -> ShowS
Show
type ThesesT = PartitionThese >> Thd

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

-- | similar to 'Data.These.Combinators.catHere'

--

-- >>> pz @(ZipThese Id Tail >> Heres) [1..10]

-- Val [1,2,3,4,5,6,7,8,9,10]

--

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

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

-- | similar to 'Data.These.Combinators.catThere'

--

-- >>> pz @(ZipThese Id Tail >> Theres) [1..10]

-- Val [2,3,4,5,6,7,8,9,10]

--

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

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

-- | 'Data.These.This' constructor

--

-- >>> pz @(Proxy Int >> MkThis' UnproxyT 10) []

-- Val (This 10)

--

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

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

--

-- >>> pl @(MkThis () Id) 'x'

-- Present This 'x' (MkThis This 'x')

-- Val (This 'x')

--

-- >>> pl @(MkThis () Fst) ('x',True)

-- Present This 'x' (MkThis This 'x')

-- Val (This 'x')

--

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

-- Val (This 44)

--

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

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

-- | similar to 'MkThat' where @t@ references the type

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

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

--

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

-- Val (That 44)

--

-- >>> pz @(MkThat _ "Abc" <> MkThis _ '[1,2] <> MkThese [3,4] "def") ()

-- Val (These [1,2,3,4] "Abcdef")

--

-- >>> pl @(MkThat () Id) 'x'

-- Present That 'x' (MkThat That 'x')

-- Val (That 'x')

--

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

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

-- | 'Data.These.These' constructor

--

-- >>> pz @(MkThese Fst Snd) (44,'x')

-- Val (These 44 'x')

--

-- >>> pl @(MkThese Id 'True) 'x'

-- Present These 'x' True (MkThese These 'x' True)

-- Val (These 'x' True)

--

data MkThese p q deriving Int -> MkThese p q -> ShowS
[MkThese p q] -> ShowS
MkThese p q -> String
(Int -> MkThese p q -> ShowS)
-> (MkThese p q -> String)
-> ([MkThese p q] -> ShowS)
-> Show (MkThese p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> MkThese p q -> ShowS
forall k (p :: k) k (q :: k). [MkThese p q] -> ShowS
forall k (p :: k) k (q :: k). MkThese p q -> String
showList :: [MkThese p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [MkThese p q] -> ShowS
show :: MkThese p q -> String
$cshow :: forall k (p :: k) k (q :: k). MkThese p q -> String
showsPrec :: Int -> MkThese p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> MkThese p q -> ShowS
Show
instance ( P p a
         , P q a
         , Show (PP p a)
         , Show (PP q a)
         ) => P (MkThese p q) a where
  type PP (MkThese p q) a = These (PP p a) (PP q a)
  eval :: proxy (MkThese p q) -> POpts -> a -> m (TT (PP (MkThese p q) a))
eval proxy (MkThese p q)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"MkThese"
    Either
  (TT (These (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 (These (PP p a) (PP q a)))
        (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
    TT (These (PP p a) (PP q a)) -> m (TT (These (PP p a) (PP q a)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (These (PP p a) (PP q a)) -> m (TT (These (PP p a) (PP q a))))
-> TT (These (PP p a) (PP q a)) -> m (TT (These (PP p a) (PP q a)))
forall a b. (a -> b) -> a -> b
$ case Either
  (TT (These (PP p a) (PP q a)))
  (PP p a, PP q a, TT (PP p a), TT (PP q a))
lr of
      Left TT (These (PP p a) (PP q a))
e -> TT (These (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) ->
        let d :: These (PP p a) (PP q a)
d = PP p a -> PP q a -> These (PP p a) (PP q a)
forall a b. a -> b -> These a b
These PP p a
p PP q a
q
        in POpts
-> Val (These (PP p a) (PP q a))
-> String
-> [Tree PE]
-> TT (These (PP p a) (PP q a))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (These (PP p a) (PP q a) -> Val (These (PP p a) (PP q a))
forall a. a -> Val a
Val These (PP p a) (PP q a)
d) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> These (PP p a) (PP q a) -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts These (PP p a) (PP q a)
d) [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]

data IsTh (th :: These x y) deriving Int -> IsTh th -> ShowS
[IsTh th] -> ShowS
IsTh th -> String
(Int -> IsTh th -> ShowS)
-> (IsTh th -> String) -> ([IsTh th] -> ShowS) -> Show (IsTh th)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall x y (th :: These x y). Int -> IsTh th -> ShowS
forall x y (th :: These x y). [IsTh th] -> ShowS
forall x y (th :: These x y). IsTh th -> String
showList :: [IsTh th] -> ShowS
$cshowList :: forall x y (th :: These x y). [IsTh th] -> ShowS
show :: IsTh th -> String
$cshow :: forall x y (th :: These x y). IsTh th -> String
showsPrec :: Int -> IsTh th -> ShowS
$cshowsPrec :: forall x y (th :: These x y). Int -> IsTh th -> ShowS
Show
-- x y can be anything


-- trying to avoid Show instance because more likely to have ambiguity errors

instance ( x ~ These a b
         , Show a
         , Show b
         , GetThese th
         ) => P (IsTh (th :: These x1 x2)) x where
  type PP (IsTh th) x = Bool
  eval :: proxy (IsTh th) -> POpts -> x -> m (TT (PP (IsTh th) x))
eval proxy (IsTh th)
_ POpts
opts x
x =
    let msg0 :: String
msg0 = String
"Is"
        th :: These () ()
th = GetThese th => These () ()
forall a b (th :: These a b). GetThese th => These () ()
getThese @th
        fn :: These a b -> Bool
fn = case These () ()
th of
               This () -> These a b -> Bool
forall a b. These a b -> Bool
TheseC.isThis
               That () -> These a b -> Bool
forall a b. These a b -> Bool
TheseC.isThat
               These () () -> These a b -> Bool
forall a b. These a b -> Bool
TheseC.isThese
    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 (These a b -> Bool
fn x
These a b
x) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> These () () -> String
forall a b. These a b -> String
showThese These () ()
th String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> x -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " x
x) []

-- | predicate on 'Data.These.This'

--

-- >>> pz @IsThis (This "aBc")

-- Val True

--

-- >>> pz @IsThis (These 1 'a')

-- Val False

--

-- >>> pl @IsThis (This 12)

-- True (IsThis | This 12)

-- Val True

--

data IsThis deriving Int -> IsThis -> ShowS
[IsThis] -> ShowS
IsThis -> String
(Int -> IsThis -> ShowS)
-> (IsThis -> String) -> ([IsThis] -> ShowS) -> Show IsThis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsThis] -> ShowS
$cshowList :: [IsThis] -> ShowS
show :: IsThis -> String
$cshow :: IsThis -> String
showsPrec :: Int -> IsThis -> ShowS
$cshowsPrec :: Int -> IsThis -> ShowS
Show
type IsThisT = IsTh ('This '())

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

-- | predicate on 'Data.These.That'

--

-- >>> pl @IsThat (This 12)

-- False (IsThat | This 12)

-- Val False

--

data IsThat deriving Int -> IsThat -> ShowS
[IsThat] -> ShowS
IsThat -> String
(Int -> IsThat -> ShowS)
-> (IsThat -> String) -> ([IsThat] -> ShowS) -> Show IsThat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsThat] -> ShowS
$cshowList :: [IsThat] -> ShowS
show :: IsThat -> String
$cshow :: IsThat -> String
showsPrec :: Int -> IsThat -> ShowS
$cshowsPrec :: Int -> IsThat -> ShowS
Show
type IsThatT = IsTh ('That '())

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

-- | predicate on 'Data.These.These'

--

-- >>> pl @IsThese (This 12)

-- False (IsThese | This 12)

-- Val False

--

-- >>> pz @IsThese (These 1 'a')

-- Val True

--

-- >>> pl @IsThese (These 'x' 12)

-- True (IsThese | These 'x' 12)

-- Val True

--

-- >>> pl @IsThese (That (SG.Sum 12))

-- False (IsThese | That (Sum {getSum = 12}))

-- Val False

--

-- >>> pl @IsThese (These 1 (SG.Sum 12))

-- True (IsThese | These 1 (Sum {getSum = 12}))

-- Val True

--

data IsThese deriving Int -> IsThese -> ShowS
[IsThese] -> ShowS
IsThese -> String
(Int -> IsThese -> ShowS)
-> (IsThese -> String) -> ([IsThese] -> ShowS) -> Show IsThese
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsThese] -> ShowS
$cshowList :: [IsThese] -> ShowS
show :: IsThese -> String
$cshow :: IsThese -> String
showsPrec :: Int -> IsThese -> ShowS
$cshowsPrec :: Int -> IsThese -> ShowS
Show
type IsTheseT = IsTh ('These '() '())

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

-- | similar to 'Data.Align.align' thats pads with 'Data.These.This' or 'Data.These.That' if one list is shorter than the other

--

-- the key is that all information about both lists are preserved

--

-- >>> pz @(ZipThese Fst Snd) ("aBc", [1..5])

-- Val [These 'a' 1,These 'B' 2,These 'c' 3,That 4,That 5]

--

-- >>> pz @(ZipThese Fst Snd) ("aBcDeF", [1..3])

-- Val [These 'a' 1,These 'B' 2,These 'c' 3,This 'D',This 'e',This 'F']

--

-- >>> pz @(ZipThese Id Reverse) "aBcDeF"

-- Val [These 'a' 'F',These 'B' 'e',These 'c' 'D',These 'D' 'c',These 'e' 'B',These 'F' 'a']

--

-- >>> pz @(ZipThese Id '[]) "aBcDeF"

-- Val [This 'a',This 'B',This 'c',This 'D',This 'e',This 'F']

--

-- >>> pz @(ZipThese '[] Id) "aBcDeF"

-- Val [That 'a',That 'B',That 'c',That 'D',That 'e',That 'F']

--

-- >>> pz @(ZipThese '[] '[]) "aBcDeF"

-- Val []

--

-- >>> pl @(ZipThese Fst Snd >> Map (TheseInSimple Id Id Fst)) (['w'..'y'],['a'..'f'])

-- Present "wxydef" ((>>) "wxydef" | {Map "wxydef" | [These 'w' 'a',These 'x' 'b',These 'y' 'c',That 'd',That 'e',That 'f']})

-- Val "wxydef"

--

-- >>> pl @(("sdf" &&& Id) >> ZipThese Fst Snd >> Map (TheseInSimple (Id &&& 0) (C "x" &&& Id) Id)) [1..5]

-- Present [('s',1),('d',2),('f',3),('x',4),('x',5)] ((>>) [('s',1),('d',2),('f',3),('x',4),('x',5)] | {Map [('s',1),('d',2),('f',3),('x',4),('x',5)] | [These 's' 1,These 'd' 2,These 'f' 3,That 4,That 5]})

-- Val [('s',1),('d',2),('f',3),('x',4),('x',5)]

--

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

instance ( PP p a ~ [x]
        , PP q a ~ [y]
         , P p a
         , P q a
         , Show x
         , Show y
         ) => P (ZipThese p q) a where
  type PP (ZipThese p q) a = [These (ExtractAFromList (PP p a)) (ExtractAFromList (PP q a))]
  eval :: proxy (ZipThese p q) -> POpts -> a -> m (TT (PP (ZipThese p q) a))
eval proxy (ZipThese p q)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"ZipThese"
    Either (TT [These x y]) ([x], [y], TT [x], TT [y])
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
        (TT [These x y]) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
    TT [These x y] -> m (TT [These x y])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [These x y] -> m (TT [These x y]))
-> TT [These x y] -> m (TT [These x y])
forall a b. (a -> b) -> a -> b
$ case Either (TT [These x y]) ([x], [y], TT [x], TT [y])
lr of
      Left TT [These x y]
e -> TT [These x y]
e
      Right ([x]
p,[y]
q,TT [x]
pp,TT [y]
qq) ->
        let hhs :: [Tree PE]
hhs = [TT [x] -> Tree PE
forall a. TT a -> Tree PE
hh TT [x]
pp, TT [y] -> Tree PE
forall a. TT a -> Tree PE
hh TT [y]
qq]
        in case POpts
-> String
-> [x]
-> [y]
-> [Tree PE]
-> Either (TT [These x y]) ((Int, [x]), (Int, [y]))
forall (t :: Type -> Type) (u :: Type -> Type) a b x.
(Foldable t, Foldable u) =>
POpts
-> String
-> t a
-> u b
-> [Tree PE]
-> Either (TT x) ((Int, [a]), (Int, [b]))
chkSize2 POpts
opts String
msg0 [x]
p [y]
q [Tree PE]
hhs of
          Left TT [These x y]
e -> TT [These x y]
e
          Right ((Int, [x]), (Int, [y]))
_ ->
            let d :: [These x y]
d = [x] -> [y] -> [These x y]
forall a b. [a] -> [b] -> [These a b]
simpleAlign [x]
p [y]
q
            in POpts -> Val [These x y] -> String -> [Tree PE] -> TT [These x y]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([These x y] -> Val [These x y]
forall a. a -> Val a
Val [These x y]
d) (POpts -> String -> [These x y] -> String -> [x] -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 [These x y]
d String
"p=" [x]
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [y] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | q=" [y]
q) [Tree PE]
hhs

-- | extract the This value from an 'These' otherwise use the default value

--   if there is no This value then @p@ is passed the whole context only

--

-- >>> pz @(ThisDef (1 % 4) Id) (This 20.4)

-- Val (102 % 5)

--

-- >>> pz @(ThisDef (1 % 4) Id) (That "aa")

-- Val (1 % 4)

--

-- >>> pz @(ThisDef (1 % 4) Id) (These 2.3 "aa")

-- Val (1 % 4)

--

-- >>> pz @(ThisDef (PrintT "found %s fst=%d" '(ShowP Snd, Fst)) Snd) (123,That "xy")

-- Val "found That \"xy\" fst=123"

--

-- >>> pz @(ThisDef (MEmptyT _) Id) (That 222)

-- Val ()

--

-- >>> pz @(ThisDef (MEmptyT (SG.Sum _)) Id) (These 222 'x')

-- Val (Sum {getSum = 0})

--

-- >>> pl @(ThisDef (MEmptyT _) Id) (This (SG.Sum 12))

-- Present Sum {getSum = 12} (ThisDef This)

-- Val (Sum {getSum = 12})

--

-- >>> pl @(ThisDef (MEmptyT _) Id) (That 12)

-- Present () (ThisDef That)

-- Val ()

--

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

instance ( PP q x ~ These a b
         , PP p x ~ a
         , P q x
         , P p x
    ) => P (ThisDef p q) x where
  type PP (ThisDef p q) x = ThisT (PP q x)
  eval :: proxy (ThisDef p q) -> POpts -> x -> m (TT (PP (ThisDef p q) x))
eval proxy (ThisDef p q)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"ThisDef"
    TT (These 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 (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)
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 These a b
q ->
        case These a b
q of
          This 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
" This") [TT (These a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (These a b)
qq]
          These a b
_ -> do
            TT 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 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 (These a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (These 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
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> These a b -> String
forall a b. These a b -> String
showThese These a b
q) [TT (These a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (These a b)
qq]


-- | extract the That value from an 'These' otherwise use the default value

--

-- if there is no That value then @p@ is passed the whole context only

--

-- >>> pz @(ThatDef (1 % 4) Id) (That 20.4)

-- Val (102 % 5)

--

-- >>> pz @(ThatDef (1 % 4) Id) (This "aa")

-- Val (1 % 4)

--

-- >>> pz @(ThatDef (1 % 4) Id) (These "aa" 2.3)

-- Val (1 % 4)

--

-- >>> pz @(ThatDef (PrintT "found %s fst=%d" '(ShowP Snd, Fst)) Snd) (123,This "xy")

-- Val "found This \"xy\" fst=123"

--

-- >>> pz @(ThatDef (MEmptyT _) Id) (This 222)

-- Val ()

--

-- >>> pz @(ThatDef (MEmptyT (SG.Sum _)) Id) (These 'x' 1120)

-- Val (Sum {getSum = 0})

--

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

instance ( PP q x ~ These a b
         , PP p x ~ b
         , P q x
         , P p x
    ) => P (ThatDef p q) x where
  type PP (ThatDef p q) x = ThatT (PP q x)
  eval :: proxy (ThatDef p q) -> POpts -> x -> m (TT (PP (ThatDef p q) x))
eval proxy (ThatDef p q)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"ThatDef"
    TT (These 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 (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)
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 These a b
q ->
        case These a b
q of
          That b
a -> 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
a) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" That") [TT (These a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (These a b)
qq]
          These a b
_ -> do
            TT 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 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 (These a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (These 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
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> These a b -> String
forall a b. These a b -> String
showThese These a b
q) [TT (These a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (These a b)
qq]

-- | extract the These value from an 'These' otherwise use the default value

--

-- if there is no These value then @p@ is passed the whole context only

--

-- >>> pz @(TheseDef '(1 % 4,"zz") Id) (These 20.4 "x")

-- Val (102 % 5,"x")

--

-- >>> pz @(TheseDef '(1 % 4,"zz") Id) (This 20.4)

-- Val (1 % 4,"zz")

--

-- >>> pz @(TheseDef '(1 % 4,"zz") Id) (That "x")

-- Val (1 % 4,"zz")

--

-- >>> pz @(TheseDef '(PrintT "found %s fst=%d" '(ShowP Snd, Fst),999) Snd) (123,This "xy")

-- Val ("found This \"xy\" fst=123",999)

--

-- >>> pz @(TheseDef (MEmptyT (SG.Sum _, String)) Id) (This 222)

-- Val (Sum {getSum = 0},"")

--

-- >>> pz @(TheseDef (MEmptyT _) Id) (These (SG.Sum 222) "aa")

-- Val (Sum {getSum = 222},"aa")

--

-- >>> pl @(TheseDef '("xyz",'True) Id) (This "abc")

-- Present ("xyz",True) (TheseDef This)

-- Val ("xyz",True)

--

-- >>> pl @(TheseDef '("xyz",'True) Id) (That False)

-- Present ("xyz",True) (TheseDef That)

-- Val ("xyz",True)

--

-- >>> pl @(TheseDef '("xyz",'True) Id) (These "abc" False)

-- Present ("abc",False) (TheseDef These)

-- Val ("abc",False)

--

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

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


-- | extract the This value from a 'These' otherwise fail with a message

--

-- if there is no This value then @p@ is passed the whole context only

--

-- >>> pz @(ThisFail "oops" Id) (This 20.4)

-- Val 20.4

--

-- >>> pz @(ThisFail "oops" Id) (That "aa")

-- Fail "oops"

--

-- >>> pz @(ThisFail (PrintT "found %s fst=%d" '(ShowP Snd,Fst)) Snd) (123,That "xy")

-- Fail "found That \"xy\" fst=123"

--

-- >>> pz @(ThisFail (MEmptyT _) Id) (That 222)

-- Fail ""

--

-- >>> pl @(ThisFail "sdf" Id) (This (SG.Sum 12))

-- Present Sum {getSum = 12} (This)

-- Val (Sum {getSum = 12})

--

-- >>> pl @(ThisFail "sdf" Id) (That (SG.Sum 12))

-- Error sdf (ThisFail That)

-- Fail "sdf"

--

-- >>> pl @(ThisFail "sdf" Id) (That 12)

-- Error sdf (ThisFail That)

-- Fail "sdf"

--

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

instance ( PP p x ~ String
         , PP q x ~ These a b
         , P p x
         , P q x
         )
    => P (ThisFail p q) x where
  type PP (ThisFail p q) x = ThisT (PP q x)
  eval :: proxy (ThisFail p q) -> POpts -> x -> m (TT (PP (ThisFail p q) x))
eval proxy (ThisFail p q)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"ThisFail"
    TT (These 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 (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)
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 These a b
q ->
        case These a b
q of
          This 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
"This" [TT (These a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (These a b)
qq]
          These a b
_ -> do
            TT String
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 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 (These a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (These 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
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> These a b -> String
forall a b. These a b -> String
showThese These a b
q) [TT (These a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (These a b)
qq, TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]


-- | extract the That value from a 'These' otherwise fail with a message

--

-- if there is no That value then @p@ is passed the whole context only

--

-- >>> pz @(ThatFail "oops" Id) (That 20.4)

-- Val 20.4

--

-- >>> pz @(ThatFail "oops" Id) (This "aa")

-- Fail "oops"

--

-- >>> pz @(ThatFail (PrintT "found %s fst=%d" '(ShowP Snd,Fst)) Snd) (123,This "xy")

-- Fail "found This \"xy\" fst=123"

--

-- >>> pz @(ThatFail (MEmptyT _) Id) (This 222)

-- Fail ""

--

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

instance ( PP p x ~ String
         , PP q x ~ These a b
         , P p x
         , P q x
         )
    => P (ThatFail p q) x where
  type PP (ThatFail p q) x = ThatT (PP q x)
  eval :: proxy (ThatFail p q) -> POpts -> x -> m (TT (PP (ThatFail p q) x))
eval proxy (ThatFail p q)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"ThatFail"
    TT (These 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 (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)
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 These a b
q ->
        case These a b
q of
          That b
a -> 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
a) String
"That" [TT (These a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (These a b)
qq]
          These a b
_ -> do
            TT String
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 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 (These a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (These 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
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> These a b -> String
forall a b. These a b -> String
showThese These a b
q) [TT (These a b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (These a b)
qq, TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]




-- | extract the These value from a 'These' otherwise fail with a message

--

-- if there is no These value then @p@ is passed the whole context only

--

-- >>> pz @(TheseFail "oops" Id) (These "abc" 20.4)

-- Val ("abc",20.4)

--

-- >>> pz @(TheseFail "oops" Id) (That "aa")

-- Fail "oops"

--

-- >>> pz @(TheseFail (PrintT "found %s fst=%d" '(ShowP Snd,Fst)) Snd) (123,That "xy")

-- Fail "found That \"xy\" fst=123"

--

-- >>> pz @(TheseFail (MEmptyT _) Id) (That 222)

-- Fail ""

--

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

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


-- | tries to extract a value from the 'Data.These.This' constructor

--

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

-- Val 21

--

-- >>> pz @(This' >> Succ) (That 'a')

-- Fail "This' found That"

--

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

-- | tries to extract a value from the 'Data.These.That' constructor

--

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

-- Val 21

--

-- >>> pz @(That' >> Succ) (This 'a')

-- Fail "That' found This"

--

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

-- | tries to extract the values from the 'Data.These.These' constructor

--

-- >>> pz @(These' >> Second Succ) (These 1 'a')

-- Val (1,'b')

--

-- >>> pz @(That' >> Succ) (This 'a')

-- Fail "That' found This"

--

-- >>> pz @(These' >> Second Succ) (That 8)

-- Fail "These' found That"

--

data These' deriving Int -> These' -> ShowS
[These'] -> ShowS
These' -> String
(Int -> These' -> ShowS)
-> (These' -> String) -> ([These'] -> ShowS) -> Show These'
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [These'] -> ShowS
$cshowList :: [These'] -> ShowS
show :: These' -> String
$cshow :: These' -> String
showsPrec :: Int -> These' -> ShowS
$cshowsPrec :: Int -> These' -> ShowS
Show
instance ( Show a
         , Show b
        ) => P These' (These a b) where
  type PP These' (These a b) = (a,b)
  eval :: proxy These'
-> POpts -> These a b -> m (TT (PP These' (These a b)))
eval proxy These'
_ POpts
opts These a b
lr =
    let msg0 :: String
msg0 = String
"These'"
    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
$ case These a b
lr of
         This a
_ -> POpts -> Val (a, b) -> String -> [Tree PE] -> TT (a, b)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (a, b)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found This")) String
"" []
         That b
_ -> POpts -> Val (a, b) -> String -> [Tree PE] -> TT (a, b)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (a, b)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" found That")) String
"" []
         These a
a b
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
a,b
b)) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> (a, b) -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts (a
a,b
b)) []

-- | destructor for These (similar to 'Data.These.these' but with an extra environment @s@)

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

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

--   @r@ @These a b@ receives @(PP t x,(a,b))@

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

--   @t@ points to the These value

--

-- >>> pz @(TheseIn Snd Fst L21 Fst Snd) (999,This 123)

-- Val 123

--

-- >>> pz @(TheseIn Snd Fst L21 Fst Snd) (999,That 123)

-- Val 999

--

-- >>> pz @(TheseIn Snd Fst L21 Fst Snd) (999,These 9 11)

-- Val 9

--

-- >>> pz @(TheseIn '(Snd,L12) '(L11,Snd) Snd Fst Snd) ((999,'a'), These 12 'x')

-- Val (12,'x')

--

-- >>> pz @(TheseIn '(Snd,L12) '(L11,Snd) Snd Fst Snd) ((999,'a'), That 'z')

-- Val (999,'z')

--

-- >>> pz @(TheseIn Snd (Snd >> Len) (Snd >> Fst + Length Snd) () Id) (This 13)

-- Val 13

--

-- >>> pz @(TheseIn Snd (Snd >> Len) (Snd >> Fst + Length Snd) () Id) (That "abcdef")

-- Val 6

--

-- >>> pl @(TheseIn "left" "right" "both" () Id) (This (SG.Sum 12))

-- Present "left" (TheseIn "left" | This Sum {getSum = 12})

-- Val "left"

--

-- >>> pl @(TheseIn '(Snd,999) '("no value",Snd) Snd () Id) (These "Ab" 13)

-- Present ("Ab",13) (TheseIn ("Ab",13) | These "Ab" 13)

-- Val ("Ab",13)

--

-- >>> pl @(TheseIn '(Snd,999) '("no value",Snd) Snd () Id) (This "Ab")

-- Present ("Ab",999) (TheseIn ("Ab",999) | This "Ab")

-- Val ("Ab",999)

--

-- >>> pz @(TheseIn ((Fst + Snd) >> ShowP Id) Snd "Xx" Fst Snd) (9,This 123)

-- Val "132"

--

-- >>> pz @(TheseIn '(Snd,"fromthis") '(Negate 99,Snd) Snd () Id) (This 123)

-- Val (123,"fromthis")

--

-- >>> pz @(TheseIn '(Snd,"fromthis") '(Negate 99,Snd) Snd () Id) (That "fromthat")

-- Val (-99,"fromthat")

--

-- >>> pz @(TheseIn '(Snd,"fromthis") '(Negate 99,Snd) Snd () Id) (These 123 "fromthese")

-- Val (123,"fromthese")

--

-- >>> pl @(TheseIn (PrintF "a=%d" (Snd >> Succ)) ("b=" <> Snd) (PrintT "a=%d b=%s" Snd) () Id) (These @Int 9 "rhs")

-- Present "a=9 b=rhs" (TheseIn "a=9 b=rhs" | These 9 "rhs")

-- Val "a=9 b=rhs"

--

-- >>> pl @(TheseIn (PrintF "a=%d" (Snd >> Succ)) ("b=" <> Snd) (PrintT "a=%d b=%s" Snd) () Id) (This @Int 9)

-- Present "a=10" (TheseIn "a=10" | This 9)

-- Val "a=10"

--

-- >>> pl @(TheseIn (PrintF "a=%d" (Snd >> Succ)) ("b=" <> Snd) (PrintT "a=%d b=%s" Snd) () Id) (That @Int "rhs")

-- Present "b=rhs" (TheseIn "b=rhs" | That "rhs")

-- Val "b=rhs"

--

-- >>> pz @(TheseIn ((Fst + Snd) >> ShowP Id) (ShowP Id) L22 Fst Snd) (9,This 123)

-- Val "132"

--

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

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

-- | calculate the return type for 'TheseIn'

type family TheseInT r y elr where
  TheseInT r y (These a b) = PP r (y,(a,b))
  TheseInT _ _ o = GL.TypeError (
      'GL.Text "TheseInT: expected 'These a b' "
      ':$$: 'GL.Text "o = "
      ':<>: 'GL.ShowType o)

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

--

-- >>> pz @(TheseId '(Id,"fromleft") '(888,Id) Id) (These 222 "ok")

-- Val (222,"ok")

--

-- >>> pz @(TheseId '(Id,"fromleft") '(888,Id) Id) (That "ok")

-- Val (888,"ok")

--

-- >>> pz @(TheseId '(Id,"fromleft") '(888,Id) Id) (This 123)

-- Val (123,"fromleft")

--

data TheseId p q r deriving Int -> TheseId p q r -> ShowS
[TheseId p q r] -> ShowS
TheseId p q r -> String
(Int -> TheseId p q r -> ShowS)
-> (TheseId p q r -> String)
-> ([TheseId p q r] -> ShowS)
-> Show (TheseId 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 -> TheseId p q r -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). [TheseId p q r] -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). TheseId p q r -> String
showList :: [TheseId p q r] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k) k (r :: k). [TheseId p q r] -> ShowS
show :: TheseId p q r -> String
$cshow :: forall k (p :: k) k (q :: k) k (r :: k). TheseId p q r -> String
showsPrec :: Int -> TheseId p q r -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k) k (r :: k).
Int -> TheseId p q r -> ShowS
Show
type TheseIdT p q r = TheseIn (Snd >> p) (Snd >> q) (Snd >> r) () Id

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

-- | provide the default pair in @s@ and @t@ refers to These

--

-- >>> pz @(ThesePair Fst Snd) ((999,"oops"),These 2 "xx")

-- Val (2,"xx")

--

-- >>> pz @(ThesePair Fst Snd) ((999,"oops"),That "ok")

-- Val (999,"ok")

--

data ThesePair s t deriving Int -> ThesePair s t -> ShowS
[ThesePair s t] -> ShowS
ThesePair s t -> String
(Int -> ThesePair s t -> ShowS)
-> (ThesePair s t -> String)
-> ([ThesePair s t] -> ShowS)
-> Show (ThesePair s t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (s :: k) k (t :: k). Int -> ThesePair s t -> ShowS
forall k (s :: k) k (t :: k). [ThesePair s t] -> ShowS
forall k (s :: k) k (t :: k). ThesePair s t -> String
showList :: [ThesePair s t] -> ShowS
$cshowList :: forall k (s :: k) k (t :: k). [ThesePair s t] -> ShowS
show :: ThesePair s t -> String
$cshow :: forall k (s :: k) k (t :: k). ThesePair s t -> String
showsPrec :: Int -> ThesePair s t -> ShowS
$cshowsPrec :: forall k (s :: k) k (t :: k). Int -> ThesePair s t -> ShowS
Show
type ThesePairT s t = TheseIn '(Snd,L12) '(L11,Snd) Snd s t

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


-- | similar to 'Data.These.these' but without any environment

--

-- >>> pz @(TheseInSimple Id Len (Fst + Length Snd)) (This 13)

-- Val 13

--

-- >>> pz @(TheseInSimple Id Len (Fst + Length Snd)) (That "this is a long string")

-- Val 21

--

-- >>> pz @(TheseInSimple Id Len (Fst + Length Snd)) (These 20 "somedata")

-- Val 28

--

-- >>> pz @(TheseInSimple (MkLeft _ Id) (MkRight _ Id) (If (Fst > Length Snd) (MkLeft _ Fst) (MkRight _ Snd))) (That "this is a long string")

-- Val (Right "this is a long string")

--

-- >>> pz @(TheseInSimple (MkLeft _ Id) (MkRight _ Id) (If (Fst > Length Snd) (MkLeft _ Fst) (MkRight _ Snd))) (These 1 "this is a long string")

-- Val (Right "this is a long string")

--

-- >>> pz @(TheseInSimple (MkLeft _ Id) (MkRight _ Id) (If (Fst > Length Snd) (MkLeft _ Fst) (MkRight _ Snd))) (These 100 "this is a long string")

-- Val (Left 100)

--

-- >>> pl @(TheseInSimple "this" "that" "these") (This (SG.Sum 12))

-- Present "this" (TheseIn "this" | This Sum {getSum = 12})

-- Val "this"

--

-- >>> pl @(TheseInSimple (Id &&& 999) ("no value" &&& Id) Id) (These "Ab" 13)

-- Present ("Ab",13) (TheseIn ("Ab",13) | These "Ab" 13)

-- Val ("Ab",13)

--

-- >>> pl @(TheseInSimple (Id &&& 999) ("no value" &&& Id) Id) (This "Ab")

-- Present ("Ab",999) (TheseIn ("Ab",999) | This "Ab")

-- Val ("Ab",999)

--

-- >>> pl @(TheseInSimple (Id &&& 999) ("no value" &&& Id) Id) (That 13)

-- Present ("no value",13) (TheseIn ("no value",13) | That 13)

-- Val ("no value",13)

--

data TheseInSimple p q r deriving Int -> TheseInSimple p q r -> ShowS
[TheseInSimple p q r] -> ShowS
TheseInSimple p q r -> String
(Int -> TheseInSimple p q r -> ShowS)
-> (TheseInSimple p q r -> String)
-> ([TheseInSimple p q r] -> ShowS)
-> Show (TheseInSimple 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 -> TheseInSimple p q r -> ShowS
forall k (p :: k) k (q :: k) k (r :: k).
[TheseInSimple p q r] -> ShowS
forall k (p :: k) k (q :: k) k (r :: k).
TheseInSimple p q r -> String
showList :: [TheseInSimple p q r] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k) k (r :: k).
[TheseInSimple p q r] -> ShowS
show :: TheseInSimple p q r -> String
$cshow :: forall k (p :: k) k (q :: k) k (r :: k).
TheseInSimple p q r -> String
showsPrec :: Int -> TheseInSimple p q r -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k) k (r :: k).
Int -> TheseInSimple p q r -> ShowS
Show
type TheseInSimpleT p q r = TheseIn (Snd >> p) (Snd >> q) (Snd >> r) () Id

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


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

--

-- >>> pz @(ThisDef' Id Fst Snd) (999,These 1 "xx")

-- Val 999

--

-- >>> pz @(ThisDef' 999 () Id) (That "sdf")

-- Val 999

--

-- >>> pz @(ThisDef' 999 () Id) (This 1)

-- Val 1

--

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

type ThisDefT' p q r = TheseIn Snd (Fst >> p) (Fst >> p) q r

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

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

--

-- >>> pz @(ThatDef' 999 () Id) (These "x" 1)

-- Val 999

--

-- >>> pz @(ThatDef' 999 () Id) (This "sdf")

-- Val 999

--

-- >>> pz @(ThatDef' 999 Fst Snd) (999,That 1)

-- Val 1

--

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

type ThatDefT' p q r = TheseIn (Fst >> p) Snd (Fst >> p) q r

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

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

--

-- >>> pz @(TheseDef' '(999,"xx") () Id) (These 12 "yy")

-- Val (12,"yy")

--

-- >>> pz @(TheseDef' '(999,"xx") () Id) (That "abc")

-- Val (999,"xx")

--

-- >>> pz @(TheseDef' '(999,"xx") () Id) (This 1)

-- Val (999,"xx")

--

-- >>> pz @(TheseDef' '(999,"xx") () Id) (These 1 "abc")

-- Val (1,"abc")

--

-- >>> pz @(TheseDef' Id Fst Snd) ((999,"xx"),That "yy")

-- Val (999,"xx")

--

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

type TheseDefT' p q r = TheseIn (Fst >> p) (Fst >> p) Snd q r

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