{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase         #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}

module PlutusTx.These (
  These (..),
  these,
  theseWithDefault,
) where

import GHC.Generics (Generic)
import PlutusTx.Blueprint.Definition (HasBlueprintDefinition)
import Prelude qualified as Haskell

{- | A 'These' @a@ @b@ is either an @a@, or a @b@ or an @a@ and a @b@.
Plutus version of 'Data.These'.
-}
data These a b = This a | That b | These a b
  deriving stock ((forall x. These a b -> Rep (These a b) x)
-> (forall x. Rep (These a b) x -> These a b)
-> Generic (These a b)
forall x. Rep (These a b) x -> These a b
forall x. These a b -> Rep (These a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (These a b) x -> These a b
forall a b x. These a b -> Rep (These a b) x
$cfrom :: forall a b x. These a b -> Rep (These a b) x
from :: forall x. These a b -> Rep (These a b) x
$cto :: forall a b x. Rep (These a b) x -> These a b
to :: forall x. Rep (These a b) x -> These a b
Generic, These a b -> These a b -> Bool
(These a b -> These a b -> Bool)
-> (These a b -> These a b -> Bool) -> Eq (These a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => These a b -> These a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => These a b -> These a b -> Bool
== :: These a b -> These a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => These a b -> These a b -> Bool
/= :: These a b -> These a b -> Bool
Haskell.Eq, Int -> These a b -> ShowS
[These a b] -> ShowS
These a b -> String
(Int -> These a b -> ShowS)
-> (These a b -> String)
-> ([These a b] -> ShowS)
-> Show (These a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> These a b -> ShowS
forall a b. (Show a, Show b) => [These a b] -> ShowS
forall a b. (Show a, Show b) => These a b -> String
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> These a b -> ShowS
showsPrec :: Int -> These a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => These a b -> String
show :: These a b -> String
$cshowList :: forall a b. (Show a, Show b) => [These a b] -> ShowS
showList :: [These a b] -> ShowS
Haskell.Show)
  deriving anyclass (DefinitionId
DefinitionId -> HasBlueprintDefinition (These a b)
forall t. DefinitionId -> HasBlueprintDefinition t
forall a b. (Typeable a, Typeable b) => DefinitionId
$cdefinitionId :: forall a b. (Typeable a, Typeable b) => DefinitionId
definitionId :: DefinitionId
HasBlueprintDefinition)

{-# INLINEABLE theseWithDefault #-}

-- | Consume a 'These a b' value.
theseWithDefault :: a -> b -> (a -> b -> c) -> These a b -> c
theseWithDefault :: forall a b c. a -> b -> (a -> b -> c) -> These a b -> c
theseWithDefault a
a' b
b' a -> b -> c
f = \case
  This a
a -> a -> b -> c
f a
a b
b'
  That b
b -> a -> b -> c
f a
a' b
b
  These a
a b
b -> a -> b -> c
f a
a b
b

{-# INLINEABLE these #-}
these :: (a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these :: forall a c b.
(a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c
these a -> c
f b -> c
g a -> b -> c
h = \case
  This a
a -> a -> c
f a
a
  That b
b -> b -> c
g b
b
  These a
a b
b -> a -> b -> c
h a
a b
b