-- Needed to ensure mapBoring is used properly
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Plutarch.Extra.Boring (
  -- * Type class
  PBoring (..),

  -- * Functions
  mapBoring,
) where

{- | Represents singleton values. They are \'boring\' as having a value of that
 type tells you absolutely nothing, as they're all the same.

 = Laws

 * /Singleton/: @x = boring@

 @since 1.2.0
-}
class PBoring (a :: S -> Type) where
  pboring :: Term s a

-- | @since 1.2.0
instance PBoring PUnit where
  pboring :: forall (s :: S). Term s PUnit
pboring = forall (a :: S -> Type) (s :: S). PlutusType a => a s -> Term s a
pcon forall {k} (s :: k). PUnit s
PUnit

{- | As every 'PBoring' instance is a singleton, we can always convert one
 boring value into another.

 @since 1.2.0
-}
mapBoring ::
  forall (a :: S -> Type) (b :: S -> Type) (s :: S).
  (PBoring a, PBoring b) =>
  Term s (a :--> b)
mapBoring :: forall (a :: S -> Type) (b :: S -> Type) (s :: S).
(PBoring a, PBoring b) =>
Term s (a :--> b)
mapBoring = forall (a :: S -> Type) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$ forall a (b :: S -> Type) (s :: S) (c :: S -> Type).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall (a :: S -> Type) (s :: S). PBoring a => Term s a
pboring