{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE QuantifiedConstraints #-}

module Plutarch.Extra.IsData (
  -- * PlutusTx ToData/FromData derive-wrappers
  ProductIsData (..),
  EnumIsData (..),
  unProductIsData,

  -- * Plutarch PIsData/PlutusType derive-wrappers
  DerivePConstantViaDataList (..),
  DerivePConstantViaEnum (..),

  -- * Plutarch deriving strategy
  PlutusTypeEnumData,
  PlutusTypeDataList,

  -- * Functions for PEnumData types
  pmatchEnum,
  pmatchEnumFromData,
) where

--------------------------------------------------------------------------------

import Data.Coerce (coerce)
import Data.Functor.Identity (Identity (Identity, runIdentity))
import Data.Kind (Constraint)
import Data.Maybe (fromJust)
import Data.Proxy (Proxy (Proxy))
import GHC.TypeLits (ErrorMessage (ShowType, Text, (:$$:), (:<>:)), TypeError)
import Generics.SOP (
  All,
  IsProductType,
  hcmap,
  hcollapse,
  hctraverse,
  mapIK,
  mapKI,
  productTypeFrom,
  productTypeTo,
  unI,
 )
import Generics.SOP qualified as SOP
import Plutarch.Builtin (pasInt)
import Plutarch.Extra.TermCont (pletC)
import Plutarch.Internal.Generic (PCode, PGeneric, gpfrom, gpto)
import Plutarch.Internal.PlutusType (
  PlutusTypeStrat (DerivedPInner, PlutusTypeStratConstraint, derivedPCon, derivedPMatch),
 )
import Plutarch.Lift (PConstantDecl (PConstantRepr, PConstanted, pconstantFromRepr, pconstantToRepr), PLifted)
import PlutusLedgerApi.V1 (
  BuiltinData (BuiltinData),
  UnsafeFromData (unsafeFromBuiltinData),
 )
import PlutusTx (
  Data (List),
  FromData (fromBuiltinData),
  ToData (toBuiltinData),
  fromData,
  toData,
 )

--------------------------------------------------------------------------------
-- ProductIsData

{- | Wrapper for deriving 'ToData', 'FromData' using the List
     constructor of Data to represent a Product type.

     It is recommended to use 'PlutusTypeDataList' when deriving
     'PlutusType' as it provides some basic safety by ensuring
     Plutarch types have an Inner type of 'PDataRecord'.

     Uses 'gProductToBuiltinData', 'gproductFromBuiltinData'.

 = Example
@
import qualified Generics.SOP as SOP

data Foo =
  Foo Integer [Integer]
  deriving stock (Generic)
  deriving anyclass (SOP.Generic)
  deriving (FromData, ToData) via (ProductIsData Foo)
  deriving (PConstantDecl) via (DerivePConstantViaDataList Foo PFoo)

instance PUnsafeLiftDecl PFoo where type PLifted PFoo = Foo

newtype PFoo s
    = PFoo
      ( Term s
          ( PDataRecord
              '[ "abc" ':= PInteger
               , "def" ':= PBuiltinList (PAsData PInteger)
               ]
          )
      )
  deriving stock (Generic)
  deriving anyclass (SOP.Generic)
  deriving anyclass (PlutusType, PIsData)

instance DerivePlutusType PFoo where
   type DPTStrat _ = PlutusTypeDataList
@

  @since 3.8.0
-}
newtype ProductIsData (a :: Type) = ProductIsData a

-- | Variant of 'PConstantViaData' using the List repr from 'ProductIsData'
newtype DerivePConstantViaDataList (h :: Type) (p :: S -> Type) = DerivePConstantViaDataList h

type family GetPRecord' (a :: [[S -> Type]]) :: [PLabeledType] where
  GetPRecord' '[ '[PDataRecord a]] = a

type family GetPRecord (a :: S -> Type) :: S -> Type where
  GetPRecord a = PDataRecord (GetPRecord' (PCode a))

type family GetRecordTypes (n :: [[Type]]) :: [S -> Type] where
  GetRecordTypes '[x ': xs] = PConstanted x ': GetRecordTypes '[xs]
  GetRecordTypes '[ '[]] = '[]

type family UD' (p :: S -> Type) :: S -> Type where
  UD' (p x1 x2 x3 x4 x5) = p (UD' x1) (UD' x2) (UD' x3) (UD' x4) (UD' x5)
  UD' (p x1 x2 x3 x4) = p (UD' x1) (UD' x2) (UD' x3) (UD' x4)
  UD' (p x1 x2 x3) = p (UD' x1) (UD' x2) (UD' x3)
  UD' (p x1 x2) = p (UD' x1) (UD' x2)
  UD' (p x1) = p (PAsData (UD' x1))
  UD' p = p

type family UD (p :: [S -> Type]) :: [S -> Type] where
  UD (x ': xs) = UD' x ': UD xs
  UD '[] = '[]

type family PUnlabel (n :: [PLabeledType]) :: [S -> Type] where
  PUnlabel ((_ ':= p) ': xs) = p ': PUnlabel xs
  PUnlabel '[] = '[]

type family MatchTypes' (n :: [S -> Type]) (m :: [S -> Type]) :: Bool where
  MatchTypes' '[] '[] = 'True
  MatchTypes' (x ': xs) (x ': ys) = MatchTypes' xs ys
  MatchTypes' (x ': xs) (y ': ys) = 'False
  MatchTypes' '[] ys = 'False
  MatchTypes' xs '[] = 'False

type family MatchTypesError (n :: [S -> Type]) (m :: [S -> Type]) (a :: Bool) :: Constraint where
  MatchTypesError _ _ 'True = ()
  MatchTypesError n m 'False =
    ( 'True ~ 'False
    , TypeError
        ( 'Text "Error when deriving 'PlutusTypeDataList':"
            ':$$: 'Text "\tMismatch between constituent Haskell and Plutarch types"
            ':$$: 'Text "Constituent Haskell Types: "
            ':$$: 'Text "\t"
              ':<>: 'ShowType n
            ':$$: 'Text "Constituent Plutarch Types: "
            ':$$: 'Text "\t"
              ':<>: 'ShowType m
        )
    )

type MatchTypes (n :: [S -> Type]) (m :: [S -> Type]) =
  (MatchTypesError n m (MatchTypes' n m))

class
  ( PGeneric p
  , PCode p ~ '[ '[GetPRecord p]]
  ) =>
  IsPlutusTypeDataList (p :: S -> Type)
instance
  forall (p :: S -> Type).
  ( PGeneric p
  , PCode p ~ '[ '[GetPRecord p]]
  , MatchTypes (UD (GetRecordTypes (SOP.Code (PLifted p)))) (PUnlabel (GetPRecord' (PCode p)))
  ) =>
  IsPlutusTypeDataList p

-- | @since 3.5.0
data PlutusTypeDataList

instance PlutusTypeStrat PlutusTypeDataList where
  type PlutusTypeStratConstraint PlutusTypeDataList = IsPlutusTypeDataList
  type DerivedPInner PlutusTypeDataList a = GetPRecord a
  derivedPCon :: forall (a :: S -> Type) (s :: S).
(DerivePlutusType a, DPTStrat a ~ PlutusTypeDataList) =>
a s -> Term s (DerivedPInner PlutusTypeDataList a)
derivedPCon a s
x = case forall (a :: S -> Type) (s :: S).
PGeneric a =>
a s -> SOP (Term s) (PCode a)
gpfrom a s
x of
    SOP.SOP (SOP.Z (Term s x
x' SOP.:* NP (Term s) xs
SOP.Nil)) -> Term s x
x'
    SOP.SOP (SOP.S NS (NP (Term s)) xs
x') -> case NS (NP (Term s)) xs
x' of {}
  derivedPMatch :: forall (a :: S -> Type) (s :: S) (b :: S -> Type).
(DerivePlutusType a, DPTStrat a ~ PlutusTypeDataList) =>
Term s (DerivedPInner PlutusTypeDataList a)
-> (a s -> Term s b) -> Term s b
derivedPMatch Term s (DerivedPInner PlutusTypeDataList a)
x a s -> Term s b
f = a s -> Term s b
f (forall (a :: S -> Type) (s :: S).
PGeneric a =>
SOP (Term s) (PCode a) -> a s
gpto forall a b. (a -> b) -> a -> b
$ forall k (f :: k -> Type) (xss :: [[k]]).
NS (NP f) xss -> SOP f xss
SOP.SOP forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k -> Type) (x :: k) (xs :: [k]).
a x -> NS a (x : xs)
SOP.Z forall a b. (a -> b) -> a -> b
$ Term s (DerivedPInner PlutusTypeDataList a)
x forall {k} (a :: k -> Type) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
SOP.:* forall {k} (a :: k -> Type). NP a '[]
SOP.Nil)

-- | @since 3.8.0
unProductIsData ::
  forall (a :: Type).
  ProductIsData a ->
  a
unProductIsData :: forall a. ProductIsData a -> a
unProductIsData = coerce :: forall a b. Coercible a b => a -> b
coerce

{- |
  Generically convert a Product-Type to 'BuiltinData' with the 'List' repr.

  @since 1.1.0
-}
gProductToBuiltinData ::
  forall (a :: Type) (repr :: [Type]).
  (IsProductType a repr, All ToData repr) =>
  a ->
  BuiltinData
gProductToBuiltinData :: forall a (repr :: [Type]).
(IsProductType a repr, All ToData repr) =>
a -> BuiltinData
gProductToBuiltinData a
x =
  Data -> BuiltinData
BuiltinData forall a b. (a -> b) -> a -> b
$ [Data] -> Data
List forall a b. (a -> b) -> a -> b
$ forall k l (h :: (k -> Type) -> l -> Type) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse forall a b. (a -> b) -> a -> b
$ forall {k} {l} (h :: (k -> Type) -> l -> Type)
       (c :: k -> Constraint) (xs :: l)
       (proxy :: (k -> Constraint) -> Type) (f :: k -> Type)
       (f' :: k -> Type).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (forall {k} (t :: k). Proxy t
Proxy @ToData) (forall {k} a b (c :: k). (a -> b) -> I a -> K b c
mapIK forall a. ToData a => a -> Data
toData) forall a b. (a -> b) -> a -> b
$ forall a (xs :: [Type]). IsProductType a xs => a -> NP I xs
productTypeFrom a
x

{- |
  Generically convert a Product-type from a 'BuiltinData' 'List' repr.

  @since 1.1.0
-}
gProductFromBuiltinData ::
  forall (a :: Type) (repr :: [Type]).
  (IsProductType a repr, All FromData repr) =>
  BuiltinData ->
  Maybe a
gProductFromBuiltinData :: forall a (repr :: [Type]).
(IsProductType a repr, All FromData repr) =>
BuiltinData -> Maybe a
gProductFromBuiltinData (BuiltinData (List [Data]
xs)) = do
  NP (K Data) repr
prod <- forall {k} (xs :: [k]) a. SListI xs => [a] -> Maybe (NP (K a) xs)
SOP.fromList @repr [Data]
xs
  forall a (xs :: [Type]). IsProductType a xs => NP I xs -> a
productTypeTo forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {l} (h :: (Type -> Type) -> l -> Type)
       (c :: Type -> Constraint) (xs :: l) (g :: Type -> Type)
       (proxy :: (Type -> Constraint) -> Type) (f :: Type -> Type).
(HSequence h, AllN h c xs, Applicative g) =>
proxy c -> (forall a. c a => f a -> g a) -> h f xs -> g (h I xs)
hctraverse (forall {k} (t :: k). Proxy t
Proxy @FromData) (forall a. I a -> a
unI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a b (c :: k). (a -> b) -> K a c -> I b
mapKI forall a. FromData a => Data -> Maybe a
fromData) NP (K Data) repr
prod
gProductFromBuiltinData BuiltinData
_ = forall a. Maybe a
Nothing

{- |
  Unsafe version of 'gProductFromBuiltinData'.

  @since 1.1.0
-}
gProductFromBuiltinDataUnsafe ::
  forall (a :: Type) (repr :: [Type]).
  (IsProductType a repr, All UnsafeFromData repr) =>
  BuiltinData ->
  a
gProductFromBuiltinDataUnsafe :: forall a (repr :: [Type]).
(IsProductType a repr, All UnsafeFromData repr) =>
BuiltinData -> a
gProductFromBuiltinDataUnsafe (BuiltinData (List [Data]
xs)) =
  let prod :: NP (K Data) repr
prod = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall {k} (xs :: [k]) a. SListI xs => [a] -> Maybe (NP (K a) xs)
SOP.fromList @repr [Data]
xs
   in forall a (xs :: [Type]). IsProductType a xs => NP I xs -> a
productTypeTo forall a b. (a -> b) -> a -> b
$
        forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$
          forall {l} (h :: (Type -> Type) -> l -> Type)
       (c :: Type -> Constraint) (xs :: l) (g :: Type -> Type)
       (proxy :: (Type -> Constraint) -> Type) (f :: Type -> Type).
(HSequence h, AllN h c xs, Applicative g) =>
proxy c -> (forall a. c a => f a -> g a) -> h f xs -> g (h I xs)
hctraverse
            (forall {k} (t :: k). Proxy t
Proxy @UnsafeFromData)
            (forall a. I a -> a
unI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} a b (c :: k). (a -> b) -> K a c -> I b
mapKI (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. UnsafeFromData a => BuiltinData -> a
unsafeFromBuiltinData forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data -> BuiltinData
BuiltinData))
            NP (K Data) repr
prod
gProductFromBuiltinDataUnsafe BuiltinData
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"invalid representation"

-- | @since 1.1.0
instance
  forall (h :: Type) (p :: S -> Type).
  (PlutusTx.FromData h, PlutusTx.ToData h, PLift p) =>
  PConstantDecl (DerivePConstantViaDataList h p)
  where
  type PConstantRepr (DerivePConstantViaDataList h p) = [PlutusTx.Data]
  type PConstanted (DerivePConstantViaDataList h p) = p
  pconstantToRepr :: DerivePConstantViaDataList h p
-> PConstantRepr (DerivePConstantViaDataList h p)
pconstantToRepr (DerivePConstantViaDataList h
x) = case forall a. ToData a => a -> Data
PlutusTx.toData h
x of
    (PlutusTx.List [Data]
xs) -> [Data]
xs
    Data
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"ToData repr is not a List!"
  pconstantFromRepr :: PConstantRepr (DerivePConstantViaDataList h p)
-> Maybe (DerivePConstantViaDataList h p)
pconstantFromRepr = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. FromData a => Data -> Maybe a
PlutusTx.fromData @h forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Data] -> Data
PlutusTx.List)

-- | @since 1.1.0
instance
  forall (a :: Type) (repr :: [Type]).
  (IsProductType a repr, All ToData repr) =>
  ToData (ProductIsData a)
  where
  toBuiltinData :: ProductIsData a -> BuiltinData
toBuiltinData = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a (repr :: [Type]).
(IsProductType a repr, All ToData repr) =>
a -> BuiltinData
gProductToBuiltinData @a)

-- | @since 1.1.0
instance
  forall (a :: Type) (repr :: [Type]).
  (IsProductType a repr, All UnsafeFromData repr) =>
  UnsafeFromData (ProductIsData a)
  where
  unsafeFromBuiltinData :: BuiltinData -> ProductIsData a
unsafeFromBuiltinData = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a (repr :: [Type]).
(IsProductType a repr, All UnsafeFromData repr) =>
BuiltinData -> a
gProductFromBuiltinDataUnsafe @a)

-- | @since 1.1.0
instance
  forall (a :: Type) (repr :: [Type]).
  (IsProductType a repr, All FromData repr) =>
  FromData (ProductIsData a)
  where
  fromBuiltinData :: BuiltinData -> Maybe (ProductIsData a)
fromBuiltinData = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a (repr :: [Type]).
(IsProductType a repr, All FromData repr) =>
BuiltinData -> Maybe a
gProductFromBuiltinData @a)

--------------------------------------------------------------------------------
-- PEnumData

{- |
  Wrapper for deriving 'ToData', 'FromData' using an Integer representation via 'Enum'.

  @since 1.1.0
-}
newtype EnumIsData (a :: Type) = EnumIsData a

-- | @since 1.1.0
instance forall (a :: Type). (Enum a) => ToData (EnumIsData a) where
  toBuiltinData :: EnumIsData a -> BuiltinData
toBuiltinData = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall a. ToData a => a -> BuiltinData
toBuiltinData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum @a

-- | @since 1.1.0
instance forall (a :: Type). (Enum a) => FromData (EnumIsData a) where
  fromBuiltinData :: BuiltinData -> Maybe (EnumIsData a)
fromBuiltinData = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Enum a => Int -> a
toEnum @a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromData a => BuiltinData -> Maybe a
fromBuiltinData @Integer

-- | @since 1.1.0
instance forall (a :: Type). (Enum a) => UnsafeFromData (EnumIsData a) where
  unsafeFromBuiltinData :: BuiltinData -> EnumIsData a
unsafeFromBuiltinData = coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum @a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. UnsafeFromData a => BuiltinData -> a
unsafeFromBuiltinData @Integer

data PlutusTypeEnumData

class
  ( PGeneric p
  , forall s. Enum (p s)
  , forall s. Bounded (p s)
  ) =>
  IsPlutusTypeEnumData (p :: S -> Type)
instance
  ( PGeneric p
  , forall s. Enum (p s)
  , forall s. Bounded (p s)
  ) =>
  IsPlutusTypeEnumData p

instance PlutusTypeStrat PlutusTypeEnumData where
  type PlutusTypeStratConstraint PlutusTypeEnumData = IsPlutusTypeEnumData
  type DerivedPInner PlutusTypeEnumData a = PInteger
  derivedPCon :: forall (a :: S -> Type) (s :: S).
(DerivePlutusType a, DPTStrat a ~ PlutusTypeEnumData) =>
a s -> Term s (DerivedPInner PlutusTypeEnumData a)
derivedPCon = forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum
  derivedPMatch :: forall (a :: S -> Type) (s :: S) (b :: S -> Type).
(DerivePlutusType a, DPTStrat a ~ PlutusTypeEnumData) =>
Term s (DerivedPInner PlutusTypeEnumData a)
-> (a s -> Term s b) -> Term s b
derivedPMatch = forall a (b :: S -> Type) (s :: S).
(Bounded a, Enum a) =>
Term s PInteger -> (a -> Term s b) -> Term s b
pmatchEnum

{- |
  Wrapper for deriving `PConstantDecl` using an Integer representation via 'Enum'.

  @since 1.1.0
-}
newtype DerivePConstantViaEnum (h :: Type) (p :: S -> Type)
  = DerivePConstantEnum h

-- | @since 1.1.0
instance
  forall (p :: S -> Type) (h :: Type).
  ( PLift p
  , Enum h
  , DerivePlutusType p
  , DPTStrat p ~ PlutusTypeEnumData
  ) =>
  PConstantDecl (DerivePConstantViaEnum h p)
  where
  type PConstantRepr (DerivePConstantViaEnum h p) = Integer
  type PConstanted (DerivePConstantViaEnum h p) = p

  pconstantToRepr :: DerivePConstantViaEnum h p
-> PConstantRepr (DerivePConstantViaEnum h p)
pconstantToRepr = forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum @h forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce
  pconstantFromRepr :: PConstantRepr (DerivePConstantViaEnum h p)
-> Maybe (DerivePConstantViaEnum h p)
pconstantFromRepr = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum @h forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger

-- | Safely enumerate all the cases.
safeCases :: forall (a :: Type). (Bounded a, Enum a) => [a]
safeCases :: forall a. (Bounded a, Enum a) => [a]
safeCases = forall a. Enum a => a -> [a]
enumFrom forall a. Bounded a => a
minBound

{- |
  Pattern match over the integer-repr of a Bounded Enum type.

  @since 1.1.0
-}
pmatchEnum ::
  forall (a :: Type) (b :: S -> Type) (s :: S).
  (Bounded a, Enum a) =>
  Term s PInteger ->
  (a -> Term s b) ->
  Term s b
pmatchEnum :: forall a (b :: S -> Type) (s :: S).
(Bounded a, Enum a) =>
Term s PInteger -> (a -> Term s b) -> Term s b
pmatchEnum Term s PInteger
x a -> Term s b
f = forall (a :: S -> Type) (s :: S). TermCont s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
  Term s PInteger
x' <- forall {r :: S -> Type} (s :: S) (a :: S -> Type).
Term s a -> TermCont s (Term s a)
pletC Term s PInteger
x

  let branch :: a -> Term s b -> Term s b
      branch :: a -> Term s b -> Term s b
branch a
n =
        forall (s :: S) (a :: S -> Type).
Term s PBool -> Term s a -> Term s a -> Term s a
pif
          (Term s PInteger
x' forall (t :: S -> Type) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== (forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ a
n))
          (a -> Term s b
f a
n)

  forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Term s b -> Term s b
branch (a -> Term s b
f forall a. Bounded a => a
maxBound) forall a. (Bounded a, Enum a) => [a]
safeCases

{- |
  Pattern match PData as a Bounded Enum. Useful for Redeemers.

  @since 1.1.0
-}
pmatchEnumFromData ::
  forall (a :: Type) (b :: S -> Type) (s :: S).
  (Bounded a, Enum a) =>
  Term s PData ->
  (Maybe a -> Term s b) ->
  Term s b
pmatchEnumFromData :: forall a (b :: S -> Type) (s :: S).
(Bounded a, Enum a) =>
Term s PData -> (Maybe a -> Term s b) -> Term s b
pmatchEnumFromData Term s PData
d Maybe a -> Term s b
f = forall (a :: S -> Type) (s :: S). TermCont s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
  Term s PInteger
x <- forall {r :: S -> Type} (s :: S) (a :: S -> Type).
Term s a -> TermCont s (Term s a)
pletC forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s (PData :--> PInteger)
pasInt forall (s :: S) (a :: S -> Type) (b :: S -> Type).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PData
d

  let branch :: a -> Term s b -> Term s b
      branch :: a -> Term s b -> Term s b
branch a
n =
        forall (s :: S) (a :: S -> Type).
Term s PBool -> Term s a -> Term s a -> Term s a
pif
          (Term s PInteger
x forall (t :: S -> Type) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== (forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum forall a b. (a -> b) -> a -> b
$ a
n))
          (Maybe a -> Term s b
f forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
n)

  forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> Term s b -> Term s b
branch (Maybe a -> Term s b
f forall a. Maybe a
Nothing) forall a. (Bounded a, Enum a) => [a]
safeCases