{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}

module Cardano.Ledger.Coin
  ( Coin (..),
    CompactForm (..),
    DeltaCoin (..),
    word64ToCoin,
    coinToRational,
    rationalToCoinViaFloor,
    rationalToCoinViaCeiling,
    addDeltaCoin,
    toDeltaCoin,
    integerToWord64,
  )
where

import Cardano.Binary (FromCBOR (..), ToCBOR (..))
import Cardano.Ledger.Compactible
import Cardano.Prelude (HeapWords)
import Control.DeepSeq (NFData)
import Data.Aeson (FromJSON, ToJSON)
import Data.Group (Abelian, Group (..))
import Data.Monoid (Sum (..))
import Data.PartialOrd (PartialOrd)
import Data.Primitive.Types
import Data.Typeable (Typeable)
import Data.Word (Word64)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Quiet

-- | The amount of value held by a transaction output.
newtype Coin = Coin {Coin -> Integer
unCoin :: Integer}
  deriving
    ( Coin -> Coin -> Bool
(Coin -> Coin -> Bool) -> (Coin -> Coin -> Bool) -> Eq Coin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Coin -> Coin -> Bool
$c/= :: Coin -> Coin -> Bool
== :: Coin -> Coin -> Bool
$c== :: Coin -> Coin -> Bool
Eq,
      Eq Coin
Eq Coin
-> (Coin -> Coin -> Ordering)
-> (Coin -> Coin -> Bool)
-> (Coin -> Coin -> Bool)
-> (Coin -> Coin -> Bool)
-> (Coin -> Coin -> Bool)
-> (Coin -> Coin -> Coin)
-> (Coin -> Coin -> Coin)
-> Ord Coin
Coin -> Coin -> Bool
Coin -> Coin -> Ordering
Coin -> Coin -> Coin
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 :: Coin -> Coin -> Coin
$cmin :: Coin -> Coin -> Coin
max :: Coin -> Coin -> Coin
$cmax :: Coin -> Coin -> Coin
>= :: Coin -> Coin -> Bool
$c>= :: Coin -> Coin -> Bool
> :: Coin -> Coin -> Bool
$c> :: Coin -> Coin -> Bool
<= :: Coin -> Coin -> Bool
$c<= :: Coin -> Coin -> Bool
< :: Coin -> Coin -> Bool
$c< :: Coin -> Coin -> Bool
compare :: Coin -> Coin -> Ordering
$ccompare :: Coin -> Coin -> Ordering
$cp1Ord :: Eq Coin
Ord,
      Int -> Coin
Coin -> Int
Coin -> [Coin]
Coin -> Coin
Coin -> Coin -> [Coin]
Coin -> Coin -> Coin -> [Coin]
(Coin -> Coin)
-> (Coin -> Coin)
-> (Int -> Coin)
-> (Coin -> Int)
-> (Coin -> [Coin])
-> (Coin -> Coin -> [Coin])
-> (Coin -> Coin -> [Coin])
-> (Coin -> Coin -> Coin -> [Coin])
-> Enum Coin
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Coin -> Coin -> Coin -> [Coin]
$cenumFromThenTo :: Coin -> Coin -> Coin -> [Coin]
enumFromTo :: Coin -> Coin -> [Coin]
$cenumFromTo :: Coin -> Coin -> [Coin]
enumFromThen :: Coin -> Coin -> [Coin]
$cenumFromThen :: Coin -> Coin -> [Coin]
enumFrom :: Coin -> [Coin]
$cenumFrom :: Coin -> [Coin]
fromEnum :: Coin -> Int
$cfromEnum :: Coin -> Int
toEnum :: Int -> Coin
$ctoEnum :: Int -> Coin
pred :: Coin -> Coin
$cpred :: Coin -> Coin
succ :: Coin -> Coin
$csucc :: Coin -> Coin
Enum,
      Context -> Coin -> IO (Maybe ThunkInfo)
Proxy Coin -> String
(Context -> Coin -> IO (Maybe ThunkInfo))
-> (Context -> Coin -> IO (Maybe ThunkInfo))
-> (Proxy Coin -> String)
-> NoThunks Coin
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy Coin -> String
$cshowTypeOf :: Proxy Coin -> String
wNoThunks :: Context -> Coin -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Coin -> IO (Maybe ThunkInfo)
noThunks :: Context -> Coin -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> Coin -> IO (Maybe ThunkInfo)
NoThunks,
      (forall x. Coin -> Rep Coin x)
-> (forall x. Rep Coin x -> Coin) -> Generic Coin
forall x. Rep Coin x -> Coin
forall x. Coin -> Rep Coin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Coin x -> Coin
$cfrom :: forall x. Coin -> Rep Coin x
Generic,
      [Coin] -> Encoding
[Coin] -> Value
Coin -> Encoding
Coin -> Value
(Coin -> Value)
-> (Coin -> Encoding)
-> ([Coin] -> Value)
-> ([Coin] -> Encoding)
-> ToJSON Coin
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Coin] -> Encoding
$ctoEncodingList :: [Coin] -> Encoding
toJSONList :: [Coin] -> Value
$ctoJSONList :: [Coin] -> Value
toEncoding :: Coin -> Encoding
$ctoEncoding :: Coin -> Encoding
toJSON :: Coin -> Value
$ctoJSON :: Coin -> Value
ToJSON,
      Value -> Parser [Coin]
Value -> Parser Coin
(Value -> Parser Coin) -> (Value -> Parser [Coin]) -> FromJSON Coin
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Coin]
$cparseJSONList :: Value -> Parser [Coin]
parseJSON :: Value -> Parser Coin
$cparseJSON :: Value -> Parser Coin
FromJSON,
      Coin -> ()
(Coin -> ()) -> NFData Coin
forall a. (a -> ()) -> NFData a
rnf :: Coin -> ()
$crnf :: Coin -> ()
NFData
    )
  deriving (Int -> Coin -> ShowS
[Coin] -> ShowS
Coin -> String
(Int -> Coin -> ShowS)
-> (Coin -> String) -> ([Coin] -> ShowS) -> Show Coin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Coin] -> ShowS
$cshowList :: [Coin] -> ShowS
show :: Coin -> String
$cshow :: Coin -> String
showsPrec :: Int -> Coin -> ShowS
$cshowsPrec :: Int -> Coin -> ShowS
Show) via Quiet Coin
  deriving (b -> Coin -> Coin
NonEmpty Coin -> Coin
Coin -> Coin -> Coin
(Coin -> Coin -> Coin)
-> (NonEmpty Coin -> Coin)
-> (forall b. Integral b => b -> Coin -> Coin)
-> Semigroup Coin
forall b. Integral b => b -> Coin -> Coin
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Coin -> Coin
$cstimes :: forall b. Integral b => b -> Coin -> Coin
sconcat :: NonEmpty Coin -> Coin
$csconcat :: NonEmpty Coin -> Coin
<> :: Coin -> Coin -> Coin
$c<> :: Coin -> Coin -> Coin
Semigroup, Semigroup Coin
Coin
Semigroup Coin
-> Coin
-> (Coin -> Coin -> Coin)
-> ([Coin] -> Coin)
-> Monoid Coin
[Coin] -> Coin
Coin -> Coin -> Coin
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Coin] -> Coin
$cmconcat :: [Coin] -> Coin
mappend :: Coin -> Coin -> Coin
$cmappend :: Coin -> Coin -> Coin
mempty :: Coin
$cmempty :: Coin
$cp1Monoid :: Semigroup Coin
Monoid, Monoid Coin
Monoid Coin
-> (Coin -> Coin)
-> (Coin -> Coin -> Coin)
-> (forall x. Integral x => Coin -> x -> Coin)
-> Group Coin
Coin -> Coin
Coin -> x -> Coin
Coin -> Coin -> Coin
forall x. Integral x => Coin -> x -> Coin
forall m.
Monoid m
-> (m -> m)
-> (m -> m -> m)
-> (forall x. Integral x => m -> x -> m)
-> Group m
pow :: Coin -> x -> Coin
$cpow :: forall x. Integral x => Coin -> x -> Coin
~~ :: Coin -> Coin -> Coin
$c~~ :: Coin -> Coin -> Coin
invert :: Coin -> Coin
$cinvert :: Coin -> Coin
$cp1Group :: Monoid Coin
Group, Group Coin
Group Coin -> Abelian Coin
forall g. Group g -> Abelian g
Abelian) via Sum Integer
  deriving newtype (Coin -> Coin -> Bool
Coin -> Coin -> Maybe Ordering
(Coin -> Coin -> Bool)
-> (Coin -> Coin -> Bool)
-> (Coin -> Coin -> Bool)
-> (Coin -> Coin -> Bool)
-> (Coin -> Coin -> Bool)
-> (Coin -> Coin -> Bool)
-> (Coin -> Coin -> Maybe Ordering)
-> PartialOrd Coin
forall a.
(a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Maybe Ordering)
-> PartialOrd a
compare :: Coin -> Coin -> Maybe Ordering
$ccompare :: Coin -> Coin -> Maybe Ordering
> :: Coin -> Coin -> Bool
$c> :: Coin -> Coin -> Bool
< :: Coin -> Coin -> Bool
$c< :: Coin -> Coin -> Bool
/= :: Coin -> Coin -> Bool
$c/= :: Coin -> Coin -> Bool
== :: Coin -> Coin -> Bool
$c== :: Coin -> Coin -> Bool
>= :: Coin -> Coin -> Bool
$c>= :: Coin -> Coin -> Bool
<= :: Coin -> Coin -> Bool
$c<= :: Coin -> Coin -> Bool
PartialOrd, Typeable Coin
Decoder s Coin
Typeable Coin
-> (forall s. Decoder s Coin)
-> (Proxy Coin -> Text)
-> FromCBOR Coin
Proxy Coin -> Text
forall s. Decoder s Coin
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
label :: Proxy Coin -> Text
$clabel :: Proxy Coin -> Text
fromCBOR :: Decoder s Coin
$cfromCBOR :: forall s. Decoder s Coin
$cp1FromCBOR :: Typeable Coin
FromCBOR, Typeable Coin
Typeable Coin
-> (Coin -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy Coin -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Coin] -> Size)
-> ToCBOR Coin
Coin -> Encoding
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Coin] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy Coin -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Coin] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Coin] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Coin -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Coin -> Size
toCBOR :: Coin -> Encoding
$ctoCBOR :: Coin -> Encoding
$cp1ToCBOR :: Typeable Coin
ToCBOR, Coin -> Int
(Coin -> Int) -> HeapWords Coin
forall a. (a -> Int) -> HeapWords a
heapWords :: Coin -> Int
$cheapWords :: Coin -> Int
HeapWords)

newtype DeltaCoin = DeltaCoin Integer
  deriving (DeltaCoin -> DeltaCoin -> Bool
(DeltaCoin -> DeltaCoin -> Bool)
-> (DeltaCoin -> DeltaCoin -> Bool) -> Eq DeltaCoin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeltaCoin -> DeltaCoin -> Bool
$c/= :: DeltaCoin -> DeltaCoin -> Bool
== :: DeltaCoin -> DeltaCoin -> Bool
$c== :: DeltaCoin -> DeltaCoin -> Bool
Eq, Eq DeltaCoin
Eq DeltaCoin
-> (DeltaCoin -> DeltaCoin -> Ordering)
-> (DeltaCoin -> DeltaCoin -> Bool)
-> (DeltaCoin -> DeltaCoin -> Bool)
-> (DeltaCoin -> DeltaCoin -> Bool)
-> (DeltaCoin -> DeltaCoin -> Bool)
-> (DeltaCoin -> DeltaCoin -> DeltaCoin)
-> (DeltaCoin -> DeltaCoin -> DeltaCoin)
-> Ord DeltaCoin
DeltaCoin -> DeltaCoin -> Bool
DeltaCoin -> DeltaCoin -> Ordering
DeltaCoin -> DeltaCoin -> DeltaCoin
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 :: DeltaCoin -> DeltaCoin -> DeltaCoin
$cmin :: DeltaCoin -> DeltaCoin -> DeltaCoin
max :: DeltaCoin -> DeltaCoin -> DeltaCoin
$cmax :: DeltaCoin -> DeltaCoin -> DeltaCoin
>= :: DeltaCoin -> DeltaCoin -> Bool
$c>= :: DeltaCoin -> DeltaCoin -> Bool
> :: DeltaCoin -> DeltaCoin -> Bool
$c> :: DeltaCoin -> DeltaCoin -> Bool
<= :: DeltaCoin -> DeltaCoin -> Bool
$c<= :: DeltaCoin -> DeltaCoin -> Bool
< :: DeltaCoin -> DeltaCoin -> Bool
$c< :: DeltaCoin -> DeltaCoin -> Bool
compare :: DeltaCoin -> DeltaCoin -> Ordering
$ccompare :: DeltaCoin -> DeltaCoin -> Ordering
$cp1Ord :: Eq DeltaCoin
Ord, (forall x. DeltaCoin -> Rep DeltaCoin x)
-> (forall x. Rep DeltaCoin x -> DeltaCoin) -> Generic DeltaCoin
forall x. Rep DeltaCoin x -> DeltaCoin
forall x. DeltaCoin -> Rep DeltaCoin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeltaCoin x -> DeltaCoin
$cfrom :: forall x. DeltaCoin -> Rep DeltaCoin x
Generic, Int -> DeltaCoin
DeltaCoin -> Int
DeltaCoin -> [DeltaCoin]
DeltaCoin -> DeltaCoin
DeltaCoin -> DeltaCoin -> [DeltaCoin]
DeltaCoin -> DeltaCoin -> DeltaCoin -> [DeltaCoin]
(DeltaCoin -> DeltaCoin)
-> (DeltaCoin -> DeltaCoin)
-> (Int -> DeltaCoin)
-> (DeltaCoin -> Int)
-> (DeltaCoin -> [DeltaCoin])
-> (DeltaCoin -> DeltaCoin -> [DeltaCoin])
-> (DeltaCoin -> DeltaCoin -> [DeltaCoin])
-> (DeltaCoin -> DeltaCoin -> DeltaCoin -> [DeltaCoin])
-> Enum DeltaCoin
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DeltaCoin -> DeltaCoin -> DeltaCoin -> [DeltaCoin]
$cenumFromThenTo :: DeltaCoin -> DeltaCoin -> DeltaCoin -> [DeltaCoin]
enumFromTo :: DeltaCoin -> DeltaCoin -> [DeltaCoin]
$cenumFromTo :: DeltaCoin -> DeltaCoin -> [DeltaCoin]
enumFromThen :: DeltaCoin -> DeltaCoin -> [DeltaCoin]
$cenumFromThen :: DeltaCoin -> DeltaCoin -> [DeltaCoin]
enumFrom :: DeltaCoin -> [DeltaCoin]
$cenumFrom :: DeltaCoin -> [DeltaCoin]
fromEnum :: DeltaCoin -> Int
$cfromEnum :: DeltaCoin -> Int
toEnum :: Int -> DeltaCoin
$ctoEnum :: Int -> DeltaCoin
pred :: DeltaCoin -> DeltaCoin
$cpred :: DeltaCoin -> DeltaCoin
succ :: DeltaCoin -> DeltaCoin
$csucc :: DeltaCoin -> DeltaCoin
Enum, Context -> DeltaCoin -> IO (Maybe ThunkInfo)
Proxy DeltaCoin -> String
(Context -> DeltaCoin -> IO (Maybe ThunkInfo))
-> (Context -> DeltaCoin -> IO (Maybe ThunkInfo))
-> (Proxy DeltaCoin -> String)
-> NoThunks DeltaCoin
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy DeltaCoin -> String
$cshowTypeOf :: Proxy DeltaCoin -> String
wNoThunks :: Context -> DeltaCoin -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> DeltaCoin -> IO (Maybe ThunkInfo)
noThunks :: Context -> DeltaCoin -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> DeltaCoin -> IO (Maybe ThunkInfo)
NoThunks, DeltaCoin -> ()
(DeltaCoin -> ()) -> NFData DeltaCoin
forall a. (a -> ()) -> NFData a
rnf :: DeltaCoin -> ()
$crnf :: DeltaCoin -> ()
NFData, Typeable DeltaCoin
Decoder s DeltaCoin
Typeable DeltaCoin
-> (forall s. Decoder s DeltaCoin)
-> (Proxy DeltaCoin -> Text)
-> FromCBOR DeltaCoin
Proxy DeltaCoin -> Text
forall s. Decoder s DeltaCoin
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
label :: Proxy DeltaCoin -> Text
$clabel :: Proxy DeltaCoin -> Text
fromCBOR :: Decoder s DeltaCoin
$cfromCBOR :: forall s. Decoder s DeltaCoin
$cp1FromCBOR :: Typeable DeltaCoin
FromCBOR, Typeable DeltaCoin
Typeable DeltaCoin
-> (DeltaCoin -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy DeltaCoin -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [DeltaCoin] -> Size)
-> ToCBOR DeltaCoin
DeltaCoin -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [DeltaCoin] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy DeltaCoin -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [DeltaCoin] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [DeltaCoin] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy DeltaCoin -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy DeltaCoin -> Size
toCBOR :: DeltaCoin -> Encoding
$ctoCBOR :: DeltaCoin -> Encoding
$cp1ToCBOR :: Typeable DeltaCoin
ToCBOR, DeltaCoin -> Int
(DeltaCoin -> Int) -> HeapWords DeltaCoin
forall a. (a -> Int) -> HeapWords a
heapWords :: DeltaCoin -> Int
$cheapWords :: DeltaCoin -> Int
HeapWords)
  deriving (Int -> DeltaCoin -> ShowS
[DeltaCoin] -> ShowS
DeltaCoin -> String
(Int -> DeltaCoin -> ShowS)
-> (DeltaCoin -> String)
-> ([DeltaCoin] -> ShowS)
-> Show DeltaCoin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeltaCoin] -> ShowS
$cshowList :: [DeltaCoin] -> ShowS
show :: DeltaCoin -> String
$cshow :: DeltaCoin -> String
showsPrec :: Int -> DeltaCoin -> ShowS
$cshowsPrec :: Int -> DeltaCoin -> ShowS
Show) via Quiet DeltaCoin
  deriving (b -> DeltaCoin -> DeltaCoin
NonEmpty DeltaCoin -> DeltaCoin
DeltaCoin -> DeltaCoin -> DeltaCoin
(DeltaCoin -> DeltaCoin -> DeltaCoin)
-> (NonEmpty DeltaCoin -> DeltaCoin)
-> (forall b. Integral b => b -> DeltaCoin -> DeltaCoin)
-> Semigroup DeltaCoin
forall b. Integral b => b -> DeltaCoin -> DeltaCoin
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> DeltaCoin -> DeltaCoin
$cstimes :: forall b. Integral b => b -> DeltaCoin -> DeltaCoin
sconcat :: NonEmpty DeltaCoin -> DeltaCoin
$csconcat :: NonEmpty DeltaCoin -> DeltaCoin
<> :: DeltaCoin -> DeltaCoin -> DeltaCoin
$c<> :: DeltaCoin -> DeltaCoin -> DeltaCoin
Semigroup, Semigroup DeltaCoin
DeltaCoin
Semigroup DeltaCoin
-> DeltaCoin
-> (DeltaCoin -> DeltaCoin -> DeltaCoin)
-> ([DeltaCoin] -> DeltaCoin)
-> Monoid DeltaCoin
[DeltaCoin] -> DeltaCoin
DeltaCoin -> DeltaCoin -> DeltaCoin
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [DeltaCoin] -> DeltaCoin
$cmconcat :: [DeltaCoin] -> DeltaCoin
mappend :: DeltaCoin -> DeltaCoin -> DeltaCoin
$cmappend :: DeltaCoin -> DeltaCoin -> DeltaCoin
mempty :: DeltaCoin
$cmempty :: DeltaCoin
$cp1Monoid :: Semigroup DeltaCoin
Monoid, Monoid DeltaCoin
Monoid DeltaCoin
-> (DeltaCoin -> DeltaCoin)
-> (DeltaCoin -> DeltaCoin -> DeltaCoin)
-> (forall x. Integral x => DeltaCoin -> x -> DeltaCoin)
-> Group DeltaCoin
DeltaCoin -> DeltaCoin
DeltaCoin -> x -> DeltaCoin
DeltaCoin -> DeltaCoin -> DeltaCoin
forall x. Integral x => DeltaCoin -> x -> DeltaCoin
forall m.
Monoid m
-> (m -> m)
-> (m -> m -> m)
-> (forall x. Integral x => m -> x -> m)
-> Group m
pow :: DeltaCoin -> x -> DeltaCoin
$cpow :: forall x. Integral x => DeltaCoin -> x -> DeltaCoin
~~ :: DeltaCoin -> DeltaCoin -> DeltaCoin
$c~~ :: DeltaCoin -> DeltaCoin -> DeltaCoin
invert :: DeltaCoin -> DeltaCoin
$cinvert :: DeltaCoin -> DeltaCoin
$cp1Group :: Monoid DeltaCoin
Group, Group DeltaCoin
Group DeltaCoin -> Abelian DeltaCoin
forall g. Group g -> Abelian g
Abelian) via Sum Integer
  deriving newtype (DeltaCoin -> DeltaCoin -> Bool
DeltaCoin -> DeltaCoin -> Maybe Ordering
(DeltaCoin -> DeltaCoin -> Bool)
-> (DeltaCoin -> DeltaCoin -> Bool)
-> (DeltaCoin -> DeltaCoin -> Bool)
-> (DeltaCoin -> DeltaCoin -> Bool)
-> (DeltaCoin -> DeltaCoin -> Bool)
-> (DeltaCoin -> DeltaCoin -> Bool)
-> (DeltaCoin -> DeltaCoin -> Maybe Ordering)
-> PartialOrd DeltaCoin
forall a.
(a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Maybe Ordering)
-> PartialOrd a
compare :: DeltaCoin -> DeltaCoin -> Maybe Ordering
$ccompare :: DeltaCoin -> DeltaCoin -> Maybe Ordering
> :: DeltaCoin -> DeltaCoin -> Bool
$c> :: DeltaCoin -> DeltaCoin -> Bool
< :: DeltaCoin -> DeltaCoin -> Bool
$c< :: DeltaCoin -> DeltaCoin -> Bool
/= :: DeltaCoin -> DeltaCoin -> Bool
$c/= :: DeltaCoin -> DeltaCoin -> Bool
== :: DeltaCoin -> DeltaCoin -> Bool
$c== :: DeltaCoin -> DeltaCoin -> Bool
>= :: DeltaCoin -> DeltaCoin -> Bool
$c>= :: DeltaCoin -> DeltaCoin -> Bool
<= :: DeltaCoin -> DeltaCoin -> Bool
$c<= :: DeltaCoin -> DeltaCoin -> Bool
PartialOrd)

addDeltaCoin :: Coin -> DeltaCoin -> Coin
addDeltaCoin :: Coin -> DeltaCoin -> Coin
addDeltaCoin (Coin Integer
x) (DeltaCoin Integer
y) = Integer -> Coin
Coin (Integer
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
y)

toDeltaCoin :: Coin -> DeltaCoin
toDeltaCoin :: Coin -> DeltaCoin
toDeltaCoin (Coin Integer
x) = Integer -> DeltaCoin
DeltaCoin Integer
x

word64ToCoin :: Word64 -> Coin
word64ToCoin :: Word64 -> Coin
word64ToCoin = Integer -> Coin
Coin (Integer -> Coin) -> (Word64 -> Integer) -> Word64 -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral

coinToRational :: Coin -> Rational
coinToRational :: Coin -> Rational
coinToRational (Coin Integer
c) = Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
c

rationalToCoinViaFloor :: Rational -> Coin
rationalToCoinViaFloor :: Rational -> Coin
rationalToCoinViaFloor = Integer -> Coin
Coin (Integer -> Coin) -> (Rational -> Integer) -> Rational -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor

rationalToCoinViaCeiling :: Rational -> Coin
rationalToCoinViaCeiling :: Rational -> Coin
rationalToCoinViaCeiling = Integer -> Coin
Coin (Integer -> Coin) -> (Rational -> Integer) -> Rational -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling

instance Compactible Coin where
  newtype CompactForm Coin = CompactCoin Word64
    deriving (CompactForm Coin -> CompactForm Coin -> Bool
(CompactForm Coin -> CompactForm Coin -> Bool)
-> (CompactForm Coin -> CompactForm Coin -> Bool)
-> Eq (CompactForm Coin)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompactForm Coin -> CompactForm Coin -> Bool
$c/= :: CompactForm Coin -> CompactForm Coin -> Bool
== :: CompactForm Coin -> CompactForm Coin -> Bool
$c== :: CompactForm Coin -> CompactForm Coin -> Bool
Eq, Int -> CompactForm Coin -> ShowS
[CompactForm Coin] -> ShowS
CompactForm Coin -> String
(Int -> CompactForm Coin -> ShowS)
-> (CompactForm Coin -> String)
-> ([CompactForm Coin] -> ShowS)
-> Show (CompactForm Coin)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompactForm Coin] -> ShowS
$cshowList :: [CompactForm Coin] -> ShowS
show :: CompactForm Coin -> String
$cshow :: CompactForm Coin -> String
showsPrec :: Int -> CompactForm Coin -> ShowS
$cshowsPrec :: Int -> CompactForm Coin -> ShowS
Show, Context -> CompactForm Coin -> IO (Maybe ThunkInfo)
Proxy (CompactForm Coin) -> String
(Context -> CompactForm Coin -> IO (Maybe ThunkInfo))
-> (Context -> CompactForm Coin -> IO (Maybe ThunkInfo))
-> (Proxy (CompactForm Coin) -> String)
-> NoThunks (CompactForm Coin)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (CompactForm Coin) -> String
$cshowTypeOf :: Proxy (CompactForm Coin) -> String
wNoThunks :: Context -> CompactForm Coin -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CompactForm Coin -> IO (Maybe ThunkInfo)
noThunks :: Context -> CompactForm Coin -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> CompactForm Coin -> IO (Maybe ThunkInfo)
NoThunks, CompactForm Coin -> ()
(CompactForm Coin -> ()) -> NFData (CompactForm Coin)
forall a. (a -> ()) -> NFData a
rnf :: CompactForm Coin -> ()
$crnf :: CompactForm Coin -> ()
NFData, Typeable, CompactForm Coin -> Int
(CompactForm Coin -> Int) -> HeapWords (CompactForm Coin)
forall a. (a -> Int) -> HeapWords a
heapWords :: CompactForm Coin -> Int
$cheapWords :: CompactForm Coin -> Int
HeapWords, Addr# -> Int# -> CompactForm Coin
Addr# -> Int# -> Int# -> CompactForm Coin -> State# s -> State# s
Addr# -> Int# -> State# s -> (# State# s, CompactForm Coin #)
Addr# -> Int# -> CompactForm Coin -> State# s -> State# s
ByteArray# -> Int# -> CompactForm Coin
MutableByteArray# s
-> Int# -> State# s -> (# State# s, CompactForm Coin #)
MutableByteArray# s
-> Int# -> CompactForm Coin -> State# s -> State# s
MutableByteArray# s
-> Int# -> Int# -> CompactForm Coin -> State# s -> State# s
CompactForm Coin -> Int#
(CompactForm Coin -> Int#)
-> (CompactForm Coin -> Int#)
-> (ByteArray# -> Int# -> CompactForm Coin)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, CompactForm Coin #))
-> (forall s.
    MutableByteArray# s
    -> Int# -> CompactForm Coin -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> CompactForm Coin -> State# s -> State# s)
-> (Addr# -> Int# -> CompactForm Coin)
-> (forall s.
    Addr# -> Int# -> State# s -> (# State# s, CompactForm Coin #))
-> (forall s.
    Addr# -> Int# -> CompactForm Coin -> State# s -> State# s)
-> (forall s.
    Addr# -> Int# -> Int# -> CompactForm Coin -> State# s -> State# s)
-> Prim (CompactForm Coin)
forall s.
Addr# -> Int# -> Int# -> CompactForm Coin -> State# s -> State# s
forall s.
Addr# -> Int# -> State# s -> (# State# s, CompactForm Coin #)
forall s. Addr# -> Int# -> CompactForm Coin -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> CompactForm Coin -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, CompactForm Coin #)
forall s.
MutableByteArray# s
-> Int# -> CompactForm Coin -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
setOffAddr# :: Addr# -> Int# -> Int# -> CompactForm Coin -> State# s -> State# s
$csetOffAddr# :: forall s.
Addr# -> Int# -> Int# -> CompactForm Coin -> State# s -> State# s
writeOffAddr# :: Addr# -> Int# -> CompactForm Coin -> State# s -> State# s
$cwriteOffAddr# :: forall s. Addr# -> Int# -> CompactForm Coin -> State# s -> State# s
readOffAddr# :: Addr# -> Int# -> State# s -> (# State# s, CompactForm Coin #)
$creadOffAddr# :: forall s.
Addr# -> Int# -> State# s -> (# State# s, CompactForm Coin #)
indexOffAddr# :: Addr# -> Int# -> CompactForm Coin
$cindexOffAddr# :: Addr# -> Int# -> CompactForm Coin
setByteArray# :: MutableByteArray# s
-> Int# -> Int# -> CompactForm Coin -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> CompactForm Coin -> State# s -> State# s
writeByteArray# :: MutableByteArray# s
-> Int# -> CompactForm Coin -> State# s -> State# s
$cwriteByteArray# :: forall s.
MutableByteArray# s
-> Int# -> CompactForm Coin -> State# s -> State# s
readByteArray# :: MutableByteArray# s
-> Int# -> State# s -> (# State# s, CompactForm Coin #)
$creadByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, CompactForm Coin #)
indexByteArray# :: ByteArray# -> Int# -> CompactForm Coin
$cindexByteArray# :: ByteArray# -> Int# -> CompactForm Coin
alignment# :: CompactForm Coin -> Int#
$calignment# :: CompactForm Coin -> Int#
sizeOf# :: CompactForm Coin -> Int#
$csizeOf# :: CompactForm Coin -> Int#
Prim)

  toCompact :: Coin -> Maybe (CompactForm Coin)
toCompact (Coin Integer
c) = Word64 -> CompactForm Coin
CompactCoin (Word64 -> CompactForm Coin)
-> Maybe Word64 -> Maybe (CompactForm Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Maybe Word64
integerToWord64 Integer
c
  fromCompact :: CompactForm Coin -> Coin
fromCompact (CompactCoin c) = Word64 -> Coin
word64ToCoin Word64
c

instance Compactible DeltaCoin where
  newtype CompactForm DeltaCoin = CompactDeltaCoin Word64
    deriving (CompactForm DeltaCoin -> CompactForm DeltaCoin -> Bool
(CompactForm DeltaCoin -> CompactForm DeltaCoin -> Bool)
-> (CompactForm DeltaCoin -> CompactForm DeltaCoin -> Bool)
-> Eq (CompactForm DeltaCoin)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompactForm DeltaCoin -> CompactForm DeltaCoin -> Bool
$c/= :: CompactForm DeltaCoin -> CompactForm DeltaCoin -> Bool
== :: CompactForm DeltaCoin -> CompactForm DeltaCoin -> Bool
$c== :: CompactForm DeltaCoin -> CompactForm DeltaCoin -> Bool
Eq, Int -> CompactForm DeltaCoin -> ShowS
[CompactForm DeltaCoin] -> ShowS
CompactForm DeltaCoin -> String
(Int -> CompactForm DeltaCoin -> ShowS)
-> (CompactForm DeltaCoin -> String)
-> ([CompactForm DeltaCoin] -> ShowS)
-> Show (CompactForm DeltaCoin)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompactForm DeltaCoin] -> ShowS
$cshowList :: [CompactForm DeltaCoin] -> ShowS
show :: CompactForm DeltaCoin -> String
$cshow :: CompactForm DeltaCoin -> String
showsPrec :: Int -> CompactForm DeltaCoin -> ShowS
$cshowsPrec :: Int -> CompactForm DeltaCoin -> ShowS
Show, Context -> CompactForm DeltaCoin -> IO (Maybe ThunkInfo)
Proxy (CompactForm DeltaCoin) -> String
(Context -> CompactForm DeltaCoin -> IO (Maybe ThunkInfo))
-> (Context -> CompactForm DeltaCoin -> IO (Maybe ThunkInfo))
-> (Proxy (CompactForm DeltaCoin) -> String)
-> NoThunks (CompactForm DeltaCoin)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (CompactForm DeltaCoin) -> String
$cshowTypeOf :: Proxy (CompactForm DeltaCoin) -> String
wNoThunks :: Context -> CompactForm DeltaCoin -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CompactForm DeltaCoin -> IO (Maybe ThunkInfo)
noThunks :: Context -> CompactForm DeltaCoin -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> CompactForm DeltaCoin -> IO (Maybe ThunkInfo)
NoThunks, CompactForm DeltaCoin -> ()
(CompactForm DeltaCoin -> ()) -> NFData (CompactForm DeltaCoin)
forall a. (a -> ()) -> NFData a
rnf :: CompactForm DeltaCoin -> ()
$crnf :: CompactForm DeltaCoin -> ()
NFData, Typeable, CompactForm DeltaCoin -> Int
(CompactForm DeltaCoin -> Int) -> HeapWords (CompactForm DeltaCoin)
forall a. (a -> Int) -> HeapWords a
heapWords :: CompactForm DeltaCoin -> Int
$cheapWords :: CompactForm DeltaCoin -> Int
HeapWords, Addr# -> Int# -> CompactForm DeltaCoin
Addr#
-> Int# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
Addr# -> Int# -> State# s -> (# State# s, CompactForm DeltaCoin #)
Addr# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
ByteArray# -> Int# -> CompactForm DeltaCoin
MutableByteArray# s
-> Int# -> State# s -> (# State# s, CompactForm DeltaCoin #)
MutableByteArray# s
-> Int# -> CompactForm DeltaCoin -> State# s -> State# s
MutableByteArray# s
-> Int# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
CompactForm DeltaCoin -> Int#
(CompactForm DeltaCoin -> Int#)
-> (CompactForm DeltaCoin -> Int#)
-> (ByteArray# -> Int# -> CompactForm DeltaCoin)
-> (forall s.
    MutableByteArray# s
    -> Int# -> State# s -> (# State# s, CompactForm DeltaCoin #))
-> (forall s.
    MutableByteArray# s
    -> Int# -> CompactForm DeltaCoin -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s
    -> Int# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s)
-> (Addr# -> Int# -> CompactForm DeltaCoin)
-> (forall s.
    Addr# -> Int# -> State# s -> (# State# s, CompactForm DeltaCoin #))
-> (forall s.
    Addr# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s)
-> (forall s.
    Addr#
    -> Int# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s)
-> Prim (CompactForm DeltaCoin)
forall s.
Addr#
-> Int# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
forall s.
Addr# -> Int# -> State# s -> (# State# s, CompactForm DeltaCoin #)
forall s.
Addr# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, CompactForm DeltaCoin #)
forall s.
MutableByteArray# s
-> Int# -> CompactForm DeltaCoin -> State# s -> State# s
forall a.
(a -> Int#)
-> (a -> Int#)
-> (ByteArray# -> Int# -> a)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, a #))
-> (forall s.
    MutableByteArray# s -> Int# -> a -> State# s -> State# s)
-> (forall s.
    MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s)
-> (Addr# -> Int# -> a)
-> (forall s. Addr# -> Int# -> State# s -> (# State# s, a #))
-> (forall s. Addr# -> Int# -> a -> State# s -> State# s)
-> (forall s. Addr# -> Int# -> Int# -> a -> State# s -> State# s)
-> Prim a
setOffAddr# :: Addr#
-> Int# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
$csetOffAddr# :: forall s.
Addr#
-> Int# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
writeOffAddr# :: Addr# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
$cwriteOffAddr# :: forall s.
Addr# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
readOffAddr# :: Addr# -> Int# -> State# s -> (# State# s, CompactForm DeltaCoin #)
$creadOffAddr# :: forall s.
Addr# -> Int# -> State# s -> (# State# s, CompactForm DeltaCoin #)
indexOffAddr# :: Addr# -> Int# -> CompactForm DeltaCoin
$cindexOffAddr# :: Addr# -> Int# -> CompactForm DeltaCoin
setByteArray# :: MutableByteArray# s
-> Int# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
writeByteArray# :: MutableByteArray# s
-> Int# -> CompactForm DeltaCoin -> State# s -> State# s
$cwriteByteArray# :: forall s.
MutableByteArray# s
-> Int# -> CompactForm DeltaCoin -> State# s -> State# s
readByteArray# :: MutableByteArray# s
-> Int# -> State# s -> (# State# s, CompactForm DeltaCoin #)
$creadByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, CompactForm DeltaCoin #)
indexByteArray# :: ByteArray# -> Int# -> CompactForm DeltaCoin
$cindexByteArray# :: ByteArray# -> Int# -> CompactForm DeltaCoin
alignment# :: CompactForm DeltaCoin -> Int#
$calignment# :: CompactForm DeltaCoin -> Int#
sizeOf# :: CompactForm DeltaCoin -> Int#
$csizeOf# :: CompactForm DeltaCoin -> Int#
Prim)

  toCompact :: DeltaCoin -> Maybe (CompactForm DeltaCoin)
toCompact (DeltaCoin Integer
dc) = Word64 -> CompactForm DeltaCoin
CompactDeltaCoin (Word64 -> CompactForm DeltaCoin)
-> Maybe Word64 -> Maybe (CompactForm DeltaCoin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Maybe Word64
integerToWord64 Integer
dc
  fromCompact :: CompactForm DeltaCoin -> DeltaCoin
fromCompact (CompactDeltaCoin cdc) = Integer -> DeltaCoin
DeltaCoin (Coin -> Integer
unCoin (Word64 -> Coin
word64ToCoin Word64
cdc))

-- It's odd for this to live here. Where should it go?
integerToWord64 :: Integer -> Maybe Word64
integerToWord64 :: Integer -> Maybe Word64
integerToWord64 Integer
c
  | Integer
c Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = Maybe Word64
forall a. Maybe a
Nothing
  | Integer
c Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: Word64) = Maybe Word64
forall a. Maybe a
Nothing
  | Bool
otherwise = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
forall a b. (a -> b) -> a -> b
$ Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
c
{-# INLINE integerToWord64 #-}

instance ToCBOR (CompactForm Coin) where
  toCBOR :: CompactForm Coin -> Encoding
toCBOR (CompactCoin c) = Word64 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Word64
c

instance FromCBOR (CompactForm Coin) where
  fromCBOR :: Decoder s (CompactForm Coin)
fromCBOR = Word64 -> CompactForm Coin
CompactCoin (Word64 -> CompactForm Coin)
-> Decoder s Word64 -> Decoder s (CompactForm Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance ToCBOR (CompactForm DeltaCoin) where
  toCBOR :: CompactForm DeltaCoin -> Encoding
toCBOR (CompactDeltaCoin c) = Word64 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Word64
c

instance FromCBOR (CompactForm DeltaCoin) where
  fromCBOR :: Decoder s (CompactForm DeltaCoin)
fromCBOR = Word64 -> CompactForm DeltaCoin
CompactDeltaCoin (Word64 -> CompactForm DeltaCoin)
-> Decoder s Word64 -> Decoder s (CompactForm DeltaCoin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall a s. FromCBOR a => Decoder s a
fromCBOR