module Plutarch.Internal.Case (punsafeCase) where

import Data.Kind (Type)
import Data.Semialign (unzipWith)
import Plutarch.Builtin.Opaque (POpaque)
import Plutarch.Internal.Term (
  RawTerm (RCase),
  S,
  Term (Term),
  TermResult (TermResult),
  asRawTerm,
 )

{- | Construct a @Case@ statement in UPLC. The first argument is what will be
matched on, while the second argument will be used as handlers.

= Important note

No attempt will (or even /can/) be made to check that the handlers have
correct types, or that the number of handlers is appropriate for the type
being handled. Crashes or misbehaviour can and will occur if you get this
wrong!

@since 1.13.0
-}
punsafeCase ::
  forall (a :: S -> Type) (b :: S -> Type) (s :: S).
  Term s a ->
  [Term s POpaque] ->
  Term s b
punsafeCase :: forall (a :: S -> Type) (b :: S -> Type) (s :: S).
Term s a -> [Term s POpaque] -> Term s b
punsafeCase Term s a
scrutinee [Term s POpaque]
handlers = (Word64 -> TermMonad TermResult) -> Term s b
forall (s :: S) (a :: S -> Type).
(Word64 -> TermMonad TermResult) -> Term s a
Term ((Word64 -> TermMonad TermResult) -> Term s b)
-> (Word64 -> TermMonad TermResult) -> Term s b
forall a b. (a -> b) -> a -> b
$ \Word64
level -> do
  TermResult RawTerm
rawScrutinee [HoistedTerm]
depsScrutinee <- Term s a -> Word64 -> TermMonad TermResult
forall (s :: S) (a :: S -> Type).
Term s a -> Word64 -> TermMonad TermResult
asRawTerm Term s a
scrutinee Word64
level
  ([RawTerm]
rawHandlers, [[HoistedTerm]]
depsHandlers) <- ([TermResult] -> ([RawTerm], [[HoistedTerm]]))
-> TermMonad [TermResult] -> TermMonad ([RawTerm], [[HoistedTerm]])
forall a b. (a -> b) -> TermMonad a -> TermMonad b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TermResult -> (RawTerm, [HoistedTerm]))
-> [TermResult] -> ([RawTerm], [[HoistedTerm]])
forall c a b. (c -> (a, b)) -> [c] -> ([a], [b])
forall (f :: Type -> Type) c a b.
Unzip f =>
(c -> (a, b)) -> f c -> (f a, f b)
unzipWith (\(TermResult RawTerm
x [HoistedTerm]
y) -> (RawTerm
x, [HoistedTerm]
y))) (TermMonad [TermResult] -> TermMonad ([RawTerm], [[HoistedTerm]]))
-> ([Term s POpaque] -> TermMonad [TermResult])
-> [Term s POpaque]
-> TermMonad ([RawTerm], [[HoistedTerm]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term s POpaque -> TermMonad TermResult)
-> [Term s POpaque] -> TermMonad [TermResult]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Term s POpaque -> Word64 -> TermMonad TermResult
forall (s :: S) (a :: S -> Type).
Term s a -> Word64 -> TermMonad TermResult
`asRawTerm` Word64
level) ([Term s POpaque] -> TermMonad ([RawTerm], [[HoistedTerm]]))
-> [Term s POpaque] -> TermMonad ([RawTerm], [[HoistedTerm]])
forall a b. (a -> b) -> a -> b
$ [Term s POpaque]
handlers
  let allDeps :: [HoistedTerm]
allDeps = [HoistedTerm]
depsScrutinee [HoistedTerm] -> [HoistedTerm] -> [HoistedTerm]
forall a. Semigroup a => a -> a -> a
<> [[HoistedTerm]] -> [HoistedTerm]
forall a. Monoid a => [a] -> a
mconcat [[HoistedTerm]]
depsHandlers
  TermResult -> TermMonad TermResult
forall a. a -> TermMonad a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TermResult -> TermMonad TermResult)
-> ([HoistedTerm] -> TermResult)
-> [HoistedTerm]
-> TermMonad TermResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawTerm -> [HoistedTerm] -> TermResult
TermResult (RawTerm -> [RawTerm] -> RawTerm
RCase RawTerm
rawScrutinee [RawTerm]
rawHandlers) ([HoistedTerm] -> TermMonad TermResult)
-> [HoistedTerm] -> TermMonad TermResult
forall a b. (a -> b) -> a -> b
$ [HoistedTerm]
allDeps