{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Plutarch.Unit (PUnit (..)) where

import Plutarch (Term, pcon, plet)
import Plutarch.Bool (PBool (PFalse, PTrue), PEq, POrd, PPartialOrd, (#<), (#<=), (#==))
import Plutarch.Internal.PlutusType (PInner, PlutusType, pcon', pmatch')
import Plutarch.Lift (
  DerivePConstantDirect (DerivePConstantDirect),
  PConstantDecl,
  PLifted,
  PUnsafeLiftDecl,
  pconstant,
 )
import Plutarch.Show (PShow (pshow'))

data PUnit s = PUnit

instance PUnsafeLiftDecl PUnit where type PLifted PUnit = ()
deriving via (DerivePConstantDirect () PUnit) instance PConstantDecl ()

instance PlutusType PUnit where
  type PInner PUnit = PUnit
  pcon' :: forall (s :: S). PUnit @S s -> Term s (PInner (PUnit @S))
pcon' PUnit @S s
PUnit = forall (p :: PType) (s :: S). PLift p => PLifted p -> Term s p
pconstant ()
  pmatch' :: forall (s :: S) (b :: PType).
Term s (PInner (PUnit @S)) -> (PUnit @S s -> Term s b) -> Term s b
pmatch' Term s (PInner (PUnit @S))
x PUnit @S s -> Term s b
f = forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet Term s (PInner (PUnit @S))
x \Term s (PInner (PUnit @S))
_ -> PUnit @S s -> Term s b
f forall {k} (s :: k). PUnit @k s
PUnit

instance PEq PUnit where
  Term s (PUnit @S)
x #== :: forall (s :: S).
Term s (PUnit @S) -> Term s (PUnit @S) -> Term s PBool
#== Term s (PUnit @S)
y = forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet Term s (PUnit @S)
x \Term s (PUnit @S)
_ -> forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet Term s (PUnit @S)
y \Term s (PUnit @S)
_ -> forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall (s :: S). PBool s
PTrue

instance PPartialOrd PUnit where
  Term s (PUnit @S)
x #<= :: forall (s :: S).
Term s (PUnit @S) -> Term s (PUnit @S) -> Term s PBool
#<= Term s (PUnit @S)
y = forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet Term s (PUnit @S)
x \Term s (PUnit @S)
_ -> forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet Term s (PUnit @S)
y \Term s (PUnit @S)
_ -> forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall (s :: S). PBool s
PTrue
  Term s (PUnit @S)
x #< :: forall (s :: S).
Term s (PUnit @S) -> Term s (PUnit @S) -> Term s PBool
#< Term s (PUnit @S)
y = forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet Term s (PUnit @S)
x \Term s (PUnit @S)
_ -> forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet Term s (PUnit @S)
y \Term s (PUnit @S)
_ -> forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall (s :: S). PBool s
PFalse

instance POrd PUnit

instance Semigroup (Term s PUnit) where
  Term s (PUnit @S)
x <> :: Term s (PUnit @S) -> Term s (PUnit @S) -> Term s (PUnit @S)
<> Term s (PUnit @S)
y = forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet Term s (PUnit @S)
x \Term s (PUnit @S)
_ -> forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet Term s (PUnit @S)
y \Term s (PUnit @S)
_ -> forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall {k} (s :: k). PUnit @k s
PUnit

instance Monoid (Term s PUnit) where
  mempty :: Term s (PUnit @S)
mempty = forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall {k} (s :: k). PUnit @k s
PUnit

instance PShow PUnit where
  pshow' :: forall (s :: S). Bool -> Term s (PUnit @S) -> Term s PString
pshow' Bool
_ Term s (PUnit @S)
x = forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet Term s (PUnit @S)
x (forall a b. a -> b -> a
const Term s PString
"()")