Skip to content

Commit 66cb7e5

Browse files
carbolymercarbolymer
authored
Merge pull request #841 from locallycompact/lc/utxo
Add many more API functions to `Cardano.Api.Tx.UTxO` and format docum…
2 parents 2212091 + 9f2eec1 commit 66cb7e5

2 files changed

Lines changed: 195 additions & 22 deletions

File tree

‎cardano-api/src/Cardano/Api/Internal/Tx/UTxO.hs‎

Lines changed: 138 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@ import Data.Aeson (FromJSON (..), ToJSON (..))
2323
import Data.Aeson qualified as Aeson
2424
import Data.Aeson.KeyMap qualified as KeyMap
2525
import Data.Aeson.Types (Parser)
26+
import Data.List qualified
2627
import Data.Map (Map)
2728
import Data.Map qualified as Map
2829
import Data.MonoTraversable
@@ -66,10 +67,30 @@ instance MonoTraversable (UTxO era) where
6667
otraverse = omapM
6768
omapM f (UTxO utxos) = UTxO <$> omapM f utxos
6869

70+
{--------------------------------------------------------------------
71+
Operators
72+
--------------------------------------------------------------------}
73+
6974
-- | Infix version of `difference`.
7075
(\\) :: UTxO era -> UTxO era -> UTxO era
7176
a \\ b = difference a b
7277

78+
{--------------------------------------------------------------------
79+
Query
80+
--------------------------------------------------------------------}
81+
82+
-- | Find a 'TxOut' for a given 'TxIn'.
83+
lookup :: TxIn -> UTxO era -> Maybe (TxOut CtxUTxO era)
84+
lookup k = Map.lookup k . unUTxO
85+
86+
-- | Synonym for `lookup`.
87+
resolveTxIn :: TxIn -> UTxO era -> Maybe (TxOut CtxUTxO era)
88+
resolveTxIn = Cardano.Api.Internal.Tx.UTxO.lookup
89+
90+
{--------------------------------------------------------------------
91+
Construction
92+
--------------------------------------------------------------------}
93+
7394
-- | Create an empty `UTxO`.
7495
empty :: UTxO era
7596
empty = UTxO Map.empty
@@ -78,46 +99,147 @@ empty = UTxO Map.empty
7899
singleton :: TxIn -> TxOut CtxUTxO era -> UTxO era
79100
singleton i o = UTxO $ Map.singleton i o
80101

81-
-- | Find a 'TxOut' for a given 'TxIn'.
82-
lookup :: TxIn -> UTxO era -> Maybe (TxOut CtxUTxO era)
83-
lookup k = Map.lookup k . unUTxO
102+
{--------------------------------------------------------------------
103+
Insertion
104+
--------------------------------------------------------------------}
84105

85-
-- | Synonym for `lookup`.
86-
resolveTxIn :: TxIn -> UTxO era -> Maybe (TxOut CtxUTxO era)
87-
resolveTxIn = Cardano.Api.Internal.Tx.UTxO.lookup
106+
-- | Insert a new `TxIn` and `TxOut` into the `UTxO`. If the `TxIn` is
107+
-- already present in the `UTxO`, the associated `TxOut` is replaced with
108+
-- the supplied `TxOut`.
109+
insert :: TxIn -> TxOut CtxUTxO era -> UTxO era -> UTxO era
110+
insert k v = UTxO . Map.insert k v . toMap
111+
112+
{--------------------------------------------------------------------
113+
Delete/Update
114+
--------------------------------------------------------------------}
115+
116+
-- | Delete a `TxIn` and `TxOut` from the `UTxO` if it exists. When the `TxIn` is not
117+
-- a member of the `UTxO`, the original `UTxO` is returned.
118+
delete :: TxIn -> UTxO era -> UTxO era
119+
delete k = UTxO . Map.delete k . toMap
120+
121+
-- | Update a `TxOut` corresponding to a specific `TxIn` with the result of the
122+
-- provided function. When the `TxIn` is not a member of the `UTxO`, the
123+
-- original `UTxO` is returned.
124+
adjust :: (TxOut CtxUTxO era -> TxOut CtxUTxO era) -> TxIn -> UTxO era -> UTxO era
125+
adjust f k = UTxO . Map.adjust f k . toMap
126+
127+
{--------------------------------------------------------------------
128+
Union
129+
--------------------------------------------------------------------}
130+
131+
-- | Left-biased union of two `UTxO`.
132+
union :: UTxO era -> UTxO era -> UTxO era
133+
union a b = UTxO $ Map.union (toMap a) (toMap b)
134+
135+
-- | The union of a list of `UTxO`.
136+
unions :: [UTxO era] -> UTxO era
137+
unions = UTxO . Map.unions . fmap toMap
138+
139+
{--------------------------------------------------------------------
140+
Difference
141+
--------------------------------------------------------------------}
142+
143+
-- | Difference of two `UTxO`. Returns elements of the first `UTxO` not existing
144+
-- in the second `UTxO`.
145+
difference :: UTxO era -> UTxO era -> UTxO era
146+
difference a b = UTxO $ Map.difference (toMap a) (toMap b)
147+
148+
{--------------------------------------------------------------------
149+
Intersection
150+
--------------------------------------------------------------------}
151+
152+
intersection :: UTxO era -> UTxO era -> UTxO era
153+
intersection a b = UTxO $ Map.intersection (toMap a) (toMap b)
154+
155+
{--------------------------------------------------------------------
156+
Map
157+
--------------------------------------------------------------------}
158+
159+
-- | Map a function over all `TxOut` in the `UTxO`.
160+
map :: (TxOut CtxUTxO era -> TxOut CtxUTxO era) -> UTxO era -> UTxO era
161+
map f = UTxO . Map.map f . toMap
162+
163+
-- | Map a function over all `TxIn`/`TxOut` in the `UTxO`.
164+
mapWithKey :: (TxIn -> TxOut CtxUTxO era -> TxOut CtxUTxO era) -> UTxO era -> UTxO era
165+
mapWithKey f = UTxO . Map.mapWithKey f . toMap
166+
167+
-- | Map a function over the `TxIn` keys in the `UTxO`.
168+
mapKeys :: (TxIn -> TxIn) -> UTxO era -> UTxO era
169+
mapKeys f = UTxO . Map.mapKeys f . toMap
170+
171+
{--------------------------------------------------------------------
172+
Filter
173+
--------------------------------------------------------------------}
88174

89175
-- | Filter all `TxOut` that satisfy the predicate.
90176
filter :: (TxOut CtxUTxO era -> Bool) -> UTxO era -> UTxO era
91-
filter fn = UTxO . Map.filter fn . unUTxO
177+
filter fn = UTxO . Map.filter fn . toMap
92178

93179
-- | Filter all UTxO to only include 'out's satisfying given predicate.
94180
filterWithKey :: (TxIn -> TxOut CtxUTxO era -> Bool) -> UTxO era -> UTxO era
95-
filterWithKey fn = UTxO . Map.filterWithKey fn . unUTxO
181+
filterWithKey fn = UTxO . Map.filterWithKey fn . toMap
96182

97-
-- | Get the 'UTxO domain input's set
183+
{--------------------------------------------------------------------
184+
Fold
185+
--------------------------------------------------------------------}
186+
187+
-- | Fold the `TxOut`s to a monoid and combine the results.
188+
foldMap :: Monoid m => (TxOut CtxUTxO era -> m) -> UTxO era -> m
189+
foldMap fn = Prelude.foldMap fn . toMap
190+
191+
{--------------------------------------------------------------------
192+
Find
193+
--------------------------------------------------------------------}
194+
195+
-- | Find the first `TxIn`/`TxOut` pair in `UTxO` using the predicate.
196+
find :: (TxOut CtxUTxO era -> Bool) -> UTxO era -> Maybe (TxIn, TxOut CtxUTxO era)
197+
find f = findWithKey (const f)
198+
199+
-- | Find the first `TxIn`/`TxOut` pair in `UTxO` using the predicate.
200+
findWithKey :: (TxIn -> TxOut CtxUTxO era -> Bool) -> UTxO era -> Maybe (TxIn, TxOut CtxUTxO era)
201+
findWithKey f = Data.List.find (uncurry f) . toList
202+
203+
{--------------------------------------------------------------------
204+
Conversion
205+
--------------------------------------------------------------------}
206+
207+
-- | Get the `UTxO`'s `TxIn` `Set`.
98208
inputSet :: UTxO era -> Set TxIn
99209
inputSet = Map.keysSet . unUTxO
100210

101-
-- | Get the UTxO output set.
211+
-- | Get the `UTxO`'s `TxOut` `Set`.
102212
txOutputs :: UTxO era -> [TxOut CtxUTxO era]
103213
txOutputs = Map.elems . unUTxO
104214

105-
-- | Remove the right hand side from the left hand side.
106-
difference :: UTxO era -> UTxO era -> UTxO era
107-
difference a b = UTxO $ Map.difference (unUTxO a) (unUTxO b)
215+
{--------------------------------------------------------------------
216+
Lists
217+
--------------------------------------------------------------------}
108218

109-
-- | Convert from a list of key/value pairs.
219+
-- | Convert to a `List` of `TxIn`/`TxOut` pairs.
110220
fromList :: [(TxIn, TxOut CtxUTxO era)] -> UTxO era
111221
fromList = UTxO . Map.fromList
112222

113-
-- | Convert to a list of key/value pairs.
223+
-- | Convert from a `List` of `TxIn`/`TxOut` pairs.
114224
toList :: UTxO era -> [(TxIn, TxOut CtxUTxO era)]
115225
toList (UTxO xs) = Map.toList xs
116226

117-
-- | Convert to a Map of TxIn/TxOut.
227+
{--------------------------------------------------------------------
228+
Maps
229+
--------------------------------------------------------------------}
230+
231+
-- | Convert to a `Map` of `TxIn`/`TxOut`.
118232
toMap :: UTxO era -> Map TxIn (TxOut CtxUTxO era)
119233
toMap = unUTxO
120234

235+
-- | Convert from a `Map` of `TxIn`/`TxOut`.
236+
fromMap :: Map TxIn (TxOut CtxUTxO era) -> UTxO era
237+
fromMap = UTxO
238+
239+
{--------------------------------------------------------------------
240+
Shelley
241+
--------------------------------------------------------------------}
242+
121243
-- | Convert from a `cardano-api` `UTxO` to a `cardano-ledger` UTxO.
122244
toShelleyUTxO :: ShelleyBasedEra era -> UTxO era -> Ledger.UTxO (ShelleyLedgerEra era)
123245
toShelleyUTxO sbe =

‎cardano-api/src/Cardano/Api/Tx/UTxO.hs‎

Lines changed: 57 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,19 +1,70 @@
11
module Cardano.Api.Tx.UTxO
2-
( UTxO.UTxO (..)
3-
, UTxO.empty
4-
, UTxO.singleton
2+
( -- * UTxO type
3+
UTxO.UTxO (..)
4+
5+
-- * Operators
6+
, (UTxO.\\)
7+
8+
-- * Query
59
, UTxO.lookup
610
, UTxO.resolveTxIn
7-
, UTxO.filter
8-
, UTxO.filterWithKey
11+
12+
-- * Construction
13+
, UTxO.empty
14+
, UTxO.singleton
15+
16+
-- ** Insertion
17+
, UTxO.insert
18+
19+
-- ** Delete/Update
20+
, UTxO.delete
21+
, UTxO.adjust
22+
23+
-- * Combine
24+
25+
-- ** Union
26+
, UTxO.union
27+
, UTxO.unions
28+
29+
-- ** Difference
30+
, UTxO.difference
31+
32+
-- ** Intersection
33+
, UTxO.intersection
34+
35+
-- * Traversal
36+
37+
-- ** Map
38+
, UTxO.map
39+
, UTxO.mapWithKey
40+
, UTxO.mapKeys
41+
42+
-- ** Fold
43+
, UTxO.foldMap
44+
45+
-- * Conversion
946
, UTxO.inputSet
1047
, UTxO.txOutputs
11-
, UTxO.difference
48+
49+
-- ** Lists
1250
, UTxO.fromList
1351
, UTxO.toList
52+
53+
-- ** Maps
1454
, UTxO.toMap
55+
, UTxO.fromMap
56+
57+
-- ** Shelley
1558
, UTxO.fromShelleyUTxO
1659
, UTxO.toShelleyUTxO
60+
61+
-- * Filter
62+
, UTxO.filter
63+
, UTxO.filterWithKey
64+
65+
-- * Find
66+
, UTxO.find
67+
, UTxO.findWithKey
1768
)
1869
where
1970

0 commit comments

Comments
 (0)