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

-- | Michelson contract in untyped model.

module Morley.Michelson.Untyped.Contract
  ( EntriesOrder (..)
  , canonicalEntriesOrder
  , entriesOrderToInt
  , mapEntriesOrdered

  , ContractBlock (..)
  , orderContractBlock

  , Contract' (..)
  , View' (..)
  , Storage
  , mapContractCode
  ) where

import Data.Aeson.TH (deriveJSON)
import Data.Data (Data(..))
import Data.Default (Default(..))
import Fmt (Buildable(build))
import Text.PrettyPrint.Leijen.Text (indent, nest, semi, text, (<$$>), (<+>))

import Morley.Michelson.Printer.Util
  (Prettier(..), RenderDoc(..), assertParensNotNeeded, buildRenderDoc, needsParens, renderOpsList)
import Morley.Michelson.Untyped.Type (ParameterType(..), Ty(..))
import Morley.Michelson.Untyped.View
import Morley.Util.Aeson

-- TODO [#698]: views are yet handled in a very hacky and not fully working way

-- | Top-level entries order of the contract.
-- This is preserved due to the fact that it affects
-- the output of pretty-printing and serializing contract.

-- Each constructors is created by the order of the first letter of
-- @parameter@, @storage@, and @code@.
--
-- For example, @PSC@ would be @parameter@, @storage@ and @code@,
-- @CPS@ would be @code@, @parameter@,and @storage@, and so on.
data EntriesOrder
  = PSC
  | PCS
  | SPC
  | SCP
  | CSP
  | CPS
  deriving stock (EntriesOrder
EntriesOrder -> EntriesOrder -> Bounded EntriesOrder
forall a. a -> a -> Bounded a
maxBound :: EntriesOrder
$cmaxBound :: EntriesOrder
minBound :: EntriesOrder
$cminBound :: EntriesOrder
Bounded, Typeable EntriesOrder
Typeable EntriesOrder
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> EntriesOrder -> c EntriesOrder)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c EntriesOrder)
-> (EntriesOrder -> Constr)
-> (EntriesOrder -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c EntriesOrder))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c EntriesOrder))
-> ((forall b. Data b => b -> b) -> EntriesOrder -> EntriesOrder)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> EntriesOrder -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> EntriesOrder -> r)
-> (forall u. (forall d. Data d => d -> u) -> EntriesOrder -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> EntriesOrder -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> EntriesOrder -> m EntriesOrder)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EntriesOrder -> m EntriesOrder)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EntriesOrder -> m EntriesOrder)
-> Data EntriesOrder
EntriesOrder -> DataType
EntriesOrder -> Constr
(forall b. Data b => b -> b) -> EntriesOrder -> EntriesOrder
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> EntriesOrder -> u
forall u. (forall d. Data d => d -> u) -> EntriesOrder -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EntriesOrder -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EntriesOrder -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EntriesOrder -> m EntriesOrder
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EntriesOrder -> m EntriesOrder
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EntriesOrder
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EntriesOrder -> c EntriesOrder
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EntriesOrder)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EntriesOrder)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EntriesOrder -> m EntriesOrder
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EntriesOrder -> m EntriesOrder
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EntriesOrder -> m EntriesOrder
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EntriesOrder -> m EntriesOrder
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EntriesOrder -> m EntriesOrder
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EntriesOrder -> m EntriesOrder
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EntriesOrder -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EntriesOrder -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> EntriesOrder -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EntriesOrder -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EntriesOrder -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EntriesOrder -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EntriesOrder -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EntriesOrder -> r
gmapT :: (forall b. Data b => b -> b) -> EntriesOrder -> EntriesOrder
$cgmapT :: (forall b. Data b => b -> b) -> EntriesOrder -> EntriesOrder
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EntriesOrder)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EntriesOrder)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EntriesOrder)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EntriesOrder)
dataTypeOf :: EntriesOrder -> DataType
$cdataTypeOf :: EntriesOrder -> DataType
toConstr :: EntriesOrder -> Constr
$ctoConstr :: EntriesOrder -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EntriesOrder
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EntriesOrder
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EntriesOrder -> c EntriesOrder
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EntriesOrder -> c EntriesOrder
Data, Int -> EntriesOrder
EntriesOrder -> Int
EntriesOrder -> [EntriesOrder]
EntriesOrder -> EntriesOrder
EntriesOrder -> EntriesOrder -> [EntriesOrder]
EntriesOrder -> EntriesOrder -> EntriesOrder -> [EntriesOrder]
(EntriesOrder -> EntriesOrder)
-> (EntriesOrder -> EntriesOrder)
-> (Int -> EntriesOrder)
-> (EntriesOrder -> Int)
-> (EntriesOrder -> [EntriesOrder])
-> (EntriesOrder -> EntriesOrder -> [EntriesOrder])
-> (EntriesOrder -> EntriesOrder -> [EntriesOrder])
-> (EntriesOrder -> EntriesOrder -> EntriesOrder -> [EntriesOrder])
-> Enum EntriesOrder
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EntriesOrder -> EntriesOrder -> EntriesOrder -> [EntriesOrder]
$cenumFromThenTo :: EntriesOrder -> EntriesOrder -> EntriesOrder -> [EntriesOrder]
enumFromTo :: EntriesOrder -> EntriesOrder -> [EntriesOrder]
$cenumFromTo :: EntriesOrder -> EntriesOrder -> [EntriesOrder]
enumFromThen :: EntriesOrder -> EntriesOrder -> [EntriesOrder]
$cenumFromThen :: EntriesOrder -> EntriesOrder -> [EntriesOrder]
enumFrom :: EntriesOrder -> [EntriesOrder]
$cenumFrom :: EntriesOrder -> [EntriesOrder]
fromEnum :: EntriesOrder -> Int
$cfromEnum :: EntriesOrder -> Int
toEnum :: Int -> EntriesOrder
$ctoEnum :: Int -> EntriesOrder
pred :: EntriesOrder -> EntriesOrder
$cpred :: EntriesOrder -> EntriesOrder
succ :: EntriesOrder -> EntriesOrder
$csucc :: EntriesOrder -> EntriesOrder
Enum, EntriesOrder -> EntriesOrder -> Bool
(EntriesOrder -> EntriesOrder -> Bool)
-> (EntriesOrder -> EntriesOrder -> Bool) -> Eq EntriesOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntriesOrder -> EntriesOrder -> Bool
$c/= :: EntriesOrder -> EntriesOrder -> Bool
== :: EntriesOrder -> EntriesOrder -> Bool
$c== :: EntriesOrder -> EntriesOrder -> Bool
Eq, (forall x. EntriesOrder -> Rep EntriesOrder x)
-> (forall x. Rep EntriesOrder x -> EntriesOrder)
-> Generic EntriesOrder
forall x. Rep EntriesOrder x -> EntriesOrder
forall x. EntriesOrder -> Rep EntriesOrder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EntriesOrder x -> EntriesOrder
$cfrom :: forall x. EntriesOrder -> Rep EntriesOrder x
Generic, Int -> EntriesOrder -> ShowS
[EntriesOrder] -> ShowS
EntriesOrder -> [Char]
(Int -> EntriesOrder -> ShowS)
-> (EntriesOrder -> [Char])
-> ([EntriesOrder] -> ShowS)
-> Show EntriesOrder
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [EntriesOrder] -> ShowS
$cshowList :: [EntriesOrder] -> ShowS
show :: EntriesOrder -> [Char]
$cshow :: EntriesOrder -> [Char]
showsPrec :: Int -> EntriesOrder -> ShowS
$cshowsPrec :: Int -> EntriesOrder -> ShowS
Show)

instance Default EntriesOrder where
  def :: EntriesOrder
def = EntriesOrder
canonicalEntriesOrder
instance NFData EntriesOrder

-- | The canonical entries order which is ordered as follow:
-- @parameter@, @storage@, and @code@.
canonicalEntriesOrder :: EntriesOrder
canonicalEntriesOrder :: EntriesOrder
canonicalEntriesOrder = EntriesOrder
PSC

-- | @(Int, Int, Int)@ is the positions of @parameter@, @storage@, and @code@
-- respectively.
entriesOrderToInt :: EntriesOrder -> (Int, Int, Int)
entriesOrderToInt :: EntriesOrder -> (Int, Int, Int)
entriesOrderToInt = \case
  EntriesOrder
PSC -> (Int
0, Int
1, Int
2)
  EntriesOrder
PCS -> (Int
0, Int
2, Int
1)
  EntriesOrder
SPC -> (Int
1, Int
0, Int
2)
  EntriesOrder
SCP -> (Int
1, Int
2, Int
0)
  EntriesOrder
CSP -> (Int
2, Int
1, Int
0)
  EntriesOrder
CPS -> (Int
2, Int
0, Int
1)

-- | Contract block, convenient when parsing
data ContractBlock op
  = CBParam ParameterType
  | CBStorage Ty
  | CBCode [op]
  | CBView (View' op)
  deriving stock (ContractBlock op -> ContractBlock op -> Bool
(ContractBlock op -> ContractBlock op -> Bool)
-> (ContractBlock op -> ContractBlock op -> Bool)
-> Eq (ContractBlock op)
forall op. Eq op => ContractBlock op -> ContractBlock op -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContractBlock op -> ContractBlock op -> Bool
$c/= :: forall op. Eq op => ContractBlock op -> ContractBlock op -> Bool
== :: ContractBlock op -> ContractBlock op -> Bool
$c== :: forall op. Eq op => ContractBlock op -> ContractBlock op -> Bool
Eq, Int -> ContractBlock op -> ShowS
[ContractBlock op] -> ShowS
ContractBlock op -> [Char]
(Int -> ContractBlock op -> ShowS)
-> (ContractBlock op -> [Char])
-> ([ContractBlock op] -> ShowS)
-> Show (ContractBlock op)
forall op. Show op => Int -> ContractBlock op -> ShowS
forall op. Show op => [ContractBlock op] -> ShowS
forall op. Show op => ContractBlock op -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ContractBlock op] -> ShowS
$cshowList :: forall op. Show op => [ContractBlock op] -> ShowS
show :: ContractBlock op -> [Char]
$cshow :: forall op. Show op => ContractBlock op -> [Char]
showsPrec :: Int -> ContractBlock op -> ShowS
$cshowsPrec :: forall op. Show op => Int -> ContractBlock op -> ShowS
Show, (forall a b. (a -> b) -> ContractBlock a -> ContractBlock b)
-> (forall a b. a -> ContractBlock b -> ContractBlock a)
-> Functor ContractBlock
forall a b. a -> ContractBlock b -> ContractBlock a
forall a b. (a -> b) -> ContractBlock a -> ContractBlock b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ContractBlock b -> ContractBlock a
$c<$ :: forall a b. a -> ContractBlock b -> ContractBlock a
fmap :: forall a b. (a -> b) -> ContractBlock a -> ContractBlock b
$cfmap :: forall a b. (a -> b) -> ContractBlock a -> ContractBlock b
Functor)

-- | Construct a contract representation from the contract blocks (i.e. parameters,
-- storage, code blocks, etc.) in arbitrary order.
-- This makes sure that unique blocks like @code@ do not duplicate, and saves the
-- order in the contract so that it can print the contract blocks in the same
-- order it was parsed. TODO [#698]: this is not fully true now.
orderContractBlock :: [ContractBlock op] -> Maybe (Contract' op)
orderContractBlock :: forall op. [ContractBlock op] -> Maybe (Contract' op)
orderContractBlock [ContractBlock op]
blocks =
  let
    vs :: [View' op]
vs = (ContractBlock op -> Maybe (View' op))
-> [ContractBlock op] -> [View' op]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\case CBView View' op
v -> View' op -> Maybe (View' op)
forall a. a -> Maybe a
Just View' op
v; ContractBlock op
_ -> Maybe (View' op)
forall a. Maybe a
Nothing) [ContractBlock op]
blocks
    plain :: [ContractBlock op]
plain = (ContractBlock op -> Bool)
-> [ContractBlock op] -> [ContractBlock op]
forall a. (a -> Bool) -> [a] -> [a]
filter (\case CBView{} -> Bool
False; ContractBlock op
_ -> Bool
True) [ContractBlock op]
blocks
  in case [ContractBlock op]
plain of
  [CBParam   ParameterType
p, CBStorage Storage
s, CBCode    [op]
c] -> Contract' op -> Maybe (Contract' op)
forall a. a -> Maybe a
Just (Contract' op -> Maybe (Contract' op))
-> Contract' op -> Maybe (Contract' op)
forall a b. (a -> b) -> a -> b
$ ParameterType
-> Storage -> [op] -> EntriesOrder -> [View' op] -> Contract' op
forall op.
ParameterType
-> Storage -> [op] -> EntriesOrder -> [View' op] -> Contract' op
Contract ParameterType
p Storage
s [op]
c EntriesOrder
PSC [View' op]
vs
  [CBParam   ParameterType
p, CBCode    [op]
c, CBStorage Storage
s] -> Contract' op -> Maybe (Contract' op)
forall a. a -> Maybe a
Just (Contract' op -> Maybe (Contract' op))
-> Contract' op -> Maybe (Contract' op)
forall a b. (a -> b) -> a -> b
$ ParameterType
-> Storage -> [op] -> EntriesOrder -> [View' op] -> Contract' op
forall op.
ParameterType
-> Storage -> [op] -> EntriesOrder -> [View' op] -> Contract' op
Contract ParameterType
p Storage
s [op]
c EntriesOrder
PCS [View' op]
vs
  [CBStorage Storage
s, CBParam   ParameterType
p, CBCode    [op]
c] -> Contract' op -> Maybe (Contract' op)
forall a. a -> Maybe a
Just (Contract' op -> Maybe (Contract' op))
-> Contract' op -> Maybe (Contract' op)
forall a b. (a -> b) -> a -> b
$ ParameterType
-> Storage -> [op] -> EntriesOrder -> [View' op] -> Contract' op
forall op.
ParameterType
-> Storage -> [op] -> EntriesOrder -> [View' op] -> Contract' op
Contract ParameterType
p Storage
s [op]
c EntriesOrder
SPC [View' op]
vs
  [CBStorage Storage
s, CBCode    [op]
c, CBParam   ParameterType
p] -> Contract' op -> Maybe (Contract' op)
forall a. a -> Maybe a
Just (Contract' op -> Maybe (Contract' op))
-> Contract' op -> Maybe (Contract' op)
forall a b. (a -> b) -> a -> b
$ ParameterType
-> Storage -> [op] -> EntriesOrder -> [View' op] -> Contract' op
forall op.
ParameterType
-> Storage -> [op] -> EntriesOrder -> [View' op] -> Contract' op
Contract ParameterType
p Storage
s [op]
c EntriesOrder
SCP [View' op]
vs
  [CBCode    [op]
c, CBStorage Storage
s, CBParam   ParameterType
p] -> Contract' op -> Maybe (Contract' op)
forall a. a -> Maybe a
Just (Contract' op -> Maybe (Contract' op))
-> Contract' op -> Maybe (Contract' op)
forall a b. (a -> b) -> a -> b
$ ParameterType
-> Storage -> [op] -> EntriesOrder -> [View' op] -> Contract' op
forall op.
ParameterType
-> Storage -> [op] -> EntriesOrder -> [View' op] -> Contract' op
Contract ParameterType
p Storage
s [op]
c EntriesOrder
CSP [View' op]
vs
  [CBCode    [op]
c, CBParam   ParameterType
p, CBStorage Storage
s] -> Contract' op -> Maybe (Contract' op)
forall a. a -> Maybe a
Just (Contract' op -> Maybe (Contract' op))
-> Contract' op -> Maybe (Contract' op)
forall a b. (a -> b) -> a -> b
$ ParameterType
-> Storage -> [op] -> EntriesOrder -> [View' op] -> Contract' op
forall op.
ParameterType
-> Storage -> [op] -> EntriesOrder -> [View' op] -> Contract' op
Contract ParameterType
p Storage
s [op]
c EntriesOrder
CPS [View' op]
vs
  [ContractBlock op]
_                                       -> Maybe (Contract' op)
forall a. Maybe a
Nothing

instance Buildable (ContractBlock op) where
  build :: ContractBlock op -> Builder
build (CBParam{}) = Builder
"parameter"
  build (CBStorage{}) = Builder
"storage"
  build (CBCode{}) = Builder
"code"
  build (CBView{}) = Builder
"view"

-- | Map each contract fields by the given function and sort the output
-- based on the 'EntriesOrder'.
mapEntriesOrdered
  :: Contract' op
  -> (ParameterType -> a)
  -> (Storage -> a)
  -> ([op] -> a)
  -> (View' op -> a)
  -> [a]
mapEntriesOrdered :: forall op a.
Contract' op
-> (ParameterType -> a)
-> (Storage -> a)
-> ([op] -> a)
-> (View' op -> a)
-> [a]
mapEntriesOrdered Contract{[op]
[View' op]
ParameterType
Storage
EntriesOrder
contractViews :: forall op. Contract' op -> [View' op]
entriesOrder :: forall op. Contract' op -> EntriesOrder
contractCode :: forall op. Contract' op -> [op]
contractStorage :: forall op. Contract' op -> Storage
contractParameter :: forall op. Contract' op -> ParameterType
contractViews :: [View' op]
entriesOrder :: EntriesOrder
contractCode :: [op]
contractStorage :: Storage
contractParameter :: ParameterType
..} ParameterType -> a
fParam Storage -> a
fStorage [op] -> a
fCode View' op -> a
fView =
  [[a]] -> [a]
forall a. Monoid a => [a] -> a
mconcat
    [ ((Int, a) -> a) -> [(Int, a)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, a) -> a
forall a b. (a, b) -> b
snd ([(Int, a)] -> [a]) -> [(Int, a)] -> [a]
forall a b. (a -> b) -> a -> b
$ ((Int, a) -> Int) -> [(Int, a)] -> [(Int, a)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith (Int, a) -> Int
forall a b. (a, b) -> a
fst
        [ (Int
paramPos, ParameterType -> a
fParam ParameterType
contractParameter)
        , (Int
storagePos, Storage -> a
fStorage Storage
contractStorage)
        , (Int
codePos, [op] -> a
fCode [op]
contractCode)
        ]
    , (View' op -> a) -> [View' op] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap View' op -> a
fView [View' op]
contractViews
    ]
  where
    (Int
paramPos, Int
storagePos, Int
codePos) = EntriesOrder -> (Int, Int, Int)
entriesOrderToInt EntriesOrder
entriesOrder

-- | Convenience synonym for 'Ty' representing the storage type
type Storage = Ty

-- | General untyped contract representation.
data Contract' op = Contract
  { forall op. Contract' op -> ParameterType
contractParameter :: ParameterType
    -- ^ Contract parameter type
  , forall op. Contract' op -> Storage
contractStorage :: Storage
    -- ^ Contract storage type
  , forall op. Contract' op -> [op]
contractCode :: [op]
    -- ^ Contract code as a list of operations
  , forall op. Contract' op -> EntriesOrder
entriesOrder :: EntriesOrder
    -- ^ Original order of contract blocks, so that we can print them
    -- in the same order they were read
  , forall op. Contract' op -> [View' op]
contractViews :: [View' op]
    -- ^ Contract views
  } deriving stock (Contract' op -> Contract' op -> Bool
(Contract' op -> Contract' op -> Bool)
-> (Contract' op -> Contract' op -> Bool) -> Eq (Contract' op)
forall op. Eq op => Contract' op -> Contract' op -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Contract' op -> Contract' op -> Bool
$c/= :: forall op. Eq op => Contract' op -> Contract' op -> Bool
== :: Contract' op -> Contract' op -> Bool
$c== :: forall op. Eq op => Contract' op -> Contract' op -> Bool
Eq, Int -> Contract' op -> ShowS
[Contract' op] -> ShowS
Contract' op -> [Char]
(Int -> Contract' op -> ShowS)
-> (Contract' op -> [Char])
-> ([Contract' op] -> ShowS)
-> Show (Contract' op)
forall op. Show op => Int -> Contract' op -> ShowS
forall op. Show op => [Contract' op] -> ShowS
forall op. Show op => Contract' op -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Contract' op] -> ShowS
$cshowList :: forall op. Show op => [Contract' op] -> ShowS
show :: Contract' op -> [Char]
$cshow :: forall op. Show op => Contract' op -> [Char]
showsPrec :: Int -> Contract' op -> ShowS
$cshowsPrec :: forall op. Show op => Int -> Contract' op -> ShowS
Show, (forall a b. (a -> b) -> Contract' a -> Contract' b)
-> (forall a b. a -> Contract' b -> Contract' a)
-> Functor Contract'
forall a b. a -> Contract' b -> Contract' a
forall a b. (a -> b) -> Contract' a -> Contract' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Contract' b -> Contract' a
$c<$ :: forall a b. a -> Contract' b -> Contract' a
fmap :: forall a b. (a -> b) -> Contract' a -> Contract' b
$cfmap :: forall a b. (a -> b) -> Contract' a -> Contract' b
Functor, Typeable (Contract' op)
Typeable (Contract' op)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Contract' op -> c (Contract' op))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Contract' op))
-> (Contract' op -> Constr)
-> (Contract' op -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Contract' op)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Contract' op)))
-> ((forall b. Data b => b -> b) -> Contract' op -> Contract' op)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Contract' op -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Contract' op -> r)
-> (forall u. (forall d. Data d => d -> u) -> Contract' op -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Contract' op -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Contract' op -> m (Contract' op))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Contract' op -> m (Contract' op))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Contract' op -> m (Contract' op))
-> Data (Contract' op)
Contract' op -> DataType
Contract' op -> Constr
(forall b. Data b => b -> b) -> Contract' op -> Contract' op
forall {op}. Data op => Typeable (Contract' op)
forall op. Data op => Contract' op -> DataType
forall op. Data op => Contract' op -> Constr
forall op.
Data op =>
(forall b. Data b => b -> b) -> Contract' op -> Contract' op
forall op u.
Data op =>
Int -> (forall d. Data d => d -> u) -> Contract' op -> u
forall op u.
Data op =>
(forall d. Data d => d -> u) -> Contract' op -> [u]
forall op r r'.
Data op =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Contract' op -> r
forall op r r'.
Data op =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Contract' op -> r
forall op (m :: * -> *).
(Data op, Monad m) =>
(forall d. Data d => d -> m d) -> Contract' op -> m (Contract' op)
forall op (m :: * -> *).
(Data op, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Contract' op -> m (Contract' op)
forall op (c :: * -> *).
Data op =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Contract' op)
forall op (c :: * -> *).
Data op =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Contract' op -> c (Contract' op)
forall op (t :: * -> *) (c :: * -> *).
(Data op, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Contract' op))
forall op (t :: * -> * -> *) (c :: * -> *).
(Data op, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Contract' op))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Contract' op -> u
forall u. (forall d. Data d => d -> u) -> Contract' op -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Contract' op -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Contract' op -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Contract' op -> m (Contract' op)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Contract' op -> m (Contract' op)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Contract' op)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Contract' op -> c (Contract' op)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Contract' op))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Contract' op))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Contract' op -> m (Contract' op)
$cgmapMo :: forall op (m :: * -> *).
(Data op, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Contract' op -> m (Contract' op)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Contract' op -> m (Contract' op)
$cgmapMp :: forall op (m :: * -> *).
(Data op, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Contract' op -> m (Contract' op)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Contract' op -> m (Contract' op)
$cgmapM :: forall op (m :: * -> *).
(Data op, Monad m) =>
(forall d. Data d => d -> m d) -> Contract' op -> m (Contract' op)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Contract' op -> u
$cgmapQi :: forall op u.
Data op =>
Int -> (forall d. Data d => d -> u) -> Contract' op -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Contract' op -> [u]
$cgmapQ :: forall op u.
Data op =>
(forall d. Data d => d -> u) -> Contract' op -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Contract' op -> r
$cgmapQr :: forall op r r'.
Data op =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Contract' op -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Contract' op -> r
$cgmapQl :: forall op r r'.
Data op =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Contract' op -> r
gmapT :: (forall b. Data b => b -> b) -> Contract' op -> Contract' op
$cgmapT :: forall op.
Data op =>
(forall b. Data b => b -> b) -> Contract' op -> Contract' op
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Contract' op))
$cdataCast2 :: forall op (t :: * -> * -> *) (c :: * -> *).
(Data op, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Contract' op))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Contract' op))
$cdataCast1 :: forall op (t :: * -> *) (c :: * -> *).
(Data op, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Contract' op))
dataTypeOf :: Contract' op -> DataType
$cdataTypeOf :: forall op. Data op => Contract' op -> DataType
toConstr :: Contract' op -> Constr
$ctoConstr :: forall op. Data op => Contract' op -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Contract' op)
$cgunfold :: forall op (c :: * -> *).
Data op =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Contract' op)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Contract' op -> c (Contract' op)
$cgfoldl :: forall op (c :: * -> *).
Data op =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Contract' op -> c (Contract' op)
Data, (forall x. Contract' op -> Rep (Contract' op) x)
-> (forall x. Rep (Contract' op) x -> Contract' op)
-> Generic (Contract' op)
forall x. Rep (Contract' op) x -> Contract' op
forall x. Contract' op -> Rep (Contract' op) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall op x. Rep (Contract' op) x -> Contract' op
forall op x. Contract' op -> Rep (Contract' op) x
$cto :: forall op x. Rep (Contract' op) x -> Contract' op
$cfrom :: forall op x. Contract' op -> Rep (Contract' op) x
Generic)

instance NFData op => NFData (Contract' op)

instance (RenderDoc op) => RenderDoc (Contract' op) where
  renderDoc :: RenderContext -> Contract' op -> Doc
renderDoc RenderContext
pn Contract' op
contract =
    RenderContext -> Doc -> Doc
forall a. RenderContext -> a -> a
assertParensNotNeeded RenderContext
pn
      (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ (Element [Doc] -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
foldr Element [Doc] -> Doc -> Doc
Doc -> Doc -> Doc
(<$$>) (Text -> Doc
text Text
"")
      ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Contract' op
-> (ParameterType -> Doc)
-> (Storage -> Doc)
-> ([op] -> Doc)
-> (View' op -> Doc)
-> [Doc]
forall op a.
Contract' op
-> (ParameterType -> a)
-> (Storage -> a)
-> ([op] -> a)
-> (View' op -> a)
-> [a]
mapEntriesOrdered Contract' op
contract
        (\ParameterType
parameter -> Doc
"parameter" Doc -> Doc -> Doc
<+> RenderContext -> Prettier ParameterType -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens (ParameterType -> Prettier ParameterType
forall a. a -> Prettier a
Prettier ParameterType
parameter) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi)
        (\Storage
storage -> Doc
"storage" Doc -> Doc -> Doc
<+> RenderContext -> Prettier Storage -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens (Storage -> Prettier Storage
forall a. a -> Prettier a
Prettier Storage
storage) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi)
        (\[op]
code -> Doc
"code" Doc -> Doc -> Doc
<+> Int -> Doc -> Doc
nest (Text -> Int
forall t. Container t => t -> Int
length (Text
"code {" :: Text)) (Bool -> [op] -> Doc
forall op. RenderDoc op => Bool -> [op] -> Doc
renderOpsList Bool
False [op]
code Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi))
        (\View{[op]
Storage
ViewName
viewCode :: forall op. View' op -> [op]
viewReturn :: forall op. View' op -> Storage
viewArgument :: forall op. View' op -> Storage
viewName :: forall op. View' op -> ViewName
viewCode :: [op]
viewReturn :: Storage
viewArgument :: Storage
viewName :: ViewName
..} -> Doc
"view" Doc -> Doc -> Doc
<+> ViewName -> Doc
renderViewName ViewName
viewName
           Doc -> Doc -> Doc
<+> RenderContext -> Storage -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens Storage
viewArgument
           Doc -> Doc -> Doc
<+> RenderContext -> Storage -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens Storage
viewReturn
           Doc -> Doc -> Doc
<$$> Int -> Doc -> Doc
indent Int
5  -- 5 is forced by Michelson
                 (Bool -> [op] -> Doc
forall op. RenderDoc op => Bool -> [op] -> Doc
renderOpsList Bool
False [op]
viewCode)
           Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
semi
          )

instance RenderDoc op => Buildable (Contract' op) where
  build :: Contract' op -> Builder
build = Contract' op -> Builder
forall a. RenderDoc a => a -> Builder
buildRenderDoc

-- | Map all the instructions appearing in the contract.
mapContractCode :: (op -> op) -> Contract' op -> Contract' op
mapContractCode :: forall op. (op -> op) -> Contract' op -> Contract' op
mapContractCode op -> op
f (Contract ParameterType
param Storage
st [op]
code EntriesOrder
o [View' op]
vs) =
  ParameterType
-> Storage -> [op] -> EntriesOrder -> [View' op] -> Contract' op
forall op.
ParameterType
-> Storage -> [op] -> EntriesOrder -> [View' op] -> Contract' op
Contract
    ParameterType
param
    Storage
st
    ([op]
code [op] -> (op -> op) -> [op]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> op -> op
f)
    EntriesOrder
o
    ([View' op]
vs [View' op] -> (View' op -> View' op) -> [View' op]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \View' op
v -> View' op
v{ viewCode :: [op]
viewCode = View' op -> [op]
forall op. View' op -> [op]
viewCode View' op
v [op] -> (op -> op) -> [op]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> op -> op
f })

deriveJSON morleyAesonOptions ''EntriesOrder
deriveJSON morleyAesonOptions ''Contract'