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

-- | Michelson contract in untyped model.

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

  , ContractBlock (..)
  , orderContractBlock

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

import Control.Lens (folded, makePrisms)
import Data.Aeson (FromJSON, FromJSONKey(..), ToJSON, ToJSONKey(..))
import Data.Aeson.TH (deriveJSON)
import Data.Aeson.Types qualified as AesonTypes
import Data.Data (Data(..))
import Data.Default (Default(..))
import Data.Map qualified as Map
import Data.Text (stripPrefix)
import Fmt (Buildable(build), pretty)
import Text.PrettyPrint.Leijen.Text (nest, semi, text, (<$$>), (<+>))
import Text.PrettyPrint.Leijen.Text qualified as PP

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

data Entry
  = EntryParameter
  | EntryStorage
  | EntryCode
  | EntryView ViewName
  deriving stock (Entry -> Entry -> Bool
(Entry -> Entry -> Bool) -> (Entry -> Entry -> Bool) -> Eq Entry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Entry -> Entry -> Bool
$c/= :: Entry -> Entry -> Bool
== :: Entry -> Entry -> Bool
$c== :: Entry -> Entry -> Bool
Eq, Eq Entry
Eq Entry
-> (Entry -> Entry -> Ordering)
-> (Entry -> Entry -> Bool)
-> (Entry -> Entry -> Bool)
-> (Entry -> Entry -> Bool)
-> (Entry -> Entry -> Bool)
-> (Entry -> Entry -> Entry)
-> (Entry -> Entry -> Entry)
-> Ord Entry
Entry -> Entry -> Bool
Entry -> Entry -> Ordering
Entry -> Entry -> Entry
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Entry -> Entry -> Entry
$cmin :: Entry -> Entry -> Entry
max :: Entry -> Entry -> Entry
$cmax :: Entry -> Entry -> Entry
>= :: Entry -> Entry -> Bool
$c>= :: Entry -> Entry -> Bool
> :: Entry -> Entry -> Bool
$c> :: Entry -> Entry -> Bool
<= :: Entry -> Entry -> Bool
$c<= :: Entry -> Entry -> Bool
< :: Entry -> Entry -> Bool
$c< :: Entry -> Entry -> Bool
compare :: Entry -> Entry -> Ordering
$ccompare :: Entry -> Entry -> Ordering
Ord, Int -> Entry -> ShowS
[Entry] -> ShowS
Entry -> String
(Int -> Entry -> ShowS)
-> (Entry -> String) -> ([Entry] -> ShowS) -> Show Entry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Entry] -> ShowS
$cshowList :: [Entry] -> ShowS
show :: Entry -> String
$cshow :: Entry -> String
showsPrec :: Int -> Entry -> ShowS
$cshowsPrec :: Int -> Entry -> ShowS
Show, Typeable Entry
Typeable Entry
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Entry -> c Entry)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Entry)
-> (Entry -> Constr)
-> (Entry -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Entry))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Entry))
-> ((forall b. Data b => b -> b) -> Entry -> Entry)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Entry -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Entry -> r)
-> (forall u. (forall d. Data d => d -> u) -> Entry -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Entry -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Entry -> m Entry)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Entry -> m Entry)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Entry -> m Entry)
-> Data Entry
Entry -> DataType
Entry -> Constr
(forall b. Data b => b -> b) -> Entry -> Entry
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) -> Entry -> u
forall u. (forall d. Data d => d -> u) -> Entry -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Entry -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Entry -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Entry -> m Entry
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Entry -> m Entry
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Entry
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entry -> c Entry
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Entry)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Entry)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Entry -> m Entry
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Entry -> m Entry
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Entry -> m Entry
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Entry -> m Entry
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Entry -> m Entry
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Entry -> m Entry
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Entry -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Entry -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Entry -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Entry -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Entry -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Entry -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Entry -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Entry -> r
gmapT :: (forall b. Data b => b -> b) -> Entry -> Entry
$cgmapT :: (forall b. Data b => b -> b) -> Entry -> Entry
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Entry)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Entry)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Entry)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Entry)
dataTypeOf :: Entry -> DataType
$cdataTypeOf :: Entry -> DataType
toConstr :: Entry -> Constr
$ctoConstr :: Entry -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Entry
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Entry
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entry -> c Entry
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entry -> c Entry
Data, (forall x. Entry -> Rep Entry x)
-> (forall x. Rep Entry x -> Entry) -> Generic Entry
forall x. Rep Entry x -> Entry
forall x. Entry -> Rep Entry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Entry x -> Entry
$cfrom :: forall x. Entry -> Rep Entry x
Generic)

deriveJSON morleyAesonOptions ''Entry

instance ToJSONKey Entry where
  toJSONKey :: ToJSONKeyFunction Entry
toJSONKey = (Entry -> Text) -> ToJSONKeyFunction Entry
forall a. (a -> Text) -> ToJSONKeyFunction a
AesonTypes.toJSONKeyText ((Entry -> Text) -> ToJSONKeyFunction Entry)
-> (Entry -> Text) -> ToJSONKeyFunction Entry
forall a b. (a -> b) -> a -> b
$ \case
    Entry
EntryParameter -> Text
"parameter"
    Entry
EntryStorage -> Text
"storage"
    Entry
EntryCode -> Text
"code"
    EntryView ViewName
name -> Text
"view:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ViewName -> Text
unViewName ViewName
name

instance FromJSONKey Entry where
  fromJSONKey :: FromJSONKeyFunction Entry
fromJSONKey = (Text -> Parser Entry) -> FromJSONKeyFunction Entry
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
AesonTypes.FromJSONKeyTextParser ((Text -> Parser Entry) -> FromJSONKeyFunction Entry)
-> (Text -> Parser Entry) -> FromJSONKeyFunction Entry
forall a b. (a -> b) -> a -> b
$ \case
    Text
"parameter" -> Entry -> Parser Entry
forall (f :: * -> *) a. Applicative f => a -> f a
pure Entry
EntryParameter
    Text
"storage" -> Entry -> Parser Entry
forall (f :: * -> *) a. Applicative f => a -> f a
pure Entry
EntryStorage
    Text
"code" -> Entry -> Parser Entry
forall (f :: * -> *) a. Applicative f => a -> f a
pure Entry
EntryCode
    Text
x | Just Text
name <- Text -> Text -> Maybe Text
stripPrefix Text
"view:" Text
x
      -> (BadViewNameError -> Parser Entry)
-> (ViewName -> Parser Entry)
-> Either BadViewNameError ViewName
-> Parser Entry
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser Entry
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Entry)
-> (BadViewNameError -> String) -> BadViewNameError -> Parser Entry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BadViewNameError -> String
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty) (Entry -> Parser Entry
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Entry -> Parser Entry)
-> (ViewName -> Entry) -> ViewName -> Parser Entry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViewName -> Entry
EntryView) (Either BadViewNameError ViewName -> Parser Entry)
-> Either BadViewNameError ViewName -> Parser Entry
forall a b. (a -> b) -> a -> b
$ Text -> Either BadViewNameError ViewName
mkViewName Text
name
    Text
_ -> String -> Parser Entry
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Entry) -> String -> Parser Entry
forall a b. (a -> b) -> a -> b
$ String
"Unexpected Entry value"

instance NFData Entry

-- | 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.
newtype EntriesOrder = EntriesOrder { EntriesOrder -> Map Entry Word
unEntriesOrder :: Map Entry Word }
  deriving stock (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, Eq EntriesOrder
Eq EntriesOrder
-> (EntriesOrder -> EntriesOrder -> Ordering)
-> (EntriesOrder -> EntriesOrder -> Bool)
-> (EntriesOrder -> EntriesOrder -> Bool)
-> (EntriesOrder -> EntriesOrder -> Bool)
-> (EntriesOrder -> EntriesOrder -> Bool)
-> (EntriesOrder -> EntriesOrder -> EntriesOrder)
-> (EntriesOrder -> EntriesOrder -> EntriesOrder)
-> Ord EntriesOrder
EntriesOrder -> EntriesOrder -> Bool
EntriesOrder -> EntriesOrder -> Ordering
EntriesOrder -> EntriesOrder -> EntriesOrder
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EntriesOrder -> EntriesOrder -> EntriesOrder
$cmin :: EntriesOrder -> EntriesOrder -> EntriesOrder
max :: EntriesOrder -> EntriesOrder -> EntriesOrder
$cmax :: EntriesOrder -> EntriesOrder -> EntriesOrder
>= :: EntriesOrder -> EntriesOrder -> Bool
$c>= :: EntriesOrder -> EntriesOrder -> Bool
> :: EntriesOrder -> EntriesOrder -> Bool
$c> :: EntriesOrder -> EntriesOrder -> Bool
<= :: EntriesOrder -> EntriesOrder -> Bool
$c<= :: EntriesOrder -> EntriesOrder -> Bool
< :: EntriesOrder -> EntriesOrder -> Bool
$c< :: EntriesOrder -> EntriesOrder -> Bool
compare :: EntriesOrder -> EntriesOrder -> Ordering
$ccompare :: EntriesOrder -> EntriesOrder -> Ordering
Ord, Int -> EntriesOrder -> ShowS
[EntriesOrder] -> ShowS
EntriesOrder -> String
(Int -> EntriesOrder -> ShowS)
-> (EntriesOrder -> String)
-> ([EntriesOrder] -> ShowS)
-> Show EntriesOrder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntriesOrder] -> ShowS
$cshowList :: [EntriesOrder] -> ShowS
show :: EntriesOrder -> String
$cshow :: EntriesOrder -> String
showsPrec :: Int -> EntriesOrder -> ShowS
$cshowsPrec :: Int -> EntriesOrder -> ShowS
Show, 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)
  deriving newtype (EntriesOrder -> ()
(EntriesOrder -> ()) -> NFData EntriesOrder
forall a. (a -> ()) -> NFData a
rnf :: EntriesOrder -> ()
$crnf :: EntriesOrder -> ()
NFData, Value -> Parser [EntriesOrder]
Value -> Parser EntriesOrder
(Value -> Parser EntriesOrder)
-> (Value -> Parser [EntriesOrder]) -> FromJSON EntriesOrder
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [EntriesOrder]
$cparseJSONList :: Value -> Parser [EntriesOrder]
parseJSON :: Value -> Parser EntriesOrder
$cparseJSON :: Value -> Parser EntriesOrder
FromJSON, [EntriesOrder] -> Encoding
[EntriesOrder] -> Value
EntriesOrder -> Encoding
EntriesOrder -> Value
(EntriesOrder -> Value)
-> (EntriesOrder -> Encoding)
-> ([EntriesOrder] -> Value)
-> ([EntriesOrder] -> Encoding)
-> ToJSON EntriesOrder
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [EntriesOrder] -> Encoding
$ctoEncodingList :: [EntriesOrder] -> Encoding
toJSONList :: [EntriesOrder] -> Value
$ctoJSONList :: [EntriesOrder] -> Value
toEncoding :: EntriesOrder -> Encoding
$ctoEncoding :: EntriesOrder -> Encoding
toJSON :: EntriesOrder -> Value
$ctoJSON :: EntriesOrder -> Value
ToJSON)

-- | Helper to construct 'EntriesOrder' from an ordered list of entires.
-- Duplicate entires are ignored.
mkEntriesOrder :: [Entry] -> EntriesOrder
mkEntriesOrder :: [Entry] -> EntriesOrder
mkEntriesOrder = Map Entry Word -> EntriesOrder
EntriesOrder (Map Entry Word -> EntriesOrder)
-> ([Entry] -> Map Entry Word) -> [Entry] -> EntriesOrder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word -> Word -> Word) -> [(Entry, Word)] -> Map Entry Word
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Word -> Word -> Word
forall a b. a -> b -> a
const ([(Entry, Word)] -> Map Entry Word)
-> ([Entry] -> [(Entry, Word)]) -> [Entry] -> Map Entry Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Entry] -> [Word] -> [(Entry, Word)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Word
0..])

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

-- | The canonical entries order which is ordered as follow:
-- @parameter@, @storage@, and @code@.
canonicalEntriesOrder :: EntriesOrder
canonicalEntriesOrder :: EntriesOrder
canonicalEntriesOrder = [Entry] -> EntriesOrder
mkEntriesOrder [Entry
EntryParameter, Entry
EntryStorage, Entry
EntryCode]

-- | 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 -> String
(Int -> ContractBlock op -> ShowS)
-> (ContractBlock op -> String)
-> ([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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContractBlock op] -> ShowS
$cshowList :: forall op. Show op => [ContractBlock op] -> ShowS
show :: ContractBlock op -> String
$cshow :: forall op. Show op => ContractBlock op -> String
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)

makePrisms ''ContractBlock

-- | 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.
orderContractBlock :: [ContractBlock op] -> Maybe (Contract' op)
orderContractBlock :: forall op. [ContractBlock op] -> Maybe (Contract' op)
orderContractBlock [ContractBlock op]
blocks =
  let
    -- we are sure there are no duplicate view names due to the guard below, so
    -- we can construct a Map right away
    contractViews :: ViewsSet op
contractViews = Either ViewsSetError (ViewsSet op) -> ViewsSet op
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either ViewsSetError (ViewsSet op) -> ViewsSet op)
-> ([View' op] -> Either ViewsSetError (ViewsSet op))
-> [View' op]
-> ViewsSet op
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [View' op] -> Either ViewsSetError (ViewsSet op)
forall instr.
[View' instr] -> Either ViewsSetError (ViewsSet instr)
mkViewsSet ([View' op] -> ViewsSet op) -> [View' op] -> ViewsSet op
forall a b. (a -> b) -> a -> b
$ [ContractBlock op]
blocks [ContractBlock op]
-> Getting (Endo [View' op]) [ContractBlock op] (View' op)
-> [View' op]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. (ContractBlock op -> Const (Endo [View' op]) (ContractBlock op))
-> [ContractBlock op] -> Const (Endo [View' op]) [ContractBlock op]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded ((ContractBlock op -> Const (Endo [View' op]) (ContractBlock op))
 -> [ContractBlock op]
 -> Const (Endo [View' op]) [ContractBlock op])
-> ((View' op -> Const (Endo [View' op]) (View' op))
    -> ContractBlock op -> Const (Endo [View' op]) (ContractBlock op))
-> Getting (Endo [View' op]) [ContractBlock op] (View' op)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (View' op -> Const (Endo [View' op]) (View' op))
-> ContractBlock op -> Const (Endo [View' op]) (ContractBlock op)
forall op. Prism' (ContractBlock op) (View' op)
_CBView
    blockTypes :: [Entry]
blockTypes = [ContractBlock op]
blocks [ContractBlock op] -> (ContractBlock op -> Entry) -> [Entry]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      CBParam{} -> Entry
EntryParameter
      CBStorage{} -> Entry
EntryStorage
      CBCode{} -> Entry
EntryCode
      CBView 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
..} -> ViewName -> Entry
EntryView ViewName
viewName
    entriesOrder :: EntriesOrder
entriesOrder = [Entry] -> EntriesOrder
mkEntriesOrder [Entry]
blockTypes
  in do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ [Entry]
blockTypes [Entry] -> [Entry] -> Bool
forall a. Eq a => a -> a -> Bool
== [Entry] -> [Entry]
forall a. Ord a => [a] -> [a]
ordNub [Entry]
blockTypes -- must have no duplicates
    ParameterType
contractParameter <- [ContractBlock op]
blocks [ContractBlock op]
-> Getting (First ParameterType) [ContractBlock op] ParameterType
-> Maybe ParameterType
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ContractBlock op
 -> Const (First ParameterType) (ContractBlock op))
-> [ContractBlock op]
-> Const (First ParameterType) [ContractBlock op]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded ((ContractBlock op
  -> Const (First ParameterType) (ContractBlock op))
 -> [ContractBlock op]
 -> Const (First ParameterType) [ContractBlock op])
-> ((ParameterType -> Const (First ParameterType) ParameterType)
    -> ContractBlock op
    -> Const (First ParameterType) (ContractBlock op))
-> Getting (First ParameterType) [ContractBlock op] ParameterType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParameterType -> Const (First ParameterType) ParameterType)
-> ContractBlock op
-> Const (First ParameterType) (ContractBlock op)
forall op. Prism' (ContractBlock op) ParameterType
_CBParam
    Storage
contractStorage <- [ContractBlock op]
blocks [ContractBlock op]
-> Getting (First Storage) [ContractBlock op] Storage
-> Maybe Storage
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ContractBlock op -> Const (First Storage) (ContractBlock op))
-> [ContractBlock op] -> Const (First Storage) [ContractBlock op]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded ((ContractBlock op -> Const (First Storage) (ContractBlock op))
 -> [ContractBlock op] -> Const (First Storage) [ContractBlock op])
-> ((Storage -> Const (First Storage) Storage)
    -> ContractBlock op -> Const (First Storage) (ContractBlock op))
-> Getting (First Storage) [ContractBlock op] Storage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Storage -> Const (First Storage) Storage)
-> ContractBlock op -> Const (First Storage) (ContractBlock op)
forall op. Prism' (ContractBlock op) Storage
_CBStorage
    [op]
contractCode <- [ContractBlock op]
blocks [ContractBlock op]
-> Getting (First [op]) [ContractBlock op] [op] -> Maybe [op]
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ContractBlock op -> Const (First [op]) (ContractBlock op))
-> [ContractBlock op] -> Const (First [op]) [ContractBlock op]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded ((ContractBlock op -> Const (First [op]) (ContractBlock op))
 -> [ContractBlock op] -> Const (First [op]) [ContractBlock op])
-> (([op] -> Const (First [op]) [op])
    -> ContractBlock op -> Const (First [op]) (ContractBlock op))
-> Getting (First [op]) [ContractBlock op] [op]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([op] -> Const (First [op]) [op])
-> ContractBlock op -> Const (First [op]) (ContractBlock op)
forall op. Prism' (ContractBlock op) [op]
_CBCode
    pure Contract :: forall op.
ParameterType
-> Storage -> [op] -> EntriesOrder -> ViewsSet op -> Contract' op
Contract{[op]
ParameterType
Storage
ViewsSet op
EntriesOrder
contractViews :: ViewsSet op
entriesOrder :: EntriesOrder
contractCode :: [op]
contractStorage :: Storage
contractParameter :: ParameterType
contractCode :: [op]
contractStorage :: Storage
contractParameter :: ParameterType
entriesOrder :: EntriesOrder
contractViews :: ViewsSet op
..}

instance Buildable (ContractBlock op) where
  build :: ContractBlock op -> Builder
build CBParam{} = Builder
"parameter"
  build CBStorage{} = Builder
"storage"
  build CBCode{} = Builder
"code"
  build (CBView View{[op]
Storage
ViewName
viewCode :: [op]
viewReturn :: Storage
viewArgument :: Storage
viewName :: 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
..}) = Builder
"view \"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ViewName -> Builder
forall p. Buildable p => p -> Builder
build ViewName
viewName Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\""

-- | 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]
ParameterType
Storage
ViewsSet op
EntriesOrder
contractViews :: ViewsSet op
entriesOrder :: EntriesOrder
contractCode :: [op]
contractStorage :: Storage
contractParameter :: ParameterType
contractViews :: forall op. Contract' op -> ViewsSet 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
..} ParameterType -> a
fParam Storage -> a
fStorage [op] -> a
fCode View' op -> 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
unEntriesOrder EntriesOrder
entriesOrder
    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
EntryParameter, ParameterType -> a
fParam ParameterType
contractParameter)
          , (Entry
EntryStorage, Storage -> a
fStorage Storage
contractStorage)
          , (Entry
EntryCode, [op] -> a
fCode [op]
contractCode)]
      [(Entry, a)] -> [(Entry, a)] -> [(Entry, a)]
forall a. Semigroup a => a -> a -> a
<>  (ViewsSet op -> [Element (ViewsSet op)]
forall t. Container t => t -> [Element t]
toList ViewsSet op
contractViews [View' op] -> (View' op -> (Entry, a)) -> [(Entry, a)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \v :: View' op
v@View{[op]
Storage
ViewName
viewCode :: [op]
viewReturn :: Storage
viewArgument :: Storage
viewName :: 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
..} -> (ViewName -> Entry
EntryView ViewName
viewName, View' op -> a
fView View' op
v))

-- | 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 -> ViewsSet op
contractViews :: ViewsSet 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 -> String
(Int -> Contract' op -> ShowS)
-> (Contract' op -> String)
-> ([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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Contract' op] -> ShowS
$cshowList :: forall op. Show op => [Contract' op] -> ShowS
show :: Contract' op -> String
$cshow :: forall op. Show op => Contract' op -> String
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 :: [op]
viewReturn :: Storage
viewArgument :: Storage
viewName :: 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
..} -> Doc -> Doc
PP.group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"view" Doc -> Doc -> Doc
<+> Doc -> Doc
PP.align (
          [Doc] -> Doc
PP.sep
            [ ViewName -> Doc
renderViewName ViewName
viewName
            , RenderContext -> Storage -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens Storage
viewArgument
            , RenderContext -> Storage -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens Storage
viewReturn
            ]
          Doc -> Doc -> Doc
PP.<$> 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 = (op -> op) -> Contract' op -> Contract' op
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap op -> op
f
{-# DEPRECATED mapContractCode "Use fmap instead" #-}

deriveJSON morleyAesonOptions ''Contract'