Iso.hs

-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Isomorphisms in Lorentz.
module Lorentz.Iso
  ( LIso (..)
  , invertIso
  , involutedIso
  , checkedCoerceIso
  , forcedCoerceIso
  , namedIso
  , nonIso
  , nonDefIso
  ) where

import Lorentz.Base
import Lorentz.Coercions
import Lorentz.Constraints
import Lorentz.Default
import Lorentz.Instr
import Lorentz.Macro
import Morley.Util.Label
import Morley.Util.Named

-- | Lorentz version of "Control.Lens.Iso".
data LIso a b = LIso
  { liTo :: forall s. a : s :-> b : s
  , liFrom :: forall s. b : s :-> a : s
  }

-- | Invert an isomorphism.
invertIso :: LIso a b -> LIso b a
invertIso LIso{..} = LIso{ liTo = liFrom, liFrom = liTo }

-- | Given a function that is its own inverse, make an 'LIso' using it
-- in both directions.
involutedIso :: Fn a a -> LIso a a
involutedIso l = LIso (framed l) (framed l)

-- | The isomorphism between two values with identical representation
-- and semantics.
checkedCoerceIso :: Coercible_ a b => LIso a b
checkedCoerceIso = LIso checkedCoerce_ checkedCoerce_

-- | The isomorphism between two values with identical representation.
--
-- The same precautions as for 'forcedCoerce' apply here.
forcedCoerceIso :: MichelsonCoercible a b => LIso a b
forcedCoerceIso = LIso forcedCoerce_ forcedCoerce_

-- | The isomorphism between raw and named value.
namedIso :: Label n -> LIso a (n :! a)
namedIso l = LIso (toNamed l) (fromNamed l)

-- | Absence of value on the left hand side is associated with
-- the given value on the right hand side.
nonIso :: (NiceConstant a, NiceComparable a) => a -> LIso (Maybe a) a
nonIso defVal = LIso (fromOption defVal) (non defVal)

-- | Absence of value on the left hand side is associated with
-- the default value on the right hand side.
--
-- This is more general version of @nonIso ldef@ since it can
-- work with e.g. containers.
nonDefIso :: (LDefault a, NiceConstant a) => LIso (Maybe a) a
nonDefIso = LIso (fromOption ldef) (non' lIsDef)