module Plutarch.Extra.Bool (
  pcompare,
  pcond,
  passert,
) where

--------------------------------------------------------------------------------

import Data.Monoid (Endo (Endo, appEndo))

--------------------------------------------------------------------------------

{- | Perform a \'three-way\' comparison on two 'Term's, then return a result
 based on the outcome.

 @since 1.0.0
-}
pcompare ::
  forall (a :: S -> Type) (b :: S -> Type) (s :: S).
  (POrd a) =>
  -- | First 'Term'
  Term s a ->
  -- | Second 'Term'
  Term s a ->
  -- | Result if first 'Term' is smaller than second
  Term s b ->
  -- | Result if first 'Term' is equal to second
  Term s b ->
  -- | Result if first 'Term' is greater than second
  Term s b ->
  -- | Final outcome based on test
  Term s b
pcompare :: forall (a :: S -> Type) (b :: S -> Type) (s :: S).
POrd a =>
Term s a
-> Term s a -> Term s b -> Term s b -> Term s b -> Term s b
pcompare Term s a
t1 Term s a
t2 Term s b
ifLT Term s b
ifEQ Term s b
ifGT =
  forall (s :: S) (a :: S -> Type).
Term s PBool -> Term s a -> Term s a -> Term s a
pif (Term s a
t1 forall (t :: S -> Type) (s :: S).
PPartialOrd t =>
Term s t -> Term s t -> Term s PBool
#< Term s a
t2) Term s b
ifLT (forall (s :: S) (a :: S -> Type).
Term s PBool -> Term s a -> Term s a -> Term s a
pif (Term s a
t1 forall (t :: S -> Type) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s a
t2) Term s b
ifEQ Term s b
ifGT)

{- |
  Lisp-like cond:
    chain together if conditions and the final else case

  @since 3.9.1
-}
pcond :: forall (s :: S) (a :: S -> Type). [Term s a -> Term s a] -> Term s a -> Term s a
pcond :: forall (s :: S) (a :: S -> Type).
[Term s a -> Term s a] -> Term s a -> Term s a
pcond = forall a. Endo a -> a -> a
appEndo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. (a -> a) -> Endo a
Endo

{- | If the condition evaluated to true, return the third argument. Otherwise error
     out with the error message.

     @since 3.14.1
-}
passert ::
  forall (a :: PType) (s :: S).
  -- | The error message.
  Term s PString ->
  -- | The condition.
  Term s PBool ->
  -- | The result.
  Term s a ->
  Term s a
passert :: forall (a :: S -> Type) (s :: S).
Term s PString -> Term s PBool -> Term s a -> Term s a
passert Term s PString
msg Term s PBool
cond Term s a
x = forall (s :: S) (a :: S -> Type).
Term s PBool -> Term s a -> Term s a -> Term s a
pif Term s PBool
cond Term s a
x forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: S -> Type). Term s PString -> Term s a
ptraceError Term s PString
msg