Skip to content

Commit 2025d04

Browse files
committed
Add MonoTraversable, MonoFoldable, MonoFunctor to the UTxO type
1 parent 2bc2e9a commit 2025d04

File tree

1 file changed

+21
-6
lines changed
  • cardano-api/src/Cardano/Api/Internal/Tx

1 file changed

+21
-6
lines changed

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

Lines changed: 21 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,8 @@
22
{-# LANGUAGE FlexibleContexts #-}
33
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
44
{-# LANGUAGE ScopedTypeVariables #-}
5-
{-# LANGUAGE UndecidableInstances #-}
5+
{-# LANGUAGE StandaloneDeriving #-}
6+
{-# LANGUAGE TypeFamilies #-}
67

78
module Cardano.Api.Internal.Tx.UTxO where
89

@@ -24,22 +25,25 @@ import Data.Aeson.KeyMap qualified as KeyMap
2425
import Data.Aeson.Types (Parser)
2526
import Data.Map (Map)
2627
import Data.Map qualified as Map
28+
import Data.MonoTraversable
2729
import Data.Set (Set)
2830
import Data.Text (Text)
2931
import GHC.Exts qualified as GHC
3032

3133
newtype UTxO era = UTxO {unUTxO :: Map TxIn (TxOut CtxUTxO era)}
3234
deriving stock (Eq, Show)
33-
deriving newtype (Semigroup, Monoid, GHC.IsList)
35+
deriving newtype (Semigroup, Monoid)
36+
37+
instance GHC.IsList (UTxO era) where
38+
type Item (UTxO era) = (TxIn, TxOut CtxUTxO era)
39+
fromList = UTxO . GHC.fromList
40+
toList = GHC.toList . unUTxO
3441

3542
instance IsCardanoEra era => ToJSON (UTxO era) where
3643
toJSON (UTxO m) = toJSON m
3744
toEncoding (UTxO m) = toEncoding m
3845

39-
instance
40-
IsShelleyBasedEra era
41-
=> FromJSON (UTxO era)
42-
where
46+
instance IsShelleyBasedEra era => FromJSON (UTxO era) where
4347
parseJSON = Aeson.withObject "UTxO" $ \hm -> do
4448
let l = GHC.toList $ KeyMap.toHashMapText hm
4549
res <- mapM toTxIn l
@@ -51,6 +55,17 @@ instance
5155
<$> parseJSON (Aeson.String txinText)
5256
<*> parseJSON txOutVal
5357

58+
type instance Element (UTxO era) = TxOut CtxUTxO era
59+
60+
instance MonoFunctor (UTxO era) where
61+
omap f (UTxO utxos) = UTxO $ f <$> utxos
62+
63+
deriving newtype instance MonoFoldable (UTxO era)
64+
65+
instance MonoTraversable (UTxO era) where
66+
otraverse = omapM
67+
omapM f (UTxO utxos) = UTxO <$> omapM f utxos
68+
5469
-- | Infix version of `difference`.
5570
(\\) :: UTxO era -> UTxO era -> UTxO era
5671
a \\ b = difference a b

0 commit comments

Comments
 (0)