module Plutarch.Extra.Monoid (
  PAll (..),
  pgetAll,
  PAny (..),
  pgetAny,
) where

import Control.Composition ((.*))
import Data.Function (on)
import Plutarch.Unsafe (punsafeCoerce)

-- | @since 1.3.0
newtype PAll (s :: S) = PAll (Term s PBool)
  deriving stock
    ( -- | @since 1.4.0
      forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: S) x. Rep (PAll s) x -> PAll s
forall (s :: S) x. PAll s -> Rep (PAll s) x
$cto :: forall (s :: S) x. Rep (PAll s) x -> PAll s
$cfrom :: forall (s :: S) x. PAll s -> Rep (PAll s) x
Generic
    )
  deriving anyclass
    ( -- | @since 1.3.0
      forall (s :: S). PAll s -> Term s (PInner PAll)
forall (s :: S) (b :: PType).
Term s (PInner PAll) -> (PAll s -> Term s b) -> Term s b
forall (a :: PType).
(forall (s :: S). a s -> Term s (PInner a))
-> (forall (s :: S) (b :: PType).
    Term s (PInner a) -> (a s -> Term s b) -> Term s b)
-> PlutusType a
pmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PAll) -> (PAll s -> Term s b) -> Term s b
$cpmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PAll) -> (PAll s -> Term s b) -> Term s b
pcon' :: forall (s :: S). PAll s -> Term s (PInner PAll)
$cpcon' :: forall (s :: S). PAll s -> Term s (PInner PAll)
PlutusType
    , -- | @since 1.3.0
      forall (s :: S). Term s (PAsData PAll) -> Term s PAll
forall (s :: S). Term s PAll -> Term s PData
forall (a :: PType).
(forall (s :: S). Term s (PAsData a) -> Term s a)
-> (forall (s :: S). Term s a -> Term s PData) -> PIsData a
pdataImpl :: forall (s :: S). Term s PAll -> Term s PData
$cpdataImpl :: forall (s :: S). Term s PAll -> Term s PData
pfromDataImpl :: forall (s :: S). Term s (PAsData PAll) -> Term s PAll
$cpfromDataImpl :: forall (s :: S). Term s (PAsData PAll) -> Term s PAll
PIsData
    , -- | @since 1.3.0
      forall (s :: S). Term s PAll -> Term s PAll -> Term s PBool
forall (t :: PType).
(forall (s :: S). Term s t -> Term s t -> Term s PBool) -> PEq t
#== :: forall (s :: S). Term s PAll -> Term s PAll -> Term s PBool
$c#== :: forall (s :: S). Term s PAll -> Term s PAll -> Term s PBool
PEq
    , -- | @since 1.3.0
      forall (s :: S). Bool -> Term s PAll -> Term s PString
forall (t :: PType).
(forall (s :: S). Bool -> Term s t -> Term s PString) -> PShow t
pshow' :: forall (s :: S). Bool -> Term s PAll -> Term s PString
$cpshow' :: forall (s :: S). Bool -> Term s PAll -> Term s PString
PShow
    )

-- | @since 1.4.0
instance DerivePlutusType PAll where
  type DPTStrat _ = PlutusTypeNewtype

instance forall (s :: S). Semigroup (Term s PAll) where
  Term s PAll
x <> :: Term s PAll -> Term s PAll -> Term s PAll
<> Term s PAll
y = forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S). Term s PBool -> PAll s
PAll forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PAll
x forall (s :: S). Term s PBool -> Term s PBool -> Term s PBool
#&& forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto Term s PAll
y

instance forall (s :: S). Monoid (Term s PAll) where
  mempty :: Term s PAll
mempty = forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s PBool -> PAll s
PAll forall a b. (a -> b) -> a -> b
$ forall (p :: PType) (s :: S). PLift p => PLifted p -> Term s p
pconstant Bool
True

pgetAll :: forall (s :: S). Term s (PAll :--> PBool)
pgetAll :: forall (s :: S). Term s (PAll :--> PBool)
pgetAll = forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce

-- | @since 1.3.0
newtype PAny (s :: S) = PAny (Term s PBool)
  deriving stock
    ( -- | @since 1.4.0
      forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: S) x. Rep (PAny s) x -> PAny s
forall (s :: S) x. PAny s -> Rep (PAny s) x
$cto :: forall (s :: S) x. Rep (PAny s) x -> PAny s
$cfrom :: forall (s :: S) x. PAny s -> Rep (PAny s) x
Generic
    )
  deriving anyclass
    ( -- | @since 1.3.0
      forall (s :: S). PAny s -> Term s (PInner PAny)
forall (s :: S) (b :: PType).
Term s (PInner PAny) -> (PAny s -> Term s b) -> Term s b
forall (a :: PType).
(forall (s :: S). a s -> Term s (PInner a))
-> (forall (s :: S) (b :: PType).
    Term s (PInner a) -> (a s -> Term s b) -> Term s b)
-> PlutusType a
pmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PAny) -> (PAny s -> Term s b) -> Term s b
$cpmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PAny) -> (PAny s -> Term s b) -> Term s b
pcon' :: forall (s :: S). PAny s -> Term s (PInner PAny)
$cpcon' :: forall (s :: S). PAny s -> Term s (PInner PAny)
PlutusType
    , -- | @since 1.3.0
      forall (s :: S). Term s (PAsData PAny) -> Term s PAny
forall (s :: S). Term s PAny -> Term s PData
forall (a :: PType).
(forall (s :: S). Term s (PAsData a) -> Term s a)
-> (forall (s :: S). Term s a -> Term s PData) -> PIsData a
pdataImpl :: forall (s :: S). Term s PAny -> Term s PData
$cpdataImpl :: forall (s :: S). Term s PAny -> Term s PData
pfromDataImpl :: forall (s :: S). Term s (PAsData PAny) -> Term s PAny
$cpfromDataImpl :: forall (s :: S). Term s (PAsData PAny) -> Term s PAny
PIsData
    , -- | @since 1.3.0
      forall (s :: S). Term s PAny -> Term s PAny -> Term s PBool
forall (t :: PType).
(forall (s :: S). Term s t -> Term s t -> Term s PBool) -> PEq t
#== :: forall (s :: S). Term s PAny -> Term s PAny -> Term s PBool
$c#== :: forall (s :: S). Term s PAny -> Term s PAny -> Term s PBool
PEq
    , -- | @since 1.3.0
      forall (s :: S). Bool -> Term s PAny -> Term s PString
forall (t :: PType).
(forall (s :: S). Bool -> Term s t -> Term s PString) -> PShow t
pshow' :: forall (s :: S). Bool -> Term s PAny -> Term s PString
$cpshow' :: forall (s :: S). Bool -> Term s PAny -> Term s PString
PShow
    )

-- | @since 1.4.0
instance DerivePlutusType PAny where
  type DPTStrat _ = PlutusTypeNewtype

pgetAny :: forall (s :: S). Term s (PAny :--> PBool)
pgetAny :: forall (s :: S). Term s (PAny :--> PBool)
pgetAny = forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce

instance forall (s :: S). Semigroup (Term s PAny) where
  <> :: Term s PAny -> Term s PAny -> Term s PAny
(<>) = forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S). Term s PBool -> PAny s
PAny forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* forall (s :: S). Term s PBool -> Term s PBool -> Term s PBool
(#&&) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce

instance forall (s :: S). Monoid (Term s PAny) where
  mempty :: Term s PAny
mempty = forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s PBool -> PAny s
PAny forall a b. (a -> b) -> a -> b
$ forall (p :: PType) (s :: S). PLift p => PLifted p -> Term s p
pconstant Bool
False