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

-- 'newtype Container' deriving produced some fake warnings
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Module, containing top-level entries of a Michelson contract.
module Morley.Michelson.Typed.Contract
  ( -- * Contract
    ContractInp1
  , ContractInp
  , ContractOut1
  , ContractOut
  , ContractCode' (..)
  , mkContractCode
  , Contract' (..)
  , IsNotInView
  , giveNotInView
  , defaultContract
  , mapContractCode
  , mapContractCodeBlock
  , mapContractViewBlocks
  , mapContractCodeM
  , mapContractCodeBlockM
  , mapContractViewBlocksM
  , mapEntriesOrdered
  ) where

import Data.Constraint (Dict(..))
import Data.Default (Default(..))
import Data.Map qualified as Map
import GHC.TypeLits (TypeError, pattern Text)
import Unsafe.Coerce (unsafeCoerce)

import Morley.Michelson.Typed.Annotation
import Morley.Michelson.Typed.Entrypoints
import Morley.Michelson.Typed.Scope
import Morley.Michelson.Typed.T (T(..))
import Morley.Michelson.Typed.View
import Morley.Michelson.Untyped.Contract (EntriesOrder)
import Morley.Michelson.Untyped.Contract qualified as U

type ContractInp1 param st = 'TPair param st
type ContractInp param st = '[ ContractInp1 param st ]

type ContractOut1 st = 'TPair ('TList 'TOperation) st
type ContractOut st = '[ ContractOut1 st ]

-- | A wrapper for contract code. The newtype is mostly there to avoid
-- accidentally passing code from inside @ContractCode@ into a view for example,
-- as semantics are slightly different.
newtype ContractCode' instr cp st =
  ContractCode { forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
ContractCode' instr cp st
-> instr (ContractInp cp st) (ContractOut st)
unContractCode :: instr (ContractInp cp st) (ContractOut st) }

deriving stock instance Show (instr (ContractInp cp st) (ContractOut st))
  => Show (ContractCode' instr cp st)

deriving stock instance Eq (instr (ContractInp cp st) (ContractOut st))
  => Eq (ContractCode' instr cp st)

deriving newtype instance NFData (instr (ContractInp cp st) (ContractOut st))
  => NFData (ContractCode' instr cp st)

-- | A helper to construct @ContractCode'@. This helper provides the constraint
-- that the contract code is not in a view.
mkContractCode
  :: (IsNotInView => instr (ContractInp cp st) (ContractOut st))
  -> ContractCode' instr cp st
mkContractCode :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
(IsNotInView => instr (ContractInp cp st) (ContractOut st))
-> ContractCode' instr cp st
mkContractCode IsNotInView => instr (ContractInp cp st) (ContractOut st)
x = instr (ContractInp cp st) (ContractOut st)
-> ContractCode' instr cp st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
instr (ContractInp cp st) (ContractOut st)
-> ContractCode' instr cp st
ContractCode (instr (ContractInp cp st) (ContractOut st)
 -> ContractCode' instr cp st)
-> instr (ContractInp cp st) (ContractOut st)
-> ContractCode' instr cp st
forall a b. (a -> b) -> a -> b
$ (IsNotInView => instr (ContractInp cp st) (ContractOut st))
-> instr (ContractInp cp st) (ContractOut st)
forall r. (IsNotInView => r) -> r
giveNotInView IsNotInView => instr (ContractInp cp st) (ContractOut st)
x

-- | Constraint ensuring the given code does not appear on the top level of a
-- view. Some Michelson instructions are forbidden on the top level of views,
-- but allowed in main contract code, and also inside lambdas in views. Hence,
-- this constraint can be provided by 'mkContractCode' or by @mkVLam@.
class IsNotInView

-- NB: This instance is a giant hack. It happens to work because explicit dicts
-- override other in-scope instances. The good news is, if this hack stops
-- working, we'll notice right away because morley will refuse to compile.
instance TypeError ('Text "Not allowed on the top level of a view") => IsNotInView

-- | An empty typeclass that has an in-scope instance that we @unsafeCoerce@
-- into 'IsNotInView' in 'giveNotInView'. Not intended to be exported.
--
-- Dicts of all empty classes are representationally equivalent, so this is
-- "safe" (as in we won't get segfaults).
class FakeClass
instance FakeClass
FakeClass

-- | Pull a constraint 'IsNotInView' out of thin air. Use this with caution,
-- as you could easily construct an invalid contract by using this directly.
giveNotInView :: (IsNotInView => r) -> r
giveNotInView :: forall r. (IsNotInView => r) -> r
giveNotInView = Dict IsNotInView -> (IsNotInView => r) -> r
forall (c :: Constraint) e r. HasDict c e => e -> (c => r) -> r
withDict (Dict FakeClass -> Dict IsNotInView
forall a b. a -> b
unsafeCoerce (Dict FakeClass
forall (a :: Constraint). a => Dict a
Dict :: Dict FakeClass) :: Dict IsNotInView)

-- | Typed contract and information about annotations
-- which is not present in the contract code.
data Contract' instr cp st = (ParameterScope cp, StorageScope st) => Contract
  { forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ContractCode' instr cp st
cCode         :: ContractCode' instr cp st
  , forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ParamNotes cp
cParamNotes   :: ParamNotes cp
  , forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> Notes st
cStoreNotes   :: Notes st
  , forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ViewsSet' instr st
cViews        :: ViewsSet' instr st
  , forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> EntriesOrder
cEntriesOrder :: EntriesOrder
  }

deriving stock instance
  (forall i o. Show (instr i o)) =>
  Show (Contract' instr cp st)

deriving stock instance
  (forall i o. Eq (instr i o)) =>
  Eq (Contract' instr cp st)

instance
  (forall i o. NFData (instr i o)) =>
  NFData (Contract' instr cp st) where
  rnf :: Contract' instr cp st -> ()
rnf (Contract ContractCode' instr cp st
a ParamNotes cp
b Notes st
c ViewsSet' instr st
d EntriesOrder
e) = (ContractCode' instr cp st, ParamNotes cp, Notes st,
 ViewsSet' instr st, EntriesOrder)
-> ()
forall a. NFData a => a -> ()
rnf (ContractCode' instr cp st
a, ParamNotes cp
b, Notes st
c, ViewsSet' instr st
d, EntriesOrder
e)

defaultContract
  :: (ParameterScope cp, StorageScope st)
  => (IsNotInView => instr (ContractInp cp st) (ContractOut st))
  -> Contract' instr cp st
defaultContract :: forall (cp :: T) (st :: T) (instr :: [T] -> [T] -> *).
(ParameterScope cp, StorageScope st) =>
(IsNotInView => instr (ContractInp cp st) (ContractOut st))
-> Contract' instr cp st
defaultContract IsNotInView => instr (ContractInp cp st) (ContractOut st)
code = Contract :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
(ParameterScope cp, StorageScope st) =>
ContractCode' instr cp st
-> ParamNotes cp
-> Notes st
-> ViewsSet' instr st
-> EntriesOrder
-> Contract' instr cp st
Contract
  { cCode :: ContractCode' instr cp st
cCode = (IsNotInView => instr (ContractInp cp st) (ContractOut st))
-> ContractCode' instr cp st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
(IsNotInView => instr (ContractInp cp st) (ContractOut st))
-> ContractCode' instr cp st
mkContractCode IsNotInView => instr (ContractInp cp st) (ContractOut st)
code
  , cParamNotes :: ParamNotes cp
cParamNotes = ParamNotes cp
forall (t :: T). SingI t => ParamNotes t
starParamNotes
  , cStoreNotes :: Notes st
cStoreNotes = Notes st
forall (t :: T). SingI t => Notes t
starNotes
  , cEntriesOrder :: EntriesOrder
cEntriesOrder = EntriesOrder
forall a. Default a => a
def
  , cViews :: ViewsSet' instr st
cViews = ViewsSet' instr st
forall a. Default a => a
def
  }

-- | Transform contract @code@ block.
--
-- To map e.g. views too, see 'mapContractCode'.
mapContractCodeBlock
  :: (instr (ContractInp cp st) (ContractOut st)
    -> instr (ContractInp cp st) (ContractOut st))
  -> Contract' instr cp st
  -> Contract' instr cp st
mapContractCodeBlock :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
(instr (ContractInp cp st) (ContractOut st)
 -> instr (ContractInp cp st) (ContractOut st))
-> Contract' instr cp st -> Contract' instr cp st
mapContractCodeBlock instr (ContractInp cp st) (ContractOut st)
-> instr (ContractInp cp st) (ContractOut st)
f = Identity (Contract' instr cp st) -> Contract' instr cp st
forall a. Identity a -> a
runIdentity (Identity (Contract' instr cp st) -> Contract' instr cp st)
-> (Contract' instr cp st -> Identity (Contract' instr cp st))
-> Contract' instr cp st
-> Contract' instr cp st
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (instr (ContractInp cp st) (ContractOut st)
 -> Identity (instr (ContractInp cp st) (ContractOut st)))
-> Contract' instr cp st -> Identity (Contract' instr cp st)
forall (m :: * -> *) (instr :: [T] -> [T] -> *) (cp :: T)
       (st :: T).
Monad m =>
(instr (ContractInp cp st) (ContractOut st)
 -> m (instr (ContractInp cp st) (ContractOut st)))
-> Contract' instr cp st -> m (Contract' instr cp st)
mapContractCodeBlockM (instr (ContractInp cp st) (ContractOut st)
-> Identity (instr (ContractInp cp st) (ContractOut st))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (instr (ContractInp cp st) (ContractOut st)
 -> Identity (instr (ContractInp cp st) (ContractOut st)))
-> (instr (ContractInp cp st) (ContractOut st)
    -> instr (ContractInp cp st) (ContractOut st))
-> instr (ContractInp cp st) (ContractOut st)
-> Identity (instr (ContractInp cp st) (ContractOut st))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. instr (ContractInp cp st) (ContractOut st)
-> instr (ContractInp cp st) (ContractOut st)
f)

-- | Transform contract @code@ block, monadic version.
--
-- To map e.g. views too, see 'mapContractCodeM'.
mapContractCodeBlockM
  :: Monad m
  => (instr (ContractInp cp st) (ContractOut st)
    -> m (instr (ContractInp cp st) (ContractOut st)))
  -> Contract' instr cp st
  -> m (Contract' instr cp st)
mapContractCodeBlockM :: forall (m :: * -> *) (instr :: [T] -> [T] -> *) (cp :: T)
       (st :: T).
Monad m =>
(instr (ContractInp cp st) (ContractOut st)
 -> m (instr (ContractInp cp st) (ContractOut st)))
-> Contract' instr cp st -> m (Contract' instr cp st)
mapContractCodeBlockM instr (ContractInp cp st) (ContractOut st)
-> m (instr (ContractInp cp st) (ContractOut st))
f Contract' instr cp st
contract = do
  ContractCode' instr cp st
code <- case Contract' instr cp st -> ContractCode' instr cp st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ContractCode' instr cp st
cCode Contract' instr cp st
contract of ContractCode instr (ContractInp cp st) (ContractOut st)
c -> instr (ContractInp cp st) (ContractOut st)
-> ContractCode' instr cp st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
instr (ContractInp cp st) (ContractOut st)
-> ContractCode' instr cp st
ContractCode (instr (ContractInp cp st) (ContractOut st)
 -> ContractCode' instr cp st)
-> m (instr (ContractInp cp st) (ContractOut st))
-> m (ContractCode' instr cp st)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> instr (ContractInp cp st) (ContractOut st)
-> m (instr (ContractInp cp st) (ContractOut st))
f instr (ContractInp cp st) (ContractOut st)
c
  pure Contract' instr cp st
contract { cCode :: ContractCode' instr cp st
cCode = ContractCode' instr cp st
code }

mapContractViewBlocks
  :: (forall arg ret. ViewCode' instr arg st ret -> ViewCode' instr arg st ret)
  -> Contract' instr cp st
  -> Contract' instr cp st
mapContractViewBlocks :: forall (instr :: [T] -> [T] -> *) (st :: T) (cp :: T).
(forall (arg :: T) (ret :: T).
 ViewCode' instr arg st ret -> ViewCode' instr arg st ret)
-> Contract' instr cp st -> Contract' instr cp st
mapContractViewBlocks forall (arg :: T) (ret :: T).
ViewCode' instr arg st ret -> ViewCode' instr arg st ret
f = Identity (Contract' instr cp st) -> Contract' instr cp st
forall a. Identity a -> a
runIdentity (Identity (Contract' instr cp st) -> Contract' instr cp st)
-> (Contract' instr cp st -> Identity (Contract' instr cp st))
-> Contract' instr cp st
-> Contract' instr cp st
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (arg :: T) (ret :: T).
 ViewCode' instr arg st ret
 -> Identity (ViewCode' instr arg st ret))
-> Contract' instr cp st -> Identity (Contract' instr cp st)
forall (m :: * -> *) (instr :: [T] -> [T] -> *) (st :: T)
       (cp :: T).
Monad m =>
(forall (arg :: T) (ret :: T).
 ViewCode' instr arg st ret -> m (ViewCode' instr arg st ret))
-> Contract' instr cp st -> m (Contract' instr cp st)
mapContractViewBlocksM (ViewCode' instr arg st ret -> Identity (ViewCode' instr arg st ret)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ViewCode' instr arg st ret
 -> Identity (ViewCode' instr arg st ret))
-> (ViewCode' instr arg st ret -> ViewCode' instr arg st ret)
-> ViewCode' instr arg st ret
-> Identity (ViewCode' instr arg st ret)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViewCode' instr arg st ret -> ViewCode' instr arg st ret
forall (arg :: T) (ret :: T).
ViewCode' instr arg st ret -> ViewCode' instr arg st ret
f)

mapContractViewBlocksM
  :: Monad m
  => (forall arg ret. ViewCode' instr arg st ret -> m (ViewCode' instr arg st ret))
  -> Contract' instr cp st
  -> m (Contract' instr cp st)
mapContractViewBlocksM :: forall (m :: * -> *) (instr :: [T] -> [T] -> *) (st :: T)
       (cp :: T).
Monad m =>
(forall (arg :: T) (ret :: T).
 ViewCode' instr arg st ret -> m (ViewCode' instr arg st ret))
-> Contract' instr cp st -> m (Contract' instr cp st)
mapContractViewBlocksM forall (arg :: T) (ret :: T).
ViewCode' instr arg st ret -> m (ViewCode' instr arg st ret)
f Contract' instr cp st
contract = do
  ViewsSet' instr st
views <- Map ViewName (SomeView' instr st) -> ViewsSet' instr st
forall (instr :: [T] -> [T] -> *) (st :: T).
Map ViewName (SomeView' instr st) -> ViewsSet' instr st
UnsafeViewsSet (Map ViewName (SomeView' instr st) -> ViewsSet' instr st)
-> m (Map ViewName (SomeView' instr st)) -> m (ViewsSet' instr st)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map ViewName (SomeView' instr st)
-> (SomeView' instr st -> m (SomeView' instr st))
-> m (Map ViewName (SomeView' instr st))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (ViewsSet' instr st -> Map ViewName (SomeView' instr st)
forall (instr :: [T] -> [T] -> *) (st :: T).
ViewsSet' instr st -> Map ViewName (SomeView' instr st)
unViewsSet (Contract' instr cp st -> ViewsSet' instr st
forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ViewsSet' instr st
cViews Contract' instr cp st
contract)) \(SomeView View' instr arg st ret
v) -> do
    ViewCode' instr arg st ret
code <- ViewCode' instr arg st ret -> m (ViewCode' instr arg st ret)
forall (arg :: T) (ret :: T).
ViewCode' instr arg st ret -> m (ViewCode' instr arg st ret)
f (ViewCode' instr arg st ret -> m (ViewCode' instr arg st ret))
-> ViewCode' instr arg st ret -> m (ViewCode' instr arg st ret)
forall a b. (a -> b) -> a -> b
$ View' instr arg st ret -> ViewCode' instr arg st ret
forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> ViewCode' instr arg st ret
vCode View' instr arg st ret
v
    pure $ View' instr arg st ret -> SomeView' instr st
forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> SomeView' instr st
SomeView View' instr arg st ret
v{ vCode :: ViewCode' instr arg st ret
vCode = ViewCode' instr arg st ret
code }
  pure Contract' instr cp st
contract{ cViews :: ViewsSet' instr st
cViews = ViewsSet' instr st
views }

-- | Map all the blocks with some code in the contract.
mapContractCode
  :: (forall i o. instr i o -> instr i o)
  -> Contract' instr cp st
  -> Contract' instr cp st
mapContractCode :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
(forall (i :: [T]) (o :: [T]). instr i o -> instr i o)
-> Contract' instr cp st -> Contract' instr cp st
mapContractCode forall (i :: [T]) (o :: [T]). instr i o -> instr i o
f = Identity (Contract' instr cp st) -> Contract' instr cp st
forall a. Identity a -> a
runIdentity (Identity (Contract' instr cp st) -> Contract' instr cp st)
-> (Contract' instr cp st -> Identity (Contract' instr cp st))
-> Contract' instr cp st
-> Contract' instr cp st
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (i :: [T]) (o :: [T]). instr i o -> Identity (instr i o))
-> Contract' instr cp st -> Identity (Contract' instr cp st)
forall (m :: * -> *) (instr :: [T] -> [T] -> *) (cp :: T)
       (st :: T).
Monad m =>
(forall (i :: [T]) (o :: [T]). instr i o -> m (instr i o))
-> Contract' instr cp st -> m (Contract' instr cp st)
mapContractCodeM (instr i o -> Identity (instr i o)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (instr i o -> Identity (instr i o))
-> (instr i o -> instr i o) -> instr i o -> Identity (instr i o)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. instr i o -> instr i o
forall (i :: [T]) (o :: [T]). instr i o -> instr i o
f)

-- | Map all the blocks with some code in the contract, monadic version.
mapContractCodeM
  :: Monad m
  => (forall i o. instr i o -> m (instr i o))
  -> Contract' instr cp st
  -> m (Contract' instr cp st)
mapContractCodeM :: forall (m :: * -> *) (instr :: [T] -> [T] -> *) (cp :: T)
       (st :: T).
Monad m =>
(forall (i :: [T]) (o :: [T]). instr i o -> m (instr i o))
-> Contract' instr cp st -> m (Contract' instr cp st)
mapContractCodeM forall (i :: [T]) (o :: [T]). instr i o -> m (instr i o)
f = (instr (ContractInp cp st) (ContractOut st)
 -> m (instr (ContractInp cp st) (ContractOut st)))
-> Contract' instr cp st -> m (Contract' instr cp st)
forall (m :: * -> *) (instr :: [T] -> [T] -> *) (cp :: T)
       (st :: T).
Monad m =>
(instr (ContractInp cp st) (ContractOut st)
 -> m (instr (ContractInp cp st) (ContractOut st)))
-> Contract' instr cp st -> m (Contract' instr cp st)
mapContractCodeBlockM instr (ContractInp cp st) (ContractOut st)
-> m (instr (ContractInp cp st) (ContractOut st))
forall (i :: [T]) (o :: [T]). instr i o -> m (instr i o)
f (Contract' instr cp st -> m (Contract' instr cp st))
-> (Contract' instr cp st -> m (Contract' instr cp st))
-> Contract' instr cp st
-> m (Contract' instr cp st)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (forall (arg :: T) (ret :: T).
 ViewCode' instr arg st ret -> m (ViewCode' instr arg st ret))
-> Contract' instr cp st -> m (Contract' instr cp st)
forall (m :: * -> *) (instr :: [T] -> [T] -> *) (st :: T)
       (cp :: T).
Monad m =>
(forall (arg :: T) (ret :: T).
 ViewCode' instr arg st ret -> m (ViewCode' instr arg st ret))
-> Contract' instr cp st -> m (Contract' instr cp st)
mapContractViewBlocksM forall (i :: [T]) (o :: [T]). instr i o -> m (instr i o)
forall (arg :: T) (ret :: T).
ViewCode' instr arg st ret -> m (ViewCode' instr arg st ret)
f

-- | Map each typed contract fields by the given function and sort the output
-- based on the 'EntriesOrder'.
mapEntriesOrdered
  :: Contract' instr cp st
  -> (ParamNotes cp -> a)
  -> (Notes st -> a)
  -> (ContractCode' instr cp st -> a)
  -> (forall arg ret. View' instr arg st ret -> a)
  -> [a]
mapEntriesOrdered :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T) a.
Contract' instr cp st
-> (ParamNotes cp -> a)
-> (Notes st -> a)
-> (ContractCode' instr cp st -> a)
-> (forall (arg :: T) (ret :: T). View' instr arg st ret -> a)
-> [a]
mapEntriesOrdered Contract{EntriesOrder
Notes st
ViewsSet' instr st
ParamNotes cp
ContractCode' instr cp st
cEntriesOrder :: EntriesOrder
cViews :: ViewsSet' instr st
cStoreNotes :: Notes st
cParamNotes :: ParamNotes cp
cCode :: ContractCode' instr cp st
cEntriesOrder :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> EntriesOrder
cViews :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ViewsSet' instr st
cStoreNotes :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> Notes st
cParamNotes :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ParamNotes cp
cCode :: forall (instr :: [T] -> [T] -> *) (cp :: T) (st :: T).
Contract' instr cp st -> ContractCode' instr cp st
..} ParamNotes cp -> a
fParam Notes st -> a
fStorage ContractCode' instr cp st -> a
fCode forall (arg :: T) (ret :: T). View' instr arg st ret -> a
fView = (Word, a) -> a
forall a b. (a, b) -> b
snd ((Word, a) -> a) -> [(Word, a)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Word, a) -> Word) -> [(Word, a)] -> [(Word, a)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith (Word, a) -> Word
forall a b. (a, b) -> a
fst [(Word, a)]
elements
  where
    getElemOrder :: Entry -> Word
getElemOrder Entry
ty = Word -> Maybe Word -> Word
forall a. a -> Maybe a -> a
fromMaybe Word
forall a. Bounded a => a
maxBound (Maybe Word -> Word) -> Maybe Word -> Word
forall a b. (a -> b) -> a -> b
$ Entry -> Map Entry Word -> Maybe Word
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Entry
ty (Map Entry Word -> Maybe Word) -> Map Entry Word -> Maybe Word
forall a b. (a -> b) -> a -> b
$ EntriesOrder -> Map Entry Word
U.unEntriesOrder EntriesOrder
cEntriesOrder
    elements :: [(Word, a)]
elements
      = (Entry -> Word) -> (Entry, a) -> (Word, a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Entry -> Word
getElemOrder
      ((Entry, a) -> (Word, a)) -> [(Entry, a)] -> [(Word, a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ (Entry
U.EntryParameter, ParamNotes cp -> a
fParam ParamNotes cp
cParamNotes)
          , (Entry
U.EntryStorage, Notes st -> a
fStorage Notes st
cStoreNotes)
          , (Entry
U.EntryCode, ContractCode' instr cp st -> a
fCode ContractCode' instr cp st
cCode)]
      [(Entry, a)] -> [(Entry, a)] -> [(Entry, a)]
forall a. Semigroup a => a -> a -> a
<>  (ViewsSet' instr st -> [Element (ViewsSet' instr st)]
forall t. Container t => t -> [Element t]
toList ViewsSet' instr st
cViews [SomeView' instr st]
-> (SomeView' instr st -> (Entry, a)) -> [(Entry, a)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(SomeView v :: View' instr arg st ret
v@View{ViewCode' instr arg st ret
ViewName
Notes arg
Notes ret
vReturn :: forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> Notes ret
vArgument :: forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> Notes arg
vName :: forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> ViewName
vCode :: ViewCode' instr arg st ret
vReturn :: Notes ret
vArgument :: Notes arg
vName :: ViewName
vCode :: forall (instr :: [T] -> [T] -> *) (arg :: T) (st :: T) (ret :: T).
View' instr arg st ret -> ViewCode' instr arg st ret
..}) -> (ViewName -> Entry
U.EntryView ViewName
vName, View' instr arg st ret -> a
forall (arg :: T) (ret :: T). View' instr arg st ret -> a
fView View' instr arg st ret
v))
{-# DEPRECATED mapEntriesOrdered "Unused and untested, essentially dead code; open an issue on the \
  \morley repository if you use this." #-}