-
Notifications
You must be signed in to change notification settings - Fork 199
/
LF.daml
278 lines (220 loc) · 8.4 KB
/
LF.daml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
-- Copyright (c) 2021 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0
{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS -Wno-unused-binds #-} -- the opaque constructors are not exported
-- | MOVE Prelude Daml-LF types and primitives, apart from templates/contracts.
module DA.Internal.LF
( Party
, getParty
, partyToText
, partyFromText
, ContractId
, coerceContractId -- This is temporary for testing.
, Date
, Time
, TextMap
, Map
, Update
, Scenario
, scenario
, HasSubmit(..)
, HasTime
, getTime
, CanAbort
, abort
, Pair
, unpackPair
-- We always expose Any and TypeRep since they are used by template desugaring.
-- If this is not supported by the target LF version, we compile it to ().
, Any
, TypeRep
#ifdef DAML_EXCEPTIONS
, AnyException
#endif
) where
import GHC.Stack.Types (HasCallStack)
import GHC.Types (Opaque, Symbol, primitive, magic)
import DA.Internal.Prelude
-- This module should not define any new types. It should only provide the Daml equivalent for LF
-- builtins using Opaque.
-- | The `Party` type represents a party to a contract.
data Party =
Party Opaque
-- Note that before Daml-LF 1.2 BEToText added single quotes around the party.
-- now it does not, and the old behavior has been renamed BEPartyToQuotedText.
-- Since we want this to work with both versions, keep the old behavior.
instance Show Party where show party = "'" <> partyToText party <> "'"
instance Eq Party where (==) = primitive @"BEEqual"
instance Ord Party where
(<) = primitive @"BELess"
(<=) = primitive @"BELessEq"
(>=) = primitive @"BEGreaterEq"
(>) = primitive @"BEGreater"
-- | Convert the `Party` to `Text`, giving back what you passed to `getParty`.
-- In most cases, you should use `show` instead. `show` wraps
-- the party in `'ticks'` making it clear it was a `Party` originally.
partyToText : Party -> Text
partyToText = primitive @"BEToText"
-- | Converts a `Text` to `Party`. It returns `None` if the provided text contains
-- any forbidden characters. See Daml-LF spec for a specification on which characters
-- are allowed in parties. Note that this function accepts text _without_
-- single quotes.
--
-- This function does not check on whether the provided
-- text corresponds to a party that "exists" on a given ledger: it merely converts
-- the given `Text` to a `Party`. The only way to guarantee that a given `Party`
-- exists on a given ledger is to involve it in a contract.
--
-- This function, together with `partyToText`, forms an isomorphism between
-- valid party strings and parties. In other words, the following equations hold:
--
-- ```
-- ∀ p. partyFromText (partyToText p) = Some p
-- ∀ txt p. partyFromText txt = Some p ==> partyToText p = txt
-- ```
--
-- This function will crash at runtime if you compile Daml to Daml-LF < 1.2.
partyFromText : Text -> Optional Party
partyFromText = primitive @"BETextToParty"
-- | Get the party with the given name. Party names must be non-empty and only
-- contain alphanumeric charaters, space, `-` (dash) or `_` (underscore).
getParty : Text -> Scenario Party
getParty = primitive @"SGetParty"
-- | The `Date` type represents a date, for example `date 2007 Apr 5`.
data Date =
Date Opaque
instance Show Date where show = primitive @"BEToText"
instance Eq Date where (==) = primitive @"BEEqual"
instance Ord Date where (<=) = primitive @"BELessEq"
-- | The `Time` type represents a specific datetime in UTC,
-- for example `time (date 2007 Apr 5) 14 30 05`.
data Time =
Time Opaque
instance Show Time where show = primitive @"BEToText"
instance Eq Time where (==) = primitive @"BEEqual"
instance Ord Time where (<=) = primitive @"BELessEq"
-- | The `TextMap a` type represents an associative array from keys of type
-- `Text` to values of type `a`.
data TextMap a =
TextMap Opaque
-- | The `Map a b` type represents an associative array from keys of type `a`
-- to values of type `b`. It uses the built-in equality for keys. Import
-- `DA.Map` to use it.
data Map a b =
Map Opaque
-- | The `ContractId a` type represents an ID for a contract created from a template `a`.
-- You can use the ID to fetch the contract, among other things.
data ContractId a =
ContractId Opaque
instance Eq (ContractId a) where (==) = primitive @"BEEqualContractId"
instance Ord (ContractId a) where
(<) = primitive @"BELess"
(<=) = primitive @"BELessEq"
(>) = primitive @"BEGreater"
(>=) = primitive @"BEGreaterEq"
instance Show (ContractId a) where
#ifdef DAML_CONTRACT_ID_TO_TEXT
show cid = case primitive @"BEContractIdToText" cid of
None -> "<contract-id>"
Some t -> t
#else
show _ = "<contract-id>"
#endif
-- | HIDE This is currently used in the internals of Daml script and Daml triggers
-- but not really something that we want to expose to users.
coerceContractId : ContractId a -> ContractId b
coerceContractId = primitive @"BECoerceContractId"
-- | The `Update a` type represents an `Action` to update or query the ledger,
-- before returning a value of type `a`. Examples include `create` and `fetch`.
data Update a =
Update Opaque
instance Functor Update where
fmap f x = x >>= \v -> pure (f v)
instance Applicative Update where
pure = primitive @"UPure"
f <*> x = f >>= \f -> x >>= \x -> pure (f x)
instance Action Update where
(>>=) = primitive @"UBind"
instance ActionFail Update where
#ifdef DAML_EXCEPTIONS
fail m = pure () >>= \_ -> error m
#else
fail = primitive @"UAbort"
#endif
-- | The `HasTime` class is for where the time is available: `Scenario` and `Update`.
class HasTime m where
-- | Get the current time.
getTime : HasCallStack => m Time
instance HasTime Update where
getTime = primitive @"UGetTime"
instance HasTime Scenario where
getTime = primitive @"SGetTime"
-- | The `CanAbort` class is for `Action` s that can be aborted.
class (Action m) => CanAbort m where
-- | Abort the current action with a message.
abort : Text -> m a
instance CanAbort Update where
abort = fail
instance CanAbort Scenario where
abort = fail
instance CanAbort (Either Text) where
abort = fail
-- | The `Scenario` type is for simulating ledger interactions.
-- The type `Scenario a` describes a set of actions taken by various parties during
-- the simulated scenario, before returning a value of type `a`.
data Scenario a =
Scenario Opaque
instance Functor Scenario where
fmap f x = x >>= \v -> pure (f v)
instance Applicative Scenario where
pure = primitive @"SPure"
f <*> x = f >>= \f -> x >>= \x -> pure (f x)
instance Action Scenario where
(>>=) = primitive @"SBind"
instance ActionFail Scenario where
fail = primitive @"SAbort"
class HasSubmit m cmds | m -> cmds, cmds -> m where
-- | `submit p cmds` submits the commands `cmds` as a single transaction
-- from party `p` and returns the value returned by `cmds`.
--
-- If the transaction fails, `submit` also fails.
submit : HasCallStack => Party -> cmds a -> m a
-- | `submitMustFail p cmds` submits the commands `cmds` as a single transaction
-- from party `p`.
--
-- It only succeeds if the submitting the transaction fails.
submitMustFail : HasCallStack => Party -> cmds a -> m ()
instance HasSubmit Scenario Update where
submit = primitive @"SCommit"
submitMustFail = primitive @"SMustFailAt"
infixr 0 `submit`
infixr 0 `submitMustFail`
-- | Declare you are building a scenario.
scenario : Scenario a -> Scenario a
scenario = identity
-- | HIDE A dummy type for the Daml-LF structural record type
-- `<f1: a1, f2: a2>`.
data Pair (f1 : Symbol) (f2 : Symbol) a1 a2 = Pair Opaque
-- | HIDE Function to turn a Daml-LF structural record type into a Daml pair.
unpackPair : forall f1 f2 a1 a2. Pair f1 f2 a1 a2 -> (a1, a2)
unpackPair = magic @"unpackPair"
-- | HIDE Existential type that can wrap an arbitrary type.
-- We do not expose this directly and instead only expose AnyTemplate and AnyChoice.
data Any = Any Opaque
-- | HIDE Value-level representation of a type.
-- We do not expose this directly and instead only expose TemplateTypeRep.
data TypeRep = TypeRep Opaque
#ifdef DAML_TYPE_REP
instance Eq TypeRep where
(==) = primitive @"BEEqual"
instance Ord TypeRep where
(<=) = primitive @"BELessEq"
(>=) = primitive @"BEGreaterEq"
(<) = primitive @"BELess"
(>) = primitive @"BEGreater"
#endif
#ifdef DAML_EXCEPTIONS
-- | A wrapper for all exception types.
data AnyException = AnyException Opaque
#endif