From 8983fcf199f34893b6ea27fa86e8ba8b4a3db94d Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 3 May 2023 00:31:23 +0000 Subject: [PATCH 01/15] Add dependency on `commutative-semigroups`. --- lib/primitive/cardano-wallet-primitive.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/primitive/cardano-wallet-primitive.cabal b/lib/primitive/cardano-wallet-primitive.cabal index 2d7447af9b1..47d0fd54240 100644 --- a/lib/primitive/cardano-wallet-primitive.cabal +++ b/lib/primitive/cardano-wallet-primitive.cabal @@ -50,6 +50,7 @@ library , cardano-numeric , cardano-wallet-test-utils , cborg + , commutative-semigroups , containers , cryptonite , delta-types From 622cd16954c12e6bfaef47dc210b003d780f9dac Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 3 May 2023 01:47:43 +0000 Subject: [PATCH 02/15] Add dependency on `monoid-subclasses`. --- lib/primitive/cardano-wallet-primitive.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/lib/primitive/cardano-wallet-primitive.cabal b/lib/primitive/cardano-wallet-primitive.cabal index 47d0fd54240..5e11016f9de 100644 --- a/lib/primitive/cardano-wallet-primitive.cabal +++ b/lib/primitive/cardano-wallet-primitive.cabal @@ -65,6 +65,7 @@ library , lattices , memory , MonadRandom + , monoid-subclasses , network-uri , nothunks , OddWord From f43e209efc2a3a66d14eaccd3dfda3ea306c106c Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 3 May 2023 00:33:31 +0000 Subject: [PATCH 03/15] Remove parentheses from deriving clause for `Coin`. --- lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs index 8d58caee247..ef6f612eb2d 100644 --- a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs +++ b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs @@ -94,7 +94,7 @@ newtype Coin = Coin { unCoin :: Natural } deriving stock (Ord, Eq, Generic) - deriving (Read, Show) via (Quiet Coin) + deriving (Read, Show) via Quiet Coin -- | The 'Semigroup' instance for 'Coin' corresponds to ordinary addition. -- From 8ae5ae052bc81aa3a14f6e08ca2d1942813cc953 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 3 May 2023 01:55:38 +0000 Subject: [PATCH 04/15] Remove parentheses from deriving clause for `TokenQuantity`. --- .../lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs index 94d9fa38942..c60be2fe984 100644 --- a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs +++ b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs @@ -79,8 +79,8 @@ import Quiet newtype TokenQuantity = TokenQuantity { unTokenQuantity :: Natural } deriving stock (Eq, Ord, Generic) - deriving (Read, Show) via (Quiet TokenQuantity) deriving anyclass (NFData, Hashable) + deriving (Read, Show) via Quiet TokenQuantity -------------------------------------------------------------------------------- -- Instances From b01c0bebb1c65c5bfb9706b2a56977931f8f6755 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 3 May 2023 00:36:46 +0000 Subject: [PATCH 05/15] Derive `Semigroup` and `Monoid` for `Coin`. --- .../lib/Cardano/Wallet/Primitive/Types/Coin.hs | 12 +++--------- 1 file changed, 3 insertions(+), 9 deletions(-) diff --git a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs index ef6f612eb2d..7fa10c4755d 100644 --- a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs +++ b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs @@ -63,6 +63,8 @@ import Data.List.NonEmpty ( NonEmpty (..) ) import Data.Maybe ( fromMaybe ) +import Data.Monoid + ( Sum (..) ) import Data.Quantity ( Quantity (..) ) import Data.Text.Class @@ -95,15 +97,7 @@ newtype Coin = Coin } deriving stock (Ord, Eq, Generic) deriving (Read, Show) via Quiet Coin - --- | The 'Semigroup' instance for 'Coin' corresponds to ordinary addition. --- -instance Semigroup Coin where - -- Natural doesn't have a default Semigroup instance. - (<>) = add - -instance Monoid Coin where - mempty = Coin 0 + deriving (Semigroup, Monoid) via Sum Natural instance ToText Coin where toText (Coin c) = T.pack $ show c From 5ae23b93af1eb8b846ad8fcbd1d9f7c38388d30f Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 3 May 2023 01:58:30 +0000 Subject: [PATCH 06/15] Derive `Semigroup` and `Monoid` for `TokenQuantity`. --- .../lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs index c60be2fe984..602dff8b272 100644 --- a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs +++ b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs @@ -52,6 +52,8 @@ import Data.List.NonEmpty ( NonEmpty (..) ) import Data.Maybe ( fromMaybe ) +import Data.Monoid + ( Sum (..) ) import Data.Text.Class ( FromText (..), ToText (..) ) import Fmt @@ -81,17 +83,12 @@ newtype TokenQuantity = TokenQuantity deriving stock (Eq, Ord, Generic) deriving anyclass (NFData, Hashable) deriving (Read, Show) via Quiet TokenQuantity + deriving (Semigroup, Monoid) via Sum Natural -------------------------------------------------------------------------------- -- Instances -------------------------------------------------------------------------------- -instance Semigroup TokenQuantity where - (<>) = add - -instance Monoid TokenQuantity where - mempty = zero - instance Buildable TokenQuantity where build = build . toText . unTokenQuantity From c231e7b33b50ec88237ed1a8240bfff3274b5919 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 3 May 2023 01:48:29 +0000 Subject: [PATCH 07/15] Derive `Semigroup` and `Monoid` subclasses for `Coin`. --- .../lib/Cardano/Wallet/Primitive/Types/Coin.hs | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs index 7fa10c4755d..b8ca0fbf7b7 100644 --- a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs +++ b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs @@ -65,8 +65,18 @@ import Data.Maybe ( fromMaybe ) import Data.Monoid ( Sum (..) ) +import Data.Monoid.Cancellative + ( LeftReductive, Reductive, RightReductive ) +import Data.Monoid.GCD + ( GCDMonoid, LeftGCDMonoid, RightGCDMonoid ) +import Data.Monoid.Monus + ( Monus, OverlappingGCDMonoid ) +import Data.Monoid.Null + ( MonoidNull ) import Data.Quantity ( Quantity (..) ) +import Data.Semigroup.Commutative + ( Commutative ) import Data.Text.Class ( FromText (..), ToText (..) ) import Data.Word @@ -97,7 +107,10 @@ newtype Coin = Coin } deriving stock (Ord, Eq, Generic) deriving (Read, Show) via Quiet Coin - deriving (Semigroup, Monoid) via Sum Natural + deriving (Commutative, Semigroup, Monoid, MonoidNull) via Sum Natural + deriving (LeftReductive, RightReductive, Reductive) via Sum Natural + deriving (LeftGCDMonoid, RightGCDMonoid, GCDMonoid) via Sum Natural + deriving (OverlappingGCDMonoid, Monus) via Sum Natural instance ToText Coin where toText (Coin c) = T.pack $ show c From ccb09d7deef57b27058c54c02df98742d2a6b527 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 3 May 2023 02:01:16 +0000 Subject: [PATCH 08/15] Derive `Semigroup` and `Monoid` subclasses for `TokenQuantity`. --- .../Wallet/Primitive/Types/TokenQuantity.hs | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs index 602dff8b272..ba90097b46a 100644 --- a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs +++ b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs @@ -54,6 +54,16 @@ import Data.Maybe ( fromMaybe ) import Data.Monoid ( Sum (..) ) +import Data.Monoid.Cancellative + ( LeftReductive, Reductive, RightReductive ) +import Data.Monoid.GCD + ( GCDMonoid, LeftGCDMonoid, RightGCDMonoid ) +import Data.Monoid.Monus + ( Monus, OverlappingGCDMonoid ) +import Data.Monoid.Null + ( MonoidNull ) +import Data.Semigroup.Commutative + ( Commutative ) import Data.Text.Class ( FromText (..), ToText (..) ) import Fmt @@ -83,7 +93,10 @@ newtype TokenQuantity = TokenQuantity deriving stock (Eq, Ord, Generic) deriving anyclass (NFData, Hashable) deriving (Read, Show) via Quiet TokenQuantity - deriving (Semigroup, Monoid) via Sum Natural + deriving (Commutative, Semigroup, Monoid, MonoidNull) via Sum Natural + deriving (LeftReductive, RightReductive, Reductive) via Sum Natural + deriving (LeftGCDMonoid, RightGCDMonoid, GCDMonoid) via Sum Natural + deriving (OverlappingGCDMonoid, Monus) via Sum Natural -------------------------------------------------------------------------------- -- Instances From 59dfafce71bc3f575447dd77823eeaf42a69bd5c Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 3 May 2023 01:42:28 +0000 Subject: [PATCH 09/15] Simplify definition of `Coin.add`. --- lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs index b8ca0fbf7b7..5d428524f07 100644 --- a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs +++ b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs @@ -266,7 +266,7 @@ subtract (Coin a) (Coin b) -- | Calculates the combined value of two coins. -- add :: Coin -> Coin -> Coin -add (Coin a) (Coin b) = Coin (a + b) +add = (<>) -- | Subtracts the second coin from the first. -- From b4cfeea82dc6ca7d7ec2ef371a5a75bc6a7e73aa Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 3 May 2023 01:50:07 +0000 Subject: [PATCH 10/15] Simplify definition of `Coin.subtract`. --- lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs index 5d428524f07..4dc6ecf26c6 100644 --- a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs +++ b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs @@ -66,7 +66,7 @@ import Data.Maybe import Data.Monoid ( Sum (..) ) import Data.Monoid.Cancellative - ( LeftReductive, Reductive, RightReductive ) + ( LeftReductive, Reductive (()), RightReductive ) import Data.Monoid.GCD ( GCDMonoid, LeftGCDMonoid, RightGCDMonoid ) import Data.Monoid.Monus @@ -259,9 +259,7 @@ unsafeToWord64 c = fromMaybe onError (toWord64Maybe c) -- Returns 'Nothing' if the second coin is strictly greater than the first. -- subtract :: Coin -> Coin -> Maybe Coin -subtract (Coin a) (Coin b) - | a >= b = Just $ Coin (a - b) - | otherwise = Nothing +subtract = () -- | Calculates the combined value of two coins. -- From 5d73962236dc2391d823967e708fa014a0662ff5 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 3 May 2023 01:50:55 +0000 Subject: [PATCH 11/15] Simplify definition of `Coin.difference`. --- lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs index 4dc6ecf26c6..4874663dedc 100644 --- a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs +++ b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs @@ -70,7 +70,7 @@ import Data.Monoid.Cancellative import Data.Monoid.GCD ( GCDMonoid, LeftGCDMonoid, RightGCDMonoid ) import Data.Monoid.Monus - ( Monus, OverlappingGCDMonoid ) + ( Monus ((<\>)), OverlappingGCDMonoid ) import Data.Monoid.Null ( MonoidNull ) import Data.Quantity @@ -271,7 +271,7 @@ add = (<>) -- Returns 'Coin 0' if the second coin is strictly greater than the first. -- difference :: Coin -> Coin -> Coin -difference a b = fromMaybe (Coin 0) (subtract a b) +difference = (<\>) -- | Absolute difference between two coin amounts. The result is never negative. distance :: Coin -> Coin -> Coin From a0c8bfc35f1cb2081425129333e115f98c1da671 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 3 May 2023 01:52:07 +0000 Subject: [PATCH 12/15] Simplify definition of `Coin.distance`. --- lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs index 4874663dedc..61b53998e0d 100644 --- a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs +++ b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/Coin.hs @@ -275,7 +275,7 @@ difference = (<\>) -- | Absolute difference between two coin amounts. The result is never negative. distance :: Coin -> Coin -> Coin -distance (Coin a) (Coin b) = if a < b then Coin (b - a) else Coin (a - b) +distance a b = (a <\> b) <> (b <\> a) -------------------------------------------------------------------------------- -- Partitioning From 423836dedb1b7ee2e1e3d3fb333d3f203351d2e6 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 3 May 2023 01:59:06 +0000 Subject: [PATCH 13/15] Simplify definition of `TokenQuantity.add`. --- .../lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs index ba90097b46a..6e090096445 100644 --- a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs +++ b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs @@ -128,7 +128,7 @@ zero = TokenQuantity 0 -------------------------------------------------------------------------------- add :: TokenQuantity -> TokenQuantity -> TokenQuantity -add (TokenQuantity x) (TokenQuantity y) = TokenQuantity $ x + y +add = (<>) -- | Subtracts the second token quantity from the first. -- From 77af2514e5d94317fe75a3a85fb512b8347116c7 Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 3 May 2023 02:02:26 +0000 Subject: [PATCH 14/15] Simplify definition of `TokenQuantity.subtract`. --- .../lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs index 6e090096445..3738920e825 100644 --- a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs +++ b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs @@ -40,12 +40,8 @@ import Cardano.Numeric.Util ( equipartitionNatural, partitionNatural ) import Control.DeepSeq ( NFData (..) ) -import Control.Monad - ( guard ) import Data.Aeson ( FromJSON (..), ToJSON (..) ) -import Data.Functor - ( ($>) ) import Data.Hashable ( Hashable ) import Data.List.NonEmpty @@ -55,7 +51,7 @@ import Data.Maybe import Data.Monoid ( Sum (..) ) import Data.Monoid.Cancellative - ( LeftReductive, Reductive, RightReductive ) + ( LeftReductive, Reductive (()), RightReductive ) import Data.Monoid.GCD ( GCDMonoid, LeftGCDMonoid, RightGCDMonoid ) import Data.Monoid.Monus @@ -135,7 +131,7 @@ add = (<>) -- Returns 'Nothing' if the first quantity is less than the second quantity. -- subtract :: TokenQuantity -> TokenQuantity -> Maybe TokenQuantity -subtract x y = guard (x >= y) $> unsafeSubtract x y +subtract = () -- | Finds the predecessor of a given token quantity. -- From 8fee775ff9888138ce0edf4cd64ae0733796784f Mon Sep 17 00:00:00 2001 From: Jonathan Knowles Date: Wed, 3 May 2023 02:03:34 +0000 Subject: [PATCH 15/15] Simplify definition of `TokenQuantity.difference`. --- .../lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs index 3738920e825..ad6f74b44a1 100644 --- a/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs +++ b/lib/primitive/lib/Cardano/Wallet/Primitive/Types/TokenQuantity.hs @@ -55,7 +55,7 @@ import Data.Monoid.Cancellative import Data.Monoid.GCD ( GCDMonoid, LeftGCDMonoid, RightGCDMonoid ) import Data.Monoid.Monus - ( Monus, OverlappingGCDMonoid ) + ( Monus ((<\>)), OverlappingGCDMonoid ) import Data.Monoid.Null ( MonoidNull ) import Data.Semigroup.Commutative @@ -161,7 +161,7 @@ succ = (`add` TokenQuantity 1) -- Returns 'zero' if the first quantity is less than the second quantity. -- difference :: TokenQuantity -> TokenQuantity -> TokenQuantity -difference x y = fromMaybe zero $ subtract x y +difference = (<\>) -------------------------------------------------------------------------------- -- Partitioning