module FFI.SimplifierTrace (
    mkFfiSimplifierTrace,
) where

import FFI.Untyped qualified as FFI

import PlutusPrelude

import UntypedPlutusCore qualified as UPLC
import UntypedPlutusCore.Transform.Simplifier

mkFfiSimplifierTrace
  :: SimplifierTrace UPLC.Name UPLC.DefaultUni UPLC.DefaultFun a
  -> [(SimplifierStage, (FFI.UTerm, FFI.UTerm))]
mkFfiSimplifierTrace :: forall a.
SimplifierTrace Name DefaultUni DefaultFun a
-> [(SimplifierStage, (UTerm, UTerm))]
mkFfiSimplifierTrace (SimplifierTrace [Simplification Name DefaultUni DefaultFun a]
simplTrace) = [(SimplifierStage, (UTerm, UTerm))]
-> [(SimplifierStage, (UTerm, UTerm))]
forall a. [a] -> [a]
reverse ([(SimplifierStage, (UTerm, UTerm))]
 -> [(SimplifierStage, (UTerm, UTerm))])
-> [(SimplifierStage, (UTerm, UTerm))]
-> [(SimplifierStage, (UTerm, UTerm))]
forall a b. (a -> b) -> a -> b
$ Simplification Name DefaultUni DefaultFun a
-> (SimplifierStage, (UTerm, UTerm))
forall {a}.
Simplification Name DefaultUni DefaultFun a
-> (SimplifierStage, (UTerm, UTerm))
toFfiAst (Simplification Name DefaultUni DefaultFun a
 -> (SimplifierStage, (UTerm, UTerm)))
-> [Simplification Name DefaultUni DefaultFun a]
-> [(SimplifierStage, (UTerm, UTerm))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Simplification Name DefaultUni DefaultFun a]
simplTrace
  where
    toFfiAst :: Simplification Name DefaultUni DefaultFun a
-> (SimplifierStage, (UTerm, UTerm))
toFfiAst Simplification {Term Name DefaultUni DefaultFun a
beforeAST :: Term Name DefaultUni DefaultFun a
beforeAST :: forall name (uni :: * -> *) fun a.
Simplification name uni fun a -> Term name uni fun a
beforeAST, SimplifierStage
stage :: SimplifierStage
stage :: forall name (uni :: * -> *) fun a.
Simplification name uni fun a -> SimplifierStage
stage, Term Name DefaultUni DefaultFun a
afterAST :: Term Name DefaultUni DefaultFun a
afterAST :: forall name (uni :: * -> *) fun a.
Simplification name uni fun a -> Term name uni fun a
afterAST} =
      case (Term Name DefaultUni DefaultFun a
-> Either
     FreeVariableError (Term NamedDeBruijn DefaultUni DefaultFun a)
forall e (m :: * -> *) (uni :: * -> *) fun ann.
(AsFreeVariableError e, MonadError e m) =>
Term Name uni fun ann -> m (Term NamedDeBruijn uni fun ann)
UPLC.deBruijnTerm Term Name DefaultUni DefaultFun a
beforeAST, Term Name DefaultUni DefaultFun a
-> Either
     FreeVariableError (Term NamedDeBruijn DefaultUni DefaultFun a)
forall e (m :: * -> *) (uni :: * -> *) fun ann.
(AsFreeVariableError e, MonadError e m) =>
Term Name uni fun ann -> m (Term NamedDeBruijn uni fun ann)
UPLC.deBruijnTerm Term Name DefaultUni DefaultFun a
afterAST) of
        (Right Term NamedDeBruijn DefaultUni DefaultFun a
before', Right Term NamedDeBruijn DefaultUni DefaultFun a
after')             ->
          (SimplifierStage
stage, (Term NamedDeBruijn DefaultUni DefaultFun () -> UTerm
forall a. Term NamedDeBruijn DefaultUni DefaultFun a -> UTerm
FFI.conv (Term NamedDeBruijn DefaultUni DefaultFun a
-> Term NamedDeBruijn DefaultUni DefaultFun ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Term NamedDeBruijn DefaultUni DefaultFun a
before'), Term NamedDeBruijn DefaultUni DefaultFun () -> UTerm
forall a. Term NamedDeBruijn DefaultUni DefaultFun a -> UTerm
FFI.conv (Term NamedDeBruijn DefaultUni DefaultFun a
-> Term NamedDeBruijn DefaultUni DefaultFun ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Term NamedDeBruijn DefaultUni DefaultFun a
after')))
        (Left (FreeVariableError
err :: UPLC.FreeVariableError), Either
  FreeVariableError (Term NamedDeBruijn DefaultUni DefaultFun a)
_) -> [Char] -> (SimplifierStage, (UTerm, UTerm))
forall a. HasCallStack => [Char] -> a
error ([Char] -> (SimplifierStage, (UTerm, UTerm)))
-> [Char] -> (SimplifierStage, (UTerm, UTerm))
forall a b. (a -> b) -> a -> b
$ FreeVariableError -> [Char]
forall a. Show a => a -> [Char]
show FreeVariableError
err
        (Either
  FreeVariableError (Term NamedDeBruijn DefaultUni DefaultFun a)
_, Left (FreeVariableError
err :: UPLC.FreeVariableError)) -> [Char] -> (SimplifierStage, (UTerm, UTerm))
forall a. HasCallStack => [Char] -> a
error ([Char] -> (SimplifierStage, (UTerm, UTerm)))
-> [Char] -> (SimplifierStage, (UTerm, UTerm))
forall a b. (a -> b) -> a -> b
$ FreeVariableError -> [Char]
forall a. Show a => a -> [Char]
show FreeVariableError
err