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

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

import Plutarch.Builtin.Bool (PBool (PFalse, PTrue))
import Plutarch.Internal.Eq (PEq ((#==)))
import Plutarch.Internal.Lift (
  DeriveBuiltinPLiftable,
  PLiftable,
  PLifted (PLifted),
  pconstant,
 )
import Plutarch.Internal.Ord (POrd, PPartialOrd ((#<), (#<=)))
import Plutarch.Internal.PlutusType (PInner, PlutusType, pcon, pcon', pmatch')
import Plutarch.Internal.Term (Term, plet)
import Plutarch.Show (PShow (pshow'))

data PUnit s = PUnit

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 = AsHaskell (PInner (PUnit @S)) -> Term s (PInner (PUnit @S))
forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
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 = Term s (PInner (PUnit @S))
-> (Term s (PInner (PUnit @S)) -> Term s b) -> Term s b
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 PUnit @S s
forall {k} (s :: k). PUnit @k s
PUnit

-- | @since WIP
deriving via
  (DeriveBuiltinPLiftable PUnit ())
  instance
    PLiftable 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 = Term s (PUnit @S)
-> (Term s (PUnit @S) -> Term s PBool) -> Term s PBool
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)
_ -> Term s (PUnit @S)
-> (Term s (PUnit @S) -> Term s PBool) -> Term s PBool
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)
_ -> PBool s -> Term s PBool
forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon PBool s
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 = Term s (PUnit @S)
-> (Term s (PUnit @S) -> Term s PBool) -> Term s PBool
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)
_ -> Term s (PUnit @S)
-> (Term s (PUnit @S) -> Term s PBool) -> Term s PBool
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)
_ -> PBool s -> Term s PBool
forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon PBool s
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 = Term s (PUnit @S)
-> (Term s (PUnit @S) -> Term s PBool) -> Term s PBool
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)
_ -> Term s (PUnit @S)
-> (Term s (PUnit @S) -> Term s PBool) -> Term s PBool
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)
_ -> PBool s -> Term s PBool
forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon PBool s
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 = Term s (PUnit @S)
-> (Term s (PUnit @S) -> Term s (PUnit @S)) -> 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)
x \Term s (PUnit @S)
_ -> Term s (PUnit @S)
-> (Term s (PUnit @S) -> Term s (PUnit @S)) -> 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)
_ -> PUnit @S s -> Term s (PUnit @S)
forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon PUnit @S s
forall {k} (s :: k). PUnit @k s
PUnit

instance Monoid (Term s PUnit) where
  mempty :: Term s (PUnit @S)
mempty = PUnit @S s -> Term s (PUnit @S)
forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon PUnit @S s
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 = Term s (PUnit @S)
-> (Term s (PUnit @S) -> Term s PString) -> Term s PString
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 PString -> Term s (PUnit @S) -> Term s PString
forall a b. a -> b -> a
const Term s PString
"()")