-- | Identity transformations between different Haskell types.
module Lorentz.Coercions
  ( Coercible_
  , coerce_
  , gcoerce_
  , fakeCoerce

  , coerceUnwrap
  , coerceWrap
  , toNamed
  , fromNamed

    -- * Coercions for some basic types
  , futureContract
  , unFutureContract

    -- * Re-exports
  , Wrapped (..)
  ) where

import Control.Lens (Wrapped(..))
import Data.Vinyl.Derived (Label)
import Named (NamedF)

import Lorentz.Base
import Lorentz.Instr
import Lorentz.Value
import Michelson.Typed

-- | Whether two types have the same Michelson representation.
type Coercible_ a b = ToT a ~ ToT b

-- | Convert between values of types that have the same representation.
coerce_ :: Coercible_ a b => a & s :-> b & s
coerce_ = I Nop

gcoerce_ :: Coercible_ (t a) (t b) => t a : s :-> t b : s
gcoerce_ = coerce_

-- | Convert between two stacks via failing.
fakeCoerce :: s1 :-> s2
fakeCoerce = unit # I FAILWITH

-- | Specialized version of 'coerce_' to wrap into a haskell newtype.
coerceWrap
  :: Coercible_ newtyp (Unwrapped newtyp)
  => Unwrapped newtyp : s :-> newtyp : s
coerceWrap = coerce_

-- | Specialized version of 'coerce_' to unwrap a haskell newtype.
coerceUnwrap
  :: Coercible_ newtyp (Unwrapped newtyp)
  => newtyp : s :-> Unwrapped newtyp : s
coerceUnwrap = coerce_

-- | Lift given value to a named value.
toNamed :: Label name -> a : s :-> NamedF Identity a name : s
toNamed _ = coerceWrap

-- | Unpack named value.
fromNamed :: Label name -> NamedF Identity a name : s :-> a : s
fromNamed _ = coerceUnwrap

----------------------------------------------------------------------------
-- Coercions for some basic types
----------------------------------------------------------------------------

-- | Make up a 'FutureContract'.
futureContract :: Address : s :-> FutureContract p : s
futureContract = coerce_

-- | Get address referred by 'FutureContract'.
unFutureContract :: FutureContract p : s :-> Address : s
unFutureContract = coerce_