{-# LANGUAGE QuantifiedConstraints #-}

{- | Vendored utilities from open source libraries.
See the appropriate License for details on usage.
-}
module Cardano.YTxP.Control.Vendored (
  DerivePConstantViaEnum (..),
  PlutusTypeEnumData,
) where

import Data.Coerce (coerce)
import Plutarch.Internal.Generic (PGeneric)
import Plutarch.Internal.PlutusType (
  PlutusTypeStrat (
    DerivedPInner,
    PlutusTypeStratConstraint,
    derivedPCon,
    derivedPMatch
  ),
 )
import Plutarch.Lift (
  PConstantDecl (PConstantRepr, PConstanted, pconstantFromRepr, pconstantToRepr),
 )

{- |
  PlutusTypeEnumData

  Vendored from LPE
  TODO: Licensing info
-}
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 _ = PInteger
  derivedPCon :: forall (a :: S -> Type) (s :: S).
(DerivePlutusType a,
 (DPTStrat a :: Type) ~ (PlutusTypeEnumData :: Type)) =>
a s -> Term s (DerivedPInner PlutusTypeEnumData a)
derivedPCon = Integer -> Term s PInteger
forall a. Num a => Integer -> a
fromInteger (Integer -> Term s PInteger)
-> (a s -> Integer) -> a s -> Term s PInteger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (a s -> Int) -> a s -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a s -> Int
forall a. Enum a => a -> Int
fromEnum
  derivedPMatch :: forall (a :: S -> Type) (s :: S) (b :: S -> Type).
(DerivePlutusType a,
 (DPTStrat a :: Type) ~ (PlutusTypeEnumData :: Type)) =>
Term s (DerivedPInner PlutusTypeEnumData a)
-> (a s -> Term s b) -> Term s b
derivedPMatch = Term s PInteger -> (a s -> Term s b) -> Term s b
Term s (DerivedPInner PlutusTypeEnumData a)
-> (a s -> Term s b) -> Term s b
forall a (b :: S -> Type) (s :: S).
(Bounded a, Enum a) =>
Term s PInteger -> (a -> Term s b) -> Term s b
pmatchEnum

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

  Vendored from LPE
  TODO: Licensing info

  @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 = TermCont @b s (Term s b) -> Term s b
forall (a :: S -> Type) (s :: S).
TermCont @a s (Term s a) -> Term s a
unTermCont (TermCont @b s (Term s b) -> Term s b)
-> TermCont @b s (Term s b) -> Term s b
forall a b. (a -> b) -> a -> b
$ do
  Term s PInteger
x' <- Term s PInteger -> TermCont @b s (Term s PInteger)
forall {r :: S -> Type} (s :: S) (a :: S -> Type).
Term s a -> TermCont @r 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 =
        Term s PBool -> Term s b -> Term s b -> Term s b
forall (s :: S) (a :: S -> Type).
Term s PBool -> Term s a -> Term s a -> Term s a
pif
          (Term s PInteger
x' Term s PInteger -> Term s PInteger -> Term s PBool
forall (s :: S). Term s PInteger -> Term s PInteger -> Term s PBool
forall (t :: S -> Type) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== (Integer -> Term s PInteger
forall a. Num a => Integer -> a
fromInteger (Integer -> Term s PInteger)
-> (a -> Integer) -> a -> Term s PInteger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (a -> Int) -> a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum (a -> Term s PInteger) -> a -> Term s PInteger
forall a b. (a -> b) -> a -> b
$ a
n))
          (a -> Term s b
f a
n)

  Term s b -> TermCont @b s (Term s b)
forall a. a -> TermCont @b s a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Term s b -> TermCont @b s (Term s b))
-> Term s b -> TermCont @b s (Term s b)
forall a b. (a -> b) -> a -> b
$ (a -> Term s b -> Term s b) -> Term s b -> [a] -> Term s b
forall a b. (a -> b -> b) -> 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 a
forall a. Bounded a => a
maxBound) [a]
forall a. (Bounded a, Enum a) => [a]
safeCases

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

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

  Vendored from LPE
  TODO: Licensing info

  @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 = Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer)
-> (DerivePConstantViaEnum h p -> Int)
-> DerivePConstantViaEnum h p
-> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum @h (h -> Int)
-> (DerivePConstantViaEnum h p -> h)
-> DerivePConstantViaEnum h p
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivePConstantViaEnum h p -> h
forall a b. Coercible @Type a b => a -> b
coerce
  pconstantFromRepr :: PConstantRepr (DerivePConstantViaEnum h p)
-> Maybe (DerivePConstantViaEnum h p)
pconstantFromRepr = DerivePConstantViaEnum h p -> Maybe (DerivePConstantViaEnum h p)
forall a. a -> Maybe a
Just (DerivePConstantViaEnum h p -> Maybe (DerivePConstantViaEnum h p))
-> (Integer -> DerivePConstantViaEnum h p)
-> Integer
-> Maybe (DerivePConstantViaEnum h p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. h -> DerivePConstantViaEnum h p
forall a b. Coercible @Type a b => a -> b
coerce (h -> DerivePConstantViaEnum h p)
-> (Integer -> h) -> Integer -> DerivePConstantViaEnum h p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => Int -> a
toEnum @h (Int -> h) -> (Integer -> Int) -> Integer -> h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger