-- 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 (..)
  , ContractBlockError (..)
  , orderContractBlock

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

import Control.Lens (Prism', makePrisms)
import Data.Aeson (FromJSON, FromJSONKey(..), ToJSON, ToJSONKey(..))
import Data.Aeson.TH (deriveJSON)
import Data.Aeson.Types qualified as AesonTypes
import Data.Bitraversable (bitraverse)
import Data.Data (Data(..))
import Data.Default (Default(..))
import Data.Map qualified as Map
import Data.Text (stripPrefix)
import Fmt (Buildable(build), listF, nameF, pretty, (<$$>), (<+>))
import Fmt.Operators qualified as PP
import Prettyprinter (semi)
import Prettyprinter qualified as PP

import Morley.Michelson.Printer.Util
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
$c== :: Entry -> Entry -> Bool
== :: Entry -> Entry -> Bool
$c/= :: Entry -> Entry -> Bool
/= :: 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
$ccompare :: Entry -> Entry -> Ordering
compare :: Entry -> Entry -> Ordering
$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
>= :: Entry -> Entry -> Bool
$cmax :: Entry -> Entry -> Entry
max :: Entry -> Entry -> Entry
$cmin :: Entry -> Entry -> Entry
min :: Entry -> Entry -> Entry
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
$cshowsPrec :: Int -> Entry -> ShowS
showsPrec :: Int -> Entry -> ShowS
$cshow :: Entry -> String
show :: Entry -> String
$cshowList :: [Entry] -> ShowS
showList :: [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 -> Constr
Entry -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entry -> c Entry
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Entry -> c Entry
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Entry
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Entry
$ctoConstr :: Entry -> Constr
toConstr :: Entry -> Constr
$cdataTypeOf :: Entry -> DataType
dataTypeOf :: Entry -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Entry)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Entry)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Entry)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Entry)
$cgmapT :: (forall b. Data b => b -> b) -> Entry -> Entry
gmapT :: (forall b. Data b => b -> b) -> Entry -> Entry
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Entry -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Entry -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Entry -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Entry -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Entry -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Entry -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Entry -> m Entry
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Entry -> m 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
$cfrom :: forall x. Entry -> Rep Entry x
from :: forall x. Entry -> Rep Entry x
$cto :: forall x. Rep Entry x -> Entry
to :: forall x. Rep Entry x -> Entry
Generic)

instance Buildable Entry where
  build :: Entry -> Doc
build = \case
    Entry
EntryParameter -> Doc
"parameter"
    Entry
EntryStorage -> Doc
"storage"
    Entry
EntryCode -> Doc
"code"
    EntryView ViewName
name -> Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"view" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ ViewName -> Doc
forall a. Buildable a => a -> Doc
build ViewName
name

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 a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Entry
EntryParameter
    Text
"storage" -> Entry -> Parser Entry
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Entry
EntryStorage
    Text
"code" -> Entry -> Parser Entry
forall a. a -> Parser a
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 a. String -> Parser a
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, FromDoc b) => a -> b
pretty) (Entry -> Parser Entry
forall a. a -> Parser a
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 a. String -> Parser a
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
$c== :: EntriesOrder -> EntriesOrder -> Bool
== :: EntriesOrder -> EntriesOrder -> Bool
$c/= :: EntriesOrder -> EntriesOrder -> Bool
/= :: 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
$ccompare :: EntriesOrder -> EntriesOrder -> Ordering
compare :: EntriesOrder -> EntriesOrder -> Ordering
$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
>= :: EntriesOrder -> EntriesOrder -> Bool
$cmax :: EntriesOrder -> EntriesOrder -> EntriesOrder
max :: EntriesOrder -> EntriesOrder -> EntriesOrder
$cmin :: EntriesOrder -> EntriesOrder -> EntriesOrder
min :: EntriesOrder -> EntriesOrder -> EntriesOrder
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
$cshowsPrec :: Int -> EntriesOrder -> ShowS
showsPrec :: Int -> EntriesOrder -> ShowS
$cshow :: EntriesOrder -> String
show :: EntriesOrder -> String
$cshowList :: [EntriesOrder] -> ShowS
showList :: [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 -> Constr
EntriesOrder -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EntriesOrder -> c EntriesOrder
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EntriesOrder -> c EntriesOrder
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EntriesOrder
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EntriesOrder
$ctoConstr :: EntriesOrder -> Constr
toConstr :: EntriesOrder -> Constr
$cdataTypeOf :: EntriesOrder -> DataType
dataTypeOf :: EntriesOrder -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EntriesOrder)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EntriesOrder)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EntriesOrder)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c EntriesOrder)
$cgmapT :: (forall b. Data b => b -> b) -> EntriesOrder -> EntriesOrder
gmapT :: (forall b. Data b => b -> b) -> EntriesOrder -> EntriesOrder
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EntriesOrder -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EntriesOrder -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EntriesOrder -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> EntriesOrder -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EntriesOrder -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EntriesOrder -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EntriesOrder -> m EntriesOrder
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EntriesOrder -> m EntriesOrder
Data)
  deriving newtype (EntriesOrder -> ()
(EntriesOrder -> ()) -> NFData EntriesOrder
forall a. (a -> ()) -> NFData a
$crnf :: EntriesOrder -> ()
rnf :: 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
$cparseJSON :: Value -> Parser EntriesOrder
parseJSON :: Value -> Parser EntriesOrder
$cparseJSONList :: Value -> Parser [EntriesOrder]
parseJSONList :: Value -> Parser [EntriesOrder]
FromJSON, [EntriesOrder] -> Value
[EntriesOrder] -> Encoding
EntriesOrder -> Value
EntriesOrder -> Encoding
(EntriesOrder -> Value)
-> (EntriesOrder -> Encoding)
-> ([EntriesOrder] -> Value)
-> ([EntriesOrder] -> Encoding)
-> ToJSON EntriesOrder
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: EntriesOrder -> Value
toJSON :: EntriesOrder -> Value
$ctoEncoding :: EntriesOrder -> Encoding
toEncoding :: EntriesOrder -> Encoding
$ctoJSONList :: [EntriesOrder] -> Value
toJSONList :: [EntriesOrder] -> Value
$ctoEncodingList :: [EntriesOrder] -> Encoding
toEncodingList :: [EntriesOrder] -> Encoding
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
$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
/= :: 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
$cshowsPrec :: forall op. Show op => Int -> ContractBlock op -> ShowS
showsPrec :: Int -> ContractBlock op -> ShowS
$cshow :: forall op. Show op => ContractBlock op -> String
show :: ContractBlock op -> String
$cshowList :: forall op. Show op => [ContractBlock op] -> ShowS
showList :: [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
$cfmap :: forall a b. (a -> b) -> ContractBlock a -> ContractBlock b
fmap :: forall a b. (a -> b) -> ContractBlock a -> ContractBlock b
$c<$ :: forall a b. a -> ContractBlock b -> ContractBlock a
<$ :: forall a b. a -> ContractBlock b -> ContractBlock a
Functor)

makePrisms ''ContractBlock
makePrisms ''Entry

data ContractBlockError
  = CBEDuplicate (NonEmpty Entry)
  | CBEMissing Entry
  deriving stock (ContractBlockError -> ContractBlockError -> Bool
(ContractBlockError -> ContractBlockError -> Bool)
-> (ContractBlockError -> ContractBlockError -> Bool)
-> Eq ContractBlockError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContractBlockError -> ContractBlockError -> Bool
== :: ContractBlockError -> ContractBlockError -> Bool
$c/= :: ContractBlockError -> ContractBlockError -> Bool
/= :: ContractBlockError -> ContractBlockError -> Bool
Eq, Int -> ContractBlockError -> ShowS
[ContractBlockError] -> ShowS
ContractBlockError -> String
(Int -> ContractBlockError -> ShowS)
-> (ContractBlockError -> String)
-> ([ContractBlockError] -> ShowS)
-> Show ContractBlockError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContractBlockError -> ShowS
showsPrec :: Int -> ContractBlockError -> ShowS
$cshow :: ContractBlockError -> String
show :: ContractBlockError -> String
$cshowList :: [ContractBlockError] -> ShowS
showList :: [ContractBlockError] -> ShowS
Show)

instance Buildable ContractBlockError where
  build :: ContractBlockError -> Doc
build = \case
    CBEDuplicate (Entry
b :| []) -> Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Duplicate contract field" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Entry -> Doc
forall a. Buildable a => a -> Doc
build Entry
b
    CBEDuplicate NonEmpty Entry
bs -> Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Duplicate contract fields" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ NonEmpty Entry -> Doc
forall a (f :: * -> *). (Buildable a, Foldable f) => f a -> Doc
listF NonEmpty Entry
bs
    CBEMissing Entry
entry -> Doc -> Doc -> Doc
forall a. Buildable a => Doc -> a -> Doc
nameF Doc
"Missing contract field" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Entry -> Doc
forall a. Buildable a => a -> Doc
build Entry
entry

newtype Validation e a = Validation { forall e a. Validation e a -> Either e a
unValidation :: Either e a }
  deriving stock (Int -> Validation e a -> ShowS
[Validation e a] -> ShowS
Validation e a -> String
(Int -> Validation e a -> ShowS)
-> (Validation e a -> String)
-> ([Validation e a] -> ShowS)
-> Show (Validation e a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall e a. (Show e, Show a) => Int -> Validation e a -> ShowS
forall e a. (Show e, Show a) => [Validation e a] -> ShowS
forall e a. (Show e, Show a) => Validation e a -> String
$cshowsPrec :: forall e a. (Show e, Show a) => Int -> Validation e a -> ShowS
showsPrec :: Int -> Validation e a -> ShowS
$cshow :: forall e a. (Show e, Show a) => Validation e a -> String
show :: Validation e a -> String
$cshowList :: forall e a. (Show e, Show a) => [Validation e a] -> ShowS
showList :: [Validation e a] -> ShowS
Show, Validation e a -> Validation e a -> Bool
(Validation e a -> Validation e a -> Bool)
-> (Validation e a -> Validation e a -> Bool)
-> Eq (Validation e a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall e a.
(Eq e, Eq a) =>
Validation e a -> Validation e a -> Bool
$c== :: forall e a.
(Eq e, Eq a) =>
Validation e a -> Validation e a -> Bool
== :: Validation e a -> Validation e a -> Bool
$c/= :: forall e a.
(Eq e, Eq a) =>
Validation e a -> Validation e a -> Bool
/= :: Validation e a -> Validation e a -> Bool
Eq)
  deriving newtype ((forall a b. (a -> b) -> Validation e a -> Validation e b)
-> (forall a b. a -> Validation e b -> Validation e a)
-> Functor (Validation e)
forall a b. a -> Validation e b -> Validation e a
forall a b. (a -> b) -> Validation e a -> Validation e b
forall e a b. a -> Validation e b -> Validation e a
forall e a b. (a -> b) -> Validation e a -> Validation e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall e a b. (a -> b) -> Validation e a -> Validation e b
fmap :: forall a b. (a -> b) -> Validation e a -> Validation e b
$c<$ :: forall e a b. a -> Validation e b -> Validation e a
<$ :: forall a b. a -> Validation e b -> Validation e a
Functor)

instance Semigroup e => Applicative (Validation e) where
  pure :: forall a. a -> Validation e a
pure = Either e a -> Validation e a
forall e a. Either e a -> Validation e a
Validation (Either e a -> Validation e a)
-> (a -> Either e a) -> a -> Validation e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either e a
forall a b. b -> Either a b
Right
  Validation (Left e
e1) <*> :: forall a b.
Validation e (a -> b) -> Validation e a -> Validation e b
<*> Validation Either e a
r = Either e b -> Validation e b
forall e a. Either e a -> Validation e a
Validation (Either e b -> Validation e b) -> Either e b -> Validation e b
forall a b. (a -> b) -> a -> b
$ e -> Either e b
forall a b. a -> Either a b
Left (e -> Either e b) -> e -> Either e b
forall a b. (a -> b) -> a -> b
$ (e -> e) -> (a -> e) -> Either e a -> e
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e
e1 e -> e -> e
forall a. Semigroup a => a -> a -> a
<>) (e -> a -> e
forall a b. a -> b -> a
const e
e1) Either e a
r
  Validation (Right a -> b
f) <*> Validation e a
x = a -> b
f (a -> b) -> Validation e a -> Validation e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Validation e a
x

-- | 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
  :: forall op. [ContractBlock op]
  -> Either (NonEmpty ContractBlockError) (Contract' op)
orderContractBlock :: forall op.
[ContractBlock op]
-> Either (NonEmpty ContractBlockError) (Contract' op)
orderContractBlock [ContractBlock op]
blocks =
  let
    blockToBlockType :: ContractBlock op -> Entry
blockToBlockType = \case
      CBParam{} -> Entry
EntryParameter
      CBStorage{} -> Entry
EntryStorage
      CBCode{} -> Entry
EntryCode
      CBView View{op
Ty
ViewName
viewName :: ViewName
viewArgument :: Ty
viewReturn :: Ty
viewCode :: op
viewName :: forall op. View' op -> ViewName
viewArgument :: forall op. View' op -> Ty
viewReturn :: forall op. View' op -> Ty
viewCode :: forall op. View' op -> op
..} -> ViewName -> Entry
EntryView ViewName
viewName
    duplicates :: [Entry]
    blockMap :: Map Entry (Word, ContractBlock op)
    ([Entry]
duplicates, Map Entry (Word, ContractBlock op)
blockMap) =
      (Element [(ContractBlock op, Word)]
 -> ([Entry], Map Entry (Word, ContractBlock op))
 -> ([Entry], Map Entry (Word, ContractBlock op)))
-> ([Entry], Map Entry (Word, ContractBlock op))
-> [(ContractBlock op, Word)]
-> ([Entry], Map Entry (Word, ContractBlock op))
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
forall b.
(Element [(ContractBlock op, Word)] -> b -> b)
-> b -> [(ContractBlock op, Word)] -> b
foldr (ContractBlock op, Word)
-> ([Entry], Map Entry (Word, ContractBlock op))
-> ([Entry], Map Entry (Word, ContractBlock op))
Element [(ContractBlock op, Word)]
-> ([Entry], Map Entry (Word, ContractBlock op))
-> ([Entry], Map Entry (Word, ContractBlock op))
forall {op} {a}.
(ContractBlock op, a)
-> ([Entry], Map Entry (a, ContractBlock op))
-> ([Entry], Map Entry (a, ContractBlock op))
go ([Entry]
forall a. Monoid a => a
mempty, Map Entry (Word, ContractBlock op)
forall a. Monoid a => a
mempty) ([ContractBlock op] -> [Word] -> [(ContractBlock op, Word)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ContractBlock op]
blocks [Word
0..])
      where
        go :: (ContractBlock op, a)
-> ([Entry], Map Entry (a, ContractBlock op))
-> ([Entry], Map Entry (a, ContractBlock op))
go (ContractBlock op
b, a
n) (![Entry]
dups, !Map Entry (a, ContractBlock op)
seen) =
          let blockType :: Entry
blockType = ContractBlock op -> Entry
forall {op}. ContractBlock op -> Entry
blockToBlockType ContractBlock op
b
              dups' :: [Entry]
dups' | Entry -> Map Entry (a, ContractBlock op) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member Entry
blockType Map Entry (a, ContractBlock op)
seen = Entry
blockTypeEntry -> [Entry] -> [Entry]
forall a. a -> [a] -> [a]
:[Entry]
dups
                    | Bool
otherwise = [Entry]
dups
          in ([Entry]
dups', Entry
-> (a, ContractBlock op)
-> Map Entry (a, ContractBlock op)
-> Map Entry (a, ContractBlock op)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Entry
blockType (a
n, ContractBlock op
b) Map Entry (a, ContractBlock op)
seen)
    entriesOrder :: EntriesOrder
entriesOrder = Map Entry Word -> EntriesOrder
EntriesOrder (Map Entry Word -> EntriesOrder) -> Map Entry Word -> EntriesOrder
forall a b. (a -> b) -> a -> b
$ (Word, ContractBlock op) -> Word
forall a b. (a, b) -> a
fst ((Word, ContractBlock op) -> Word)
-> Map Entry (Word, ContractBlock op) -> Map Entry Word
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Entry (Word, ContractBlock op)
blockMap
    getBlock :: Entry -> Prism' (ContractBlock op) a -> Validation (NonEmpty ContractBlockError) a
    getBlock :: forall a.
Entry
-> Prism' (ContractBlock op) a
-> Validation (NonEmpty ContractBlockError) a
getBlock Entry
ty Prism' (ContractBlock op) a
prism = Either (NonEmpty ContractBlockError) a
-> Validation (NonEmpty ContractBlockError) a
forall e a. Either e a -> Validation e a
Validation (Either (NonEmpty ContractBlockError) a
 -> Validation (NonEmpty ContractBlockError) a)
-> Either (NonEmpty ContractBlockError) a
-> Validation (NonEmpty ContractBlockError) a
forall a b. (a -> b) -> a -> b
$ NonEmpty ContractBlockError
-> Maybe a -> Either (NonEmpty ContractBlockError) a
forall l r. l -> Maybe r -> Either l r
maybeToRight (OneItem (NonEmpty ContractBlockError)
-> NonEmpty ContractBlockError
forall x. One x => OneItem x -> x
one (OneItem (NonEmpty ContractBlockError)
 -> NonEmpty ContractBlockError)
-> OneItem (NonEmpty ContractBlockError)
-> NonEmpty ContractBlockError
forall a b. (a -> b) -> a -> b
$ Entry -> ContractBlockError
CBEMissing Entry
ty) (Maybe a -> Either (NonEmpty ContractBlockError) a)
-> Maybe a -> Either (NonEmpty ContractBlockError) a
forall a b. (a -> b) -> a -> b
$
      Entry
-> Map Entry (Word, ContractBlock op)
-> Maybe (Word, ContractBlock op)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Entry
ty Map Entry (Word, ContractBlock op)
blockMap Maybe (Word, ContractBlock op)
-> ((Word, ContractBlock op) -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Getting (First a) (Word, ContractBlock op) a
-> (Word, ContractBlock op) -> Maybe a
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((ContractBlock op -> Const (First a) (ContractBlock op))
-> (Word, ContractBlock op)
-> Const (First a) (Word, ContractBlock op)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Word, ContractBlock op)
  (Word, ContractBlock op)
  (ContractBlock op)
  (ContractBlock op)
_2 ((ContractBlock op -> Const (First a) (ContractBlock op))
 -> (Word, ContractBlock op)
 -> Const (First a) (Word, ContractBlock op))
-> ((a -> Const (First a) a)
    -> ContractBlock op -> Const (First a) (ContractBlock op))
-> Getting (First a) (Word, ContractBlock op) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Const (First a) a)
-> ContractBlock op -> Const (First a) (ContractBlock op)
Prism' (ContractBlock op) a
prism)
    contractViews :: ViewsSet op
contractViews = Map ViewName (View' op) -> ViewsSet op
forall instr. Map ViewName (View' instr) -> ViewsSet instr
ViewsSet
      (Map ViewName (View' op) -> ViewsSet op)
-> ([(Entry, (Word, ContractBlock op))] -> Map ViewName (View' op))
-> [(Entry, (Word, ContractBlock op))]
-> ViewsSet op
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ViewName, View' op)] -> Map ViewName (View' op)
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList -- we know that keys are still unique and sorted
      ([(ViewName, View' op)] -> Map ViewName (View' op))
-> ([(Entry, (Word, ContractBlock op))] -> [(ViewName, View' op)])
-> [(Entry, (Word, ContractBlock op))]
-> Map ViewName (View' op)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Entry, (Word, ContractBlock op)) -> Maybe (ViewName, View' op))
-> [(Entry, (Word, ContractBlock op))] -> [(ViewName, View' op)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Entry -> Maybe ViewName)
-> ((Word, ContractBlock op) -> Maybe (View' op))
-> (Entry, (Word, ContractBlock op))
-> Maybe (ViewName, View' op)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> (a, b) -> f (c, d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse (Getting (First ViewName) Entry ViewName -> Entry -> Maybe ViewName
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First ViewName) Entry ViewName
Prism' Entry ViewName
_EntryView) (Getting (First (View' op)) (Word, ContractBlock op) (View' op)
-> (Word, ContractBlock op) -> Maybe (View' op)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Getting (First (View' op)) (Word, ContractBlock op) (View' op)
 -> (Word, ContractBlock op) -> Maybe (View' op))
-> Getting (First (View' op)) (Word, ContractBlock op) (View' op)
-> (Word, ContractBlock op)
-> Maybe (View' op)
forall a b. (a -> b) -> a -> b
$ (ContractBlock op -> Const (First (View' op)) (ContractBlock op))
-> (Word, ContractBlock op)
-> Const (First (View' op)) (Word, ContractBlock op)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Word, ContractBlock op)
  (Word, ContractBlock op)
  (ContractBlock op)
  (ContractBlock op)
_2 ((ContractBlock op -> Const (First (View' op)) (ContractBlock op))
 -> (Word, ContractBlock op)
 -> Const (First (View' op)) (Word, ContractBlock op))
-> ((View' op -> Const (First (View' op)) (View' op))
    -> ContractBlock op -> Const (First (View' op)) (ContractBlock op))
-> Getting (First (View' op)) (Word, ContractBlock op) (View' op)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (View' op -> Const (First (View' op)) (View' op))
-> ContractBlock op -> Const (First (View' op)) (ContractBlock op)
forall op (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (View' op) (f (View' op))
-> p (ContractBlock op) (f (ContractBlock op))
_CBView))
      ([(Entry, (Word, ContractBlock op))] -> ViewsSet op)
-> [(Entry, (Word, ContractBlock op))] -> ViewsSet op
forall a b. (a -> b) -> a -> b
$ Map Entry (Word, ContractBlock op)
-> [(Key (Map Entry (Word, ContractBlock op)),
     Val (Map Entry (Word, ContractBlock op)))]
forall t. ToPairs t => t -> [(Key t, Val t)]
toPairs Map Entry (Word, ContractBlock op)
blockMap
  in Validation (NonEmpty ContractBlockError) (Contract' op)
-> Either (NonEmpty ContractBlockError) (Contract' op)
forall e a. Validation e a -> Either e a
unValidation do
    Either (NonEmpty ContractBlockError) ()
-> Validation (NonEmpty ContractBlockError) ()
forall e a. Either e a -> Validation e a
Validation (Either (NonEmpty ContractBlockError) ()
 -> Validation (NonEmpty ContractBlockError) ())
-> Either (NonEmpty ContractBlockError) ()
-> Validation (NonEmpty ContractBlockError) ()
forall a b. (a -> b) -> a -> b
$ [Entry] -> Maybe (NonEmpty Entry)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Entry]
duplicates Maybe (NonEmpty Entry)
-> (Maybe (NonEmpty Entry)
    -> Either (NonEmpty ContractBlockError) ())
-> Either (NonEmpty ContractBlockError) ()
forall a b. a -> (a -> b) -> b
& ()
-> Maybe (NonEmpty ContractBlockError)
-> Either (NonEmpty ContractBlockError) ()
forall r l. r -> Maybe l -> Either l r
maybeToLeft () (Maybe (NonEmpty ContractBlockError)
 -> Either (NonEmpty ContractBlockError) ())
-> (Maybe (NonEmpty Entry) -> Maybe (NonEmpty ContractBlockError))
-> Maybe (NonEmpty Entry)
-> Either (NonEmpty ContractBlockError) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty Entry -> NonEmpty ContractBlockError)
-> Maybe (NonEmpty Entry) -> Maybe (NonEmpty ContractBlockError)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (OneItem (NonEmpty ContractBlockError)
-> NonEmpty ContractBlockError
ContractBlockError -> NonEmpty ContractBlockError
forall x. One x => OneItem x -> x
one (ContractBlockError -> NonEmpty ContractBlockError)
-> (NonEmpty Entry -> ContractBlockError)
-> NonEmpty Entry
-> NonEmpty ContractBlockError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Entry -> ContractBlockError
CBEDuplicate)
    ParameterType
contractParameter <- Entry
-> Prism' (ContractBlock op) ParameterType
-> Validation (NonEmpty ContractBlockError) ParameterType
forall a.
Entry
-> Prism' (ContractBlock op) a
-> Validation (NonEmpty ContractBlockError) a
getBlock Entry
EntryParameter p ParameterType (f ParameterType)
-> p (ContractBlock op) (f (ContractBlock op))
forall op (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p ParameterType (f ParameterType)
-> p (ContractBlock op) (f (ContractBlock op))
Prism' (ContractBlock op) ParameterType
_CBParam
    Ty
contractStorage <- Entry
-> Prism' (ContractBlock op) Ty
-> Validation (NonEmpty ContractBlockError) Ty
forall a.
Entry
-> Prism' (ContractBlock op) a
-> Validation (NonEmpty ContractBlockError) a
getBlock Entry
EntryStorage p Ty (f Ty) -> p (ContractBlock op) (f (ContractBlock op))
forall op (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p Ty (f Ty) -> p (ContractBlock op) (f (ContractBlock op))
Prism' (ContractBlock op) Ty
_CBStorage
    op
contractCode <- Entry
-> Prism' (ContractBlock op) op
-> Validation (NonEmpty ContractBlockError) op
forall a.
Entry
-> Prism' (ContractBlock op) a
-> Validation (NonEmpty ContractBlockError) a
getBlock Entry
EntryCode p op (f op) -> p (ContractBlock op) (f (ContractBlock op))
forall op (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p op (f op) -> p (ContractBlock op) (f (ContractBlock op))
Prism' (ContractBlock op) op
_CBCode
    pure Contract{op
ParameterType
Ty
ViewsSet op
EntriesOrder
entriesOrder :: EntriesOrder
contractViews :: ViewsSet op
contractParameter :: ParameterType
contractStorage :: Ty
contractCode :: op
contractParameter :: ParameterType
contractStorage :: Ty
contractCode :: op
entriesOrder :: EntriesOrder
contractViews :: ViewsSet op
..}

instance Buildable (ContractBlock op) where
  build :: ContractBlock op -> Doc
build CBParam{} = Doc
"parameter"
  build CBStorage{} = Doc
"storage"
  build CBCode{} = Doc
"code"
  build (CBView View{op
Ty
ViewName
viewName :: forall op. View' op -> ViewName
viewArgument :: forall op. View' op -> Ty
viewReturn :: forall op. View' op -> Ty
viewCode :: forall op. View' op -> op
viewName :: ViewName
viewArgument :: Ty
viewReturn :: Ty
viewCode :: op
..}) = Doc
"view \"" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ViewName -> Doc
forall a. Buildable a => a -> Doc
build ViewName
viewName Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
"\""

-- | 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)
-> (Ty -> a)
-> (op -> a)
-> (View' op -> a)
-> [a]
mapEntriesOrdered Contract{op
ParameterType
Ty
ViewsSet op
EntriesOrder
contractParameter :: forall op. Contract' op -> ParameterType
contractStorage :: forall op. Contract' op -> Ty
contractCode :: forall op. Contract' op -> op
entriesOrder :: forall op. Contract' op -> EntriesOrder
contractViews :: forall op. Contract' op -> ViewsSet op
contractParameter :: ParameterType
contractStorage :: Ty
contractCode :: op
entriesOrder :: EntriesOrder
contractViews :: ViewsSet op
..} ParameterType -> a
fParam Ty -> 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 a b c. (a -> b) -> (a, c) -> (b, c)
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, Ty -> a
fStorage Ty
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
Ty
ViewName
viewName :: forall op. View' op -> ViewName
viewArgument :: forall op. View' op -> Ty
viewReturn :: forall op. View' op -> Ty
viewCode :: forall op. View' op -> op
viewName :: ViewName
viewArgument :: Ty
viewReturn :: Ty
viewCode :: op
..} -> (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 -> Ty
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
$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
/= :: 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
$cshowsPrec :: forall op. Show op => Int -> Contract' op -> ShowS
showsPrec :: Int -> Contract' op -> ShowS
$cshow :: forall op. Show op => Contract' op -> String
show :: Contract' op -> String
$cshowList :: forall op. Show op => [Contract' op] -> ShowS
showList :: [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
$cfmap :: forall a b. (a -> b) -> Contract' a -> Contract' b
fmap :: forall a b. (a -> b) -> Contract' a -> Contract' b
$c<$ :: forall a b. a -> Contract' b -> Contract' a
<$ :: forall a b. a -> Contract' b -> Contract' a
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 -> Constr
Contract' op -> DataType
(forall b. Data b => b -> b) -> Contract' op -> Contract' op
forall {op}. Data op => Typeable (Contract' op)
forall op. Data op => Contract' op -> Constr
forall op. Data op => Contract' op -> DataType
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))
$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)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Contract' op -> 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)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Contract' op)
$ctoConstr :: forall op. Data op => Contract' op -> Constr
toConstr :: Contract' op -> Constr
$cdataTypeOf :: forall op. Data op => Contract' op -> DataType
dataTypeOf :: Contract' op -> DataType
$cdataCast1 :: forall op (t :: * -> *) (c :: * -> *).
(Data op, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Contract' op))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> 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))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Contract' op))
$cgmapT :: forall op.
Data op =>
(forall b. Data b => b -> b) -> Contract' op -> Contract' op
gmapT :: (forall b. Data b => b -> b) -> Contract' op -> Contract' op
$cgmapQl :: 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
$cgmapQr :: forall op r r'.
Data op =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Contract' op -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Contract' op -> r
$cgmapQ :: forall op u.
Data op =>
(forall d. Data d => d -> u) -> Contract' op -> [u]
gmapQ :: forall u. (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
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Contract' op -> u
$cgmapM :: forall op (m :: * -> *).
(Data op, Monad 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)
$cgmapMp :: 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)
$cgmapMo :: forall op (m :: * -> *).
(Data op, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Contract' op -> m (Contract' op)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Contract' op -> m (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
$cfrom :: forall op x. Contract' op -> Rep (Contract' op) x
from :: forall x. Contract' op -> Rep (Contract' op) x
$cto :: forall op x. Rep (Contract' op) x -> Contract' op
to :: forall x. Rep (Contract' op) x -> Contract' op
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
forall b. (Element [Doc] -> b -> b) -> b -> [Doc] -> b
foldr Doc -> Doc -> Doc
Element [Doc] -> Doc -> Doc
(<$$>) Doc
forall a. Monoid a => a
mempty
      ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Contract' op
-> (ParameterType -> Doc)
-> (Ty -> Doc)
-> (op -> Doc)
-> (View' op -> Doc)
-> [Doc]
forall op a.
Contract' op
-> (ParameterType -> a)
-> (Ty -> a)
-> (op -> a)
-> (View' op -> a)
-> [a]
mapEntriesOrdered Contract' op
contract
        (\ParameterType
parameter -> Doc
"parameter" Doc -> Doc -> Doc
<+> RenderContext -> ParameterType -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens ParameterType
parameter Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
forall ann. Doc ann
semi)
        (\Ty
storage -> Doc
"storage" Doc -> Doc -> Doc
<+> RenderContext -> Ty -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens Ty
storage Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
forall ann. Doc ann
semi)
        (\op
code -> Doc
"code" Doc -> Doc -> Doc
<+> Doc -> Doc
forall ann. Doc ann -> Doc ann
PP.align (RenderContext -> op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
doesntNeedParens op
code Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
forall ann. Doc ann
semi))
        (\View{op
Ty
ViewName
viewName :: forall op. View' op -> ViewName
viewArgument :: forall op. View' op -> Ty
viewReturn :: forall op. View' op -> Ty
viewCode :: forall op. View' op -> op
viewName :: ViewName
viewArgument :: Ty
viewReturn :: Ty
viewCode :: op
..} -> Doc -> Doc
forall ann. Doc ann -> Doc ann
PP.group (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"view" Doc -> Doc -> Doc
<+> Doc -> Doc
forall ann. Doc ann -> Doc ann
PP.align (
          [Doc] -> Doc
forall ann. [Doc ann] -> Doc ann
PP.sep
            [ ViewName -> Doc
renderViewName ViewName
viewName
            , RenderContext -> Ty -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens Ty
viewArgument
            , RenderContext -> Ty -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
needsParens Ty
viewReturn
            ]
          Doc -> Doc -> Doc
PP.<$> RenderContext -> op -> Doc
forall a. RenderDoc a => RenderContext -> a -> Doc
renderDoc RenderContext
doesntNeedParens op
viewCode Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
forall ann. Doc ann
semi
        ))

deriveJSON morleyAesonOptions ''Contract'