{-# LANGUAGE LambdaCase #-}
{-|
A trivial simplification that cancels unwrap/wrap pairs.

This can only occur if we've inlined both datatype constructors and destructors
and we're deconstructing something we just constructed. This is probably rare,
and should anyway better be handled by something like case-of-known constructor.
But it's so simple we might as well include it just in case.
-}
module PlutusIR.Transform.Unwrap (
  unwrapCancel
  ) where

import PlutusIR

import Control.Lens (transformOf)

{-|
A single non-recursive application of wrap/unwrap cancellation.
-}
unwrapCancelStep
    :: Term tyname name uni fun a
    -> Term tyname name uni fun a
unwrapCancelStep :: Term tyname name uni fun a -> Term tyname name uni fun a
unwrapCancelStep = \case
    Unwrap a
_ (IWrap a
_ Type tyname uni a
_ Type tyname uni a
_ Term tyname name uni fun a
b) -> Term tyname name uni fun a
b
    Term tyname name uni fun a
t                        -> Term tyname name uni fun a
t

{-|
Recursively apply wrap/unwrap cancellation.
-}
unwrapCancel
    :: Term tyname name uni fun a
    -> Term tyname name uni fun a
unwrapCancel :: Term tyname name uni fun a -> Term tyname name uni fun a
unwrapCancel = ASetter
  (Term tyname name uni fun a)
  (Term tyname name uni fun a)
  (Term tyname name uni fun a)
  (Term tyname name uni fun a)
-> (Term tyname name uni fun a -> Term tyname name uni fun a)
-> Term tyname name uni fun a
-> Term tyname name uni fun a
forall a b. ASetter a b a b -> (b -> b) -> a -> b
transformOf ASetter
  (Term tyname name uni fun a)
  (Term tyname name uni fun a)
  (Term tyname name uni fun a)
  (Term tyname name uni fun a)
forall tyname name (uni :: * -> *) fun a.
Traversal'
  (Term tyname name uni fun a) (Term tyname name uni fun a)
termSubterms Term tyname name uni fun a -> Term tyname name uni fun a
forall tyname name (uni :: * -> *) fun a.
Term tyname name uni fun a -> Term tyname name uni fun a
unwrapCancelStep