{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE TypeApplications #-}
module Cardano.Wallet.Primitive.Types.TokenQuantity
(
TokenQuantity (..)
, zero
, add
, subtract
, pred
, predZero
, succ
, difference
, equipartition
, partition
, partitionDefault
, isNonZero
, isZero
, unsafeSubtract
) where
import Prelude hiding
( pred, subtract, succ )
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
( NonEmpty (..) )
import Data.Maybe
( fromMaybe )
import Data.Text.Class
( FromText (..), ToText (..) )
import Fmt
( Buildable (..) )
import GHC.Generics
( Generic )
import Numeric.Natural
( Natural )
import Quiet
( Quiet (..) )
newtype TokenQuantity = TokenQuantity
{ TokenQuantity -> Natural
unTokenQuantity :: Natural }
deriving stock (TokenQuantity -> TokenQuantity -> Bool
(TokenQuantity -> TokenQuantity -> Bool)
-> (TokenQuantity -> TokenQuantity -> Bool) -> Eq TokenQuantity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenQuantity -> TokenQuantity -> Bool
$c/= :: TokenQuantity -> TokenQuantity -> Bool
== :: TokenQuantity -> TokenQuantity -> Bool
$c== :: TokenQuantity -> TokenQuantity -> Bool
Eq, Eq TokenQuantity
Eq TokenQuantity
-> (TokenQuantity -> TokenQuantity -> Ordering)
-> (TokenQuantity -> TokenQuantity -> Bool)
-> (TokenQuantity -> TokenQuantity -> Bool)
-> (TokenQuantity -> TokenQuantity -> Bool)
-> (TokenQuantity -> TokenQuantity -> Bool)
-> (TokenQuantity -> TokenQuantity -> TokenQuantity)
-> (TokenQuantity -> TokenQuantity -> TokenQuantity)
-> Ord TokenQuantity
TokenQuantity -> TokenQuantity -> Bool
TokenQuantity -> TokenQuantity -> Ordering
TokenQuantity -> TokenQuantity -> TokenQuantity
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
min :: TokenQuantity -> TokenQuantity -> TokenQuantity
$cmin :: TokenQuantity -> TokenQuantity -> TokenQuantity
max :: TokenQuantity -> TokenQuantity -> TokenQuantity
$cmax :: TokenQuantity -> TokenQuantity -> TokenQuantity
>= :: TokenQuantity -> TokenQuantity -> Bool
$c>= :: TokenQuantity -> TokenQuantity -> Bool
> :: TokenQuantity -> TokenQuantity -> Bool
$c> :: TokenQuantity -> TokenQuantity -> Bool
<= :: TokenQuantity -> TokenQuantity -> Bool
$c<= :: TokenQuantity -> TokenQuantity -> Bool
< :: TokenQuantity -> TokenQuantity -> Bool
$c< :: TokenQuantity -> TokenQuantity -> Bool
compare :: TokenQuantity -> TokenQuantity -> Ordering
$ccompare :: TokenQuantity -> TokenQuantity -> Ordering
$cp1Ord :: Eq TokenQuantity
Ord, (forall x. TokenQuantity -> Rep TokenQuantity x)
-> (forall x. Rep TokenQuantity x -> TokenQuantity)
-> Generic TokenQuantity
forall x. Rep TokenQuantity x -> TokenQuantity
forall x. TokenQuantity -> Rep TokenQuantity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenQuantity x -> TokenQuantity
$cfrom :: forall x. TokenQuantity -> Rep TokenQuantity x
Generic)
deriving (ReadPrec [TokenQuantity]
ReadPrec TokenQuantity
Int -> ReadS TokenQuantity
ReadS [TokenQuantity]
(Int -> ReadS TokenQuantity)
-> ReadS [TokenQuantity]
-> ReadPrec TokenQuantity
-> ReadPrec [TokenQuantity]
-> Read TokenQuantity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TokenQuantity]
$creadListPrec :: ReadPrec [TokenQuantity]
readPrec :: ReadPrec TokenQuantity
$creadPrec :: ReadPrec TokenQuantity
readList :: ReadS [TokenQuantity]
$creadList :: ReadS [TokenQuantity]
readsPrec :: Int -> ReadS TokenQuantity
$creadsPrec :: Int -> ReadS TokenQuantity
Read, Int -> TokenQuantity -> ShowS
[TokenQuantity] -> ShowS
TokenQuantity -> String
(Int -> TokenQuantity -> ShowS)
-> (TokenQuantity -> String)
-> ([TokenQuantity] -> ShowS)
-> Show TokenQuantity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenQuantity] -> ShowS
$cshowList :: [TokenQuantity] -> ShowS
show :: TokenQuantity -> String
$cshow :: TokenQuantity -> String
showsPrec :: Int -> TokenQuantity -> ShowS
$cshowsPrec :: Int -> TokenQuantity -> ShowS
Show) via (Quiet TokenQuantity)
deriving anyclass (TokenQuantity -> ()
(TokenQuantity -> ()) -> NFData TokenQuantity
forall a. (a -> ()) -> NFData a
rnf :: TokenQuantity -> ()
$crnf :: TokenQuantity -> ()
NFData, Int -> TokenQuantity -> Int
TokenQuantity -> Int
(Int -> TokenQuantity -> Int)
-> (TokenQuantity -> Int) -> Hashable TokenQuantity
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: TokenQuantity -> Int
$chash :: TokenQuantity -> Int
hashWithSalt :: Int -> TokenQuantity -> Int
$chashWithSalt :: Int -> TokenQuantity -> Int
Hashable)
instance Semigroup TokenQuantity where
<> :: TokenQuantity -> TokenQuantity -> TokenQuantity
(<>) = TokenQuantity -> TokenQuantity -> TokenQuantity
add
instance Monoid TokenQuantity where
mempty :: TokenQuantity
mempty = TokenQuantity
zero
instance Buildable TokenQuantity where
build :: TokenQuantity -> Builder
build = Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder)
-> (TokenQuantity -> Text) -> TokenQuantity -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Text
forall a. ToText a => a -> Text
toText (Natural -> Text)
-> (TokenQuantity -> Natural) -> TokenQuantity -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenQuantity -> Natural
unTokenQuantity
instance ToText TokenQuantity where
toText :: TokenQuantity -> Text
toText = Natural -> Text
forall a. ToText a => a -> Text
toText (Natural -> Text)
-> (TokenQuantity -> Natural) -> TokenQuantity -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenQuantity -> Natural
unTokenQuantity
instance FromText TokenQuantity where
fromText :: Text -> Either TextDecodingError TokenQuantity
fromText = (Integer -> TokenQuantity)
-> Either TextDecodingError Integer
-> Either TextDecodingError TokenQuantity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Natural -> TokenQuantity
TokenQuantity (Natural -> TokenQuantity)
-> (Integer -> Natural) -> Integer -> TokenQuantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. (Integral Integer, Num b) => Integer -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Integer) (Either TextDecodingError Integer
-> Either TextDecodingError TokenQuantity)
-> (Text -> Either TextDecodingError Integer)
-> Text
-> Either TextDecodingError TokenQuantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either TextDecodingError Integer
forall a. FromText a => Text -> Either TextDecodingError a
fromText
instance FromJSON TokenQuantity where
parseJSON :: Value -> Parser TokenQuantity
parseJSON = (Natural -> TokenQuantity)
-> Parser Natural -> Parser TokenQuantity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Natural -> TokenQuantity
TokenQuantity (Parser Natural -> Parser TokenQuantity)
-> (Value -> Parser Natural) -> Value -> Parser TokenQuantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Natural
forall a. FromJSON a => Value -> Parser a
parseJSON
instance ToJSON TokenQuantity where
toJSON :: TokenQuantity -> Value
toJSON = Natural -> Value
forall a. ToJSON a => a -> Value
toJSON (Natural -> Value)
-> (TokenQuantity -> Natural) -> TokenQuantity -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenQuantity -> Natural
unTokenQuantity
zero :: TokenQuantity
zero :: TokenQuantity
zero = Natural -> TokenQuantity
TokenQuantity Natural
0
add :: TokenQuantity -> TokenQuantity -> TokenQuantity
add :: TokenQuantity -> TokenQuantity -> TokenQuantity
add (TokenQuantity Natural
x) (TokenQuantity Natural
y) = Natural -> TokenQuantity
TokenQuantity (Natural -> TokenQuantity) -> Natural -> TokenQuantity
forall a b. (a -> b) -> a -> b
$ Natural
x Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
y
subtract :: TokenQuantity -> TokenQuantity -> Maybe TokenQuantity
subtract :: TokenQuantity -> TokenQuantity -> Maybe TokenQuantity
subtract TokenQuantity
x TokenQuantity
y = Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (TokenQuantity
x TokenQuantity -> TokenQuantity -> Bool
forall a. Ord a => a -> a -> Bool
>= TokenQuantity
y) Maybe () -> TokenQuantity -> Maybe TokenQuantity
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TokenQuantity -> TokenQuantity -> TokenQuantity
unsafeSubtract TokenQuantity
x TokenQuantity
y
pred :: TokenQuantity -> Maybe TokenQuantity
pred :: TokenQuantity -> Maybe TokenQuantity
pred = (TokenQuantity -> TokenQuantity -> Maybe TokenQuantity
`subtract` Natural -> TokenQuantity
TokenQuantity Natural
1)
predZero :: TokenQuantity -> TokenQuantity
predZero :: TokenQuantity -> TokenQuantity
predZero = TokenQuantity -> Maybe TokenQuantity -> TokenQuantity
forall a. a -> Maybe a -> a
fromMaybe TokenQuantity
zero (Maybe TokenQuantity -> TokenQuantity)
-> (TokenQuantity -> Maybe TokenQuantity)
-> TokenQuantity
-> TokenQuantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenQuantity -> Maybe TokenQuantity
pred
succ :: TokenQuantity -> TokenQuantity
succ :: TokenQuantity -> TokenQuantity
succ = (TokenQuantity -> TokenQuantity -> TokenQuantity
`add` Natural -> TokenQuantity
TokenQuantity Natural
1)
difference :: TokenQuantity -> TokenQuantity -> TokenQuantity
difference :: TokenQuantity -> TokenQuantity -> TokenQuantity
difference TokenQuantity
x TokenQuantity
y = TokenQuantity -> Maybe TokenQuantity -> TokenQuantity
forall a. a -> Maybe a -> a
fromMaybe TokenQuantity
zero (Maybe TokenQuantity -> TokenQuantity)
-> Maybe TokenQuantity -> TokenQuantity
forall a b. (a -> b) -> a -> b
$ TokenQuantity -> TokenQuantity -> Maybe TokenQuantity
subtract TokenQuantity
x TokenQuantity
y
equipartition
:: TokenQuantity
-> NonEmpty a
-> NonEmpty TokenQuantity
equipartition :: TokenQuantity -> NonEmpty a -> NonEmpty TokenQuantity
equipartition TokenQuantity
q =
(Natural -> TokenQuantity)
-> NonEmpty Natural -> NonEmpty TokenQuantity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Natural -> TokenQuantity
TokenQuantity (NonEmpty Natural -> NonEmpty TokenQuantity)
-> (NonEmpty a -> NonEmpty Natural)
-> NonEmpty a
-> NonEmpty TokenQuantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> NonEmpty a -> NonEmpty Natural
forall a. HasCallStack => Natural -> NonEmpty a -> NonEmpty Natural
equipartitionNatural (TokenQuantity -> Natural
unTokenQuantity TokenQuantity
q)
partition
:: TokenQuantity
-> NonEmpty TokenQuantity
-> Maybe (NonEmpty TokenQuantity)
partition :: TokenQuantity
-> NonEmpty TokenQuantity -> Maybe (NonEmpty TokenQuantity)
partition TokenQuantity
c
= (NonEmpty Natural -> NonEmpty TokenQuantity)
-> Maybe (NonEmpty Natural) -> Maybe (NonEmpty TokenQuantity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Natural -> TokenQuantity)
-> NonEmpty Natural -> NonEmpty TokenQuantity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Natural -> TokenQuantity
TokenQuantity)
(Maybe (NonEmpty Natural) -> Maybe (NonEmpty TokenQuantity))
-> (NonEmpty TokenQuantity -> Maybe (NonEmpty Natural))
-> NonEmpty TokenQuantity
-> Maybe (NonEmpty TokenQuantity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> NonEmpty Natural -> Maybe (NonEmpty Natural)
partitionNatural (TokenQuantity -> Natural
unTokenQuantity TokenQuantity
c)
(NonEmpty Natural -> Maybe (NonEmpty Natural))
-> (NonEmpty TokenQuantity -> NonEmpty Natural)
-> NonEmpty TokenQuantity
-> Maybe (NonEmpty Natural)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TokenQuantity -> Natural)
-> NonEmpty TokenQuantity -> NonEmpty Natural
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TokenQuantity -> Natural
unTokenQuantity
partitionDefault
:: TokenQuantity
-> NonEmpty TokenQuantity
-> NonEmpty TokenQuantity
partitionDefault :: TokenQuantity -> NonEmpty TokenQuantity -> NonEmpty TokenQuantity
partitionDefault TokenQuantity
q NonEmpty TokenQuantity
ws = NonEmpty TokenQuantity
-> Maybe (NonEmpty TokenQuantity) -> NonEmpty TokenQuantity
forall a. a -> Maybe a -> a
fromMaybe (TokenQuantity -> NonEmpty TokenQuantity -> NonEmpty TokenQuantity
forall a. TokenQuantity -> NonEmpty a -> NonEmpty TokenQuantity
equipartition TokenQuantity
q NonEmpty TokenQuantity
ws) (TokenQuantity
-> NonEmpty TokenQuantity -> Maybe (NonEmpty TokenQuantity)
partition TokenQuantity
q NonEmpty TokenQuantity
ws)
isNonZero :: TokenQuantity -> Bool
isNonZero :: TokenQuantity -> Bool
isNonZero = (TokenQuantity -> TokenQuantity -> Bool
forall a. Eq a => a -> a -> Bool
/= TokenQuantity
zero)
isZero :: TokenQuantity -> Bool
isZero :: TokenQuantity -> Bool
isZero = (TokenQuantity -> TokenQuantity -> Bool
forall a. Eq a => a -> a -> Bool
== TokenQuantity
zero)
unsafeSubtract :: TokenQuantity -> TokenQuantity -> TokenQuantity
unsafeSubtract :: TokenQuantity -> TokenQuantity -> TokenQuantity
unsafeSubtract (TokenQuantity Natural
x) (TokenQuantity Natural
y) = Natural -> TokenQuantity
TokenQuantity (Natural -> TokenQuantity) -> Natural -> TokenQuantity
forall a b. (a -> b) -> a -> b
$ Natural
x Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
y