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

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

import Cardano.HeapWords (HeapWords)
import Cardano.Ledger.BaseTypes (Inject (..))
import Cardano.Ledger.Binary (
  DecCBOR (..),
  Decoder,
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR,
  decodeInteger,
  decodeWord64,
  ifDecoderVersionAtLeast,
  natVersion,
 )
import qualified Cardano.Ledger.Binary.Plain as Plain
import Cardano.Ledger.Compactible
import Control.DeepSeq (NFData)
import Data.Aeson (FromJSON, ToJSON)
import Data.Coerce (coerce)
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 GHC.Stack
import NoThunks.Class (NoThunks (..))
import Quiet
import System.Random.Stateful (Uniform (..), UniformRange (..))

-- | The amount of value held by a transaction output.
newtype Coin = Coin {Coin -> Integer
unCoin :: Integer}
  deriving
    ( Coin -> Coin -> Bool
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
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
Ord
    , Int -> Coin
Coin -> Int
Coin -> [Coin]
Coin -> Coin
Coin -> Coin -> [Coin]
Coin -> Coin -> Coin -> [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
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. 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 -> Bool
Coin -> Encoding
Coin -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
omitField :: Coin -> Bool
$comitField :: Coin -> Bool
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
    , Maybe Coin
Value -> Parser [Coin]
Value -> Parser Coin
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
omittedField :: Maybe Coin
$comittedField :: Maybe Coin
parseJSONList :: Value -> Parser [Coin]
$cparseJSONList :: Value -> Parser [Coin]
parseJSON :: Value -> Parser Coin
$cparseJSON :: Value -> Parser Coin
FromJSON
    , Coin -> ()
forall a. (a -> ()) -> NFData a
rnf :: Coin -> ()
$crnf :: Coin -> ()
NFData
    )
  deriving (Int -> Coin -> ShowS
[Coin] -> ShowS
Coin -> String
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 (NonEmpty Coin -> Coin
Coin -> Coin -> 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 :: forall b. Integral b => 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
[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
Monoid, Monoid Coin
Coin -> 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 :: forall x. Integral x => Coin -> x -> Coin
$cpow :: forall x. Integral x => Coin -> x -> Coin
~~ :: Coin -> Coin -> Coin
$c~~ :: Coin -> Coin -> Coin
invert :: Coin -> Coin
$cinvert :: Coin -> Coin
Group, Group Coin
forall g. Group g -> Abelian g
Abelian) via Sum Integer
  deriving newtype (Coin -> Coin -> Bool
Coin -> Coin -> Maybe Ordering
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
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
ToCBOR, Typeable Coin
Coin -> Encoding
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy [Coin] -> Size
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy Coin -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy [Coin] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy [Coin] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy Coin -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy Coin -> Size
encCBOR :: Coin -> Encoding
$cencCBOR :: Coin -> Encoding
EncCBOR, Coin -> Int
forall a. (a -> Int) -> HeapWords a
heapWords :: Coin -> Int
$cheapWords :: Coin -> Int
HeapWords)

instance FromCBOR Coin where
  fromCBOR :: forall s. Decoder s Coin
fromCBOR = Integer -> Coin
Coin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word64
Plain.decodeWord64

instance DecCBOR Coin where
  decCBOR :: forall s. Decoder s Coin
decCBOR =
    forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
      (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
      (Integer -> Coin
Coin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Word64
decodeWord64)
      (Integer -> Coin
Coin forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s Integer
decodeInteger)

newtype DeltaCoin = DeltaCoin Integer
  deriving (DeltaCoin -> DeltaCoin -> Bool
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
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
Ord, 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]
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
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 -> Int
forall a. (a -> Int) -> HeapWords a
heapWords :: DeltaCoin -> Int
$cheapWords :: DeltaCoin -> Int
HeapWords)
  deriving (Int -> DeltaCoin -> ShowS
[DeltaCoin] -> ShowS
DeltaCoin -> String
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 (NonEmpty DeltaCoin -> DeltaCoin
DeltaCoin -> DeltaCoin -> 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 :: forall b. Integral b => 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
[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
Monoid, Monoid DeltaCoin
DeltaCoin -> 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 :: forall x. Integral x => DeltaCoin -> x -> DeltaCoin
$cpow :: forall x. Integral x => DeltaCoin -> x -> DeltaCoin
~~ :: DeltaCoin -> DeltaCoin -> DeltaCoin
$c~~ :: DeltaCoin -> DeltaCoin -> DeltaCoin
invert :: DeltaCoin -> DeltaCoin
$cinvert :: DeltaCoin -> DeltaCoin
Group, Group DeltaCoin
forall g. Group g -> Abelian g
Abelian) via Sum Integer
  deriving newtype (DeltaCoin -> DeltaCoin -> Bool
DeltaCoin -> DeltaCoin -> Maybe Ordering
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, DeltaCoin -> ()
forall a. (a -> ()) -> NFData a
rnf :: DeltaCoin -> ()
$crnf :: DeltaCoin -> ()
NFData, Typeable 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
ToCBOR, Typeable DeltaCoin
Proxy DeltaCoin -> Text
forall s. Decoder s DeltaCoin
forall a.
Typeable a
-> (forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy DeltaCoin -> Decoder s ()
label :: Proxy DeltaCoin -> Text
$clabel :: Proxy DeltaCoin -> Text
dropCBOR :: forall s. Proxy DeltaCoin -> Decoder s ()
$cdropCBOR :: forall s. Proxy DeltaCoin -> Decoder s ()
decCBOR :: forall s. Decoder s DeltaCoin
$cdecCBOR :: forall s. Decoder s DeltaCoin
DecCBOR, Typeable DeltaCoin
DeltaCoin -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [DeltaCoin] -> Size
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy DeltaCoin -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [DeltaCoin] -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [DeltaCoin] -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy DeltaCoin -> Size
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy DeltaCoin -> Size
encCBOR :: DeltaCoin -> Encoding
$cencCBOR :: DeltaCoin -> Encoding
EncCBOR, [DeltaCoin] -> Encoding
[DeltaCoin] -> Value
DeltaCoin -> Bool
DeltaCoin -> Encoding
DeltaCoin -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
omitField :: DeltaCoin -> Bool
$comitField :: DeltaCoin -> Bool
toEncodingList :: [DeltaCoin] -> Encoding
$ctoEncodingList :: [DeltaCoin] -> Encoding
toJSONList :: [DeltaCoin] -> Value
$ctoJSONList :: [DeltaCoin] -> Value
toEncoding :: DeltaCoin -> Encoding
$ctoEncoding :: DeltaCoin -> Encoding
toJSON :: DeltaCoin -> Value
$ctoJSON :: DeltaCoin -> Value
ToJSON, Maybe DeltaCoin
Value -> Parser [DeltaCoin]
Value -> Parser DeltaCoin
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
omittedField :: Maybe DeltaCoin
$comittedField :: Maybe DeltaCoin
parseJSONList :: Value -> Parser [DeltaCoin]
$cparseJSONList :: Value -> Parser [DeltaCoin]
parseJSON :: Value -> Parser DeltaCoin
$cparseJSON :: Value -> Parser DeltaCoin
FromJSON)

instance Inject Coin DeltaCoin where
  inject :: Coin -> DeltaCoin
inject = coerce :: forall a b. Coercible a b => a -> b
coerce

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

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

fromDeltaCoin :: DeltaCoin -> Maybe Coin
fromDeltaCoin :: DeltaCoin -> Maybe Coin
fromDeltaCoin (DeltaCoin Integer
x)
  | Integer
x forall a. Ord a => a -> a -> Bool
< Integer
0 = forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
x

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

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

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

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

instance Compactible Coin where
  newtype CompactForm Coin = CompactCoin {CompactForm Coin -> Word64
unCompactCoin :: Word64}
    deriving (CompactForm Coin -> CompactForm Coin -> Bool
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
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
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: CompactForm Coin -> ()
$crnf :: CompactForm Coin -> ()
NFData, Typeable, CompactForm Coin -> Int
forall a. (a -> Int) -> HeapWords a
heapWords :: CompactForm Coin -> Int
$cheapWords :: CompactForm Coin -> Int
HeapWords, Addr# -> Int# -> CompactForm Coin
ByteArray# -> Int# -> CompactForm Coin
Proxy (CompactForm Coin) -> Int#
CompactForm Coin -> Int#
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.
(Proxy a -> Int#)
-> (a -> Int#)
-> (Proxy 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# :: forall s.
Addr# -> Int# -> Int# -> CompactForm Coin -> State# s -> State# s
$csetOffAddr# :: forall s.
Addr# -> Int# -> Int# -> CompactForm Coin -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> CompactForm Coin -> State# s -> State# s
$cwriteOffAddr# :: forall s. Addr# -> Int# -> CompactForm Coin -> State# s -> State# s
readOffAddr# :: forall s.
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# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> CompactForm Coin -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> CompactForm Coin -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s
-> Int# -> CompactForm Coin -> State# s -> State# s
$cwriteByteArray# :: forall s.
MutableByteArray# s
-> Int# -> CompactForm Coin -> State# s -> State# s
readByteArray# :: forall s.
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#
alignmentOfType# :: Proxy (CompactForm Coin) -> Int#
$calignmentOfType# :: Proxy (CompactForm Coin) -> Int#
sizeOf# :: CompactForm Coin -> Int#
$csizeOf# :: CompactForm Coin -> Int#
sizeOfType# :: Proxy (CompactForm Coin) -> Int#
$csizeOfType# :: Proxy (CompactForm Coin) -> Int#
Prim, Eq (CompactForm Coin)
CompactForm Coin -> CompactForm Coin -> Bool
CompactForm Coin -> CompactForm Coin -> Ordering
CompactForm Coin -> CompactForm Coin -> CompactForm 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 :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
$cmin :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
max :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
$cmax :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
>= :: CompactForm Coin -> CompactForm Coin -> Bool
$c>= :: CompactForm Coin -> CompactForm Coin -> Bool
> :: CompactForm Coin -> CompactForm Coin -> Bool
$c> :: CompactForm Coin -> CompactForm Coin -> Bool
<= :: CompactForm Coin -> CompactForm Coin -> Bool
$c<= :: CompactForm Coin -> CompactForm Coin -> Bool
< :: CompactForm Coin -> CompactForm Coin -> Bool
$c< :: CompactForm Coin -> CompactForm Coin -> Bool
compare :: CompactForm Coin -> CompactForm Coin -> Ordering
$ccompare :: CompactForm Coin -> CompactForm Coin -> Ordering
Ord, Typeable (CompactForm Coin)
CompactForm Coin -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [CompactForm Coin] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (CompactForm 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 [CompactForm Coin] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [CompactForm Coin] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (CompactForm Coin) -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (CompactForm Coin) -> Size
toCBOR :: CompactForm Coin -> Encoding
$ctoCBOR :: CompactForm Coin -> Encoding
ToCBOR, [CompactForm Coin] -> Encoding
[CompactForm Coin] -> Value
CompactForm Coin -> Bool
CompactForm Coin -> Encoding
CompactForm Coin -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
omitField :: CompactForm Coin -> Bool
$comitField :: CompactForm Coin -> Bool
toEncodingList :: [CompactForm Coin] -> Encoding
$ctoEncodingList :: [CompactForm Coin] -> Encoding
toJSONList :: [CompactForm Coin] -> Value
$ctoJSONList :: [CompactForm Coin] -> Value
toEncoding :: CompactForm Coin -> Encoding
$ctoEncoding :: CompactForm Coin -> Encoding
toJSON :: CompactForm Coin -> Value
$ctoJSON :: CompactForm Coin -> Value
ToJSON, Maybe (CompactForm Coin)
Value -> Parser [CompactForm Coin]
Value -> Parser (CompactForm Coin)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
omittedField :: Maybe (CompactForm Coin)
$comittedField :: Maybe (CompactForm Coin)
parseJSONList :: Value -> Parser [CompactForm Coin]
$cparseJSONList :: Value -> Parser [CompactForm Coin]
parseJSON :: Value -> Parser (CompactForm Coin)
$cparseJSON :: Value -> Parser (CompactForm Coin)
FromJSON)
    deriving (NonEmpty (CompactForm Coin) -> CompactForm Coin
CompactForm Coin -> CompactForm Coin -> CompactForm Coin
forall b. Integral b => b -> CompactForm Coin -> CompactForm Coin
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> CompactForm Coin -> CompactForm Coin
$cstimes :: forall b. Integral b => b -> CompactForm Coin -> CompactForm Coin
sconcat :: NonEmpty (CompactForm Coin) -> CompactForm Coin
$csconcat :: NonEmpty (CompactForm Coin) -> CompactForm Coin
<> :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
$c<> :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
Semigroup, Semigroup (CompactForm Coin)
CompactForm Coin
[CompactForm Coin] -> CompactForm Coin
CompactForm Coin -> CompactForm Coin -> CompactForm Coin
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [CompactForm Coin] -> CompactForm Coin
$cmconcat :: [CompactForm Coin] -> CompactForm Coin
mappend :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
$cmappend :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
mempty :: CompactForm Coin
$cmempty :: CompactForm Coin
Monoid, Monoid (CompactForm Coin)
CompactForm Coin -> CompactForm Coin
CompactForm Coin -> CompactForm Coin -> CompactForm Coin
forall x. Integral x => CompactForm Coin -> x -> CompactForm Coin
forall m.
Monoid m
-> (m -> m)
-> (m -> m -> m)
-> (forall x. Integral x => m -> x -> m)
-> Group m
pow :: forall x. Integral x => CompactForm Coin -> x -> CompactForm Coin
$cpow :: forall x. Integral x => CompactForm Coin -> x -> CompactForm Coin
~~ :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
$c~~ :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
invert :: CompactForm Coin -> CompactForm Coin
$cinvert :: CompactForm Coin -> CompactForm Coin
Group, Group (CompactForm Coin)
forall g. Group g -> Abelian g
Abelian) via Sum Word64

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

instance Compactible DeltaCoin where
  newtype CompactForm DeltaCoin = CompactDeltaCoin Word64
    deriving (CompactForm DeltaCoin -> CompactForm DeltaCoin -> Bool
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
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
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: CompactForm DeltaCoin -> ()
$crnf :: CompactForm DeltaCoin -> ()
NFData, Typeable, CompactForm DeltaCoin -> Int
forall a. (a -> Int) -> HeapWords a
heapWords :: CompactForm DeltaCoin -> Int
$cheapWords :: CompactForm DeltaCoin -> Int
HeapWords, [CompactForm DeltaCoin] -> Encoding
[CompactForm DeltaCoin] -> Value
CompactForm DeltaCoin -> Bool
CompactForm DeltaCoin -> Encoding
CompactForm DeltaCoin -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
omitField :: CompactForm DeltaCoin -> Bool
$comitField :: CompactForm DeltaCoin -> Bool
toEncodingList :: [CompactForm DeltaCoin] -> Encoding
$ctoEncodingList :: [CompactForm DeltaCoin] -> Encoding
toJSONList :: [CompactForm DeltaCoin] -> Value
$ctoJSONList :: [CompactForm DeltaCoin] -> Value
toEncoding :: CompactForm DeltaCoin -> Encoding
$ctoEncoding :: CompactForm DeltaCoin -> Encoding
toJSON :: CompactForm DeltaCoin -> Value
$ctoJSON :: CompactForm DeltaCoin -> Value
ToJSON, Addr# -> Int# -> CompactForm DeltaCoin
ByteArray# -> Int# -> CompactForm DeltaCoin
Proxy (CompactForm DeltaCoin) -> Int#
CompactForm DeltaCoin -> Int#
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.
(Proxy a -> Int#)
-> (a -> Int#)
-> (Proxy 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# :: forall s.
Addr#
-> Int# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
$csetOffAddr# :: forall s.
Addr#
-> Int# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
writeOffAddr# :: forall s.
Addr# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
$cwriteOffAddr# :: forall s.
Addr# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
readOffAddr# :: forall s.
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# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s
-> Int# -> CompactForm DeltaCoin -> State# s -> State# s
$cwriteByteArray# :: forall s.
MutableByteArray# s
-> Int# -> CompactForm DeltaCoin -> State# s -> State# s
readByteArray# :: forall s.
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#
alignmentOfType# :: Proxy (CompactForm DeltaCoin) -> Int#
$calignmentOfType# :: Proxy (CompactForm DeltaCoin) -> Int#
sizeOf# :: CompactForm DeltaCoin -> Int#
$csizeOf# :: CompactForm DeltaCoin -> Int#
sizeOfType# :: Proxy (CompactForm DeltaCoin) -> Int#
$csizeOfType# :: Proxy (CompactForm DeltaCoin) -> Int#
Prim)

  toCompact :: DeltaCoin -> Maybe (CompactForm DeltaCoin)
toCompact (DeltaCoin Integer
dc) = Word64 -> CompactForm DeltaCoin
CompactDeltaCoin forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Maybe Word64
integerToWord64 Integer
dc
  fromCompact :: CompactForm DeltaCoin -> DeltaCoin
fromCompact (CompactDeltaCoin Word64
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 forall a. Ord a => a -> a -> Bool
< Integer
0 = forall a. Maybe a
Nothing
  | Integer
c forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word64) = forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
c
{-# INLINE integerToWord64 #-}

compactCoinOrError :: HasCallStack => Coin -> CompactForm Coin
compactCoinOrError :: HasCallStack => Coin -> CompactForm Coin
compactCoinOrError Coin
c =
  case forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact Coin
c of
    Maybe (CompactForm Coin)
Nothing -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Invalid ADA value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Coin
c
    Just CompactForm Coin
compactCoin -> CompactForm Coin
compactCoin

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

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

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

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

-- ================================

decodePositiveCoin :: String -> Decoder s Coin
decodePositiveCoin :: forall s. String -> Decoder s Coin
decodePositiveCoin String
errorMessage = do
  Word64
n <- forall s. Decoder s Word64
decodeWord64
  if Word64
n forall a. Eq a => a -> a -> Bool
== Word64
0
    then forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
errorMessage forall a. [a] -> [a] -> [a]
++ String
": Expected a positive Coin. Got 0 (zero)."
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin (forall a. Integral a => a -> Integer
toInteger Word64
n)

instance Uniform Coin where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m Coin
uniformM g
g = forall a. Compactible a => CompactForm a -> a
fromCompact forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g

instance Uniform (CompactForm Coin) where
  uniformM :: forall g (m :: * -> *).
StatefulGen g m =>
g -> m (CompactForm Coin)
uniformM g
g = Word64 -> CompactForm Coin
CompactCoin forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
uniformM g
g

instance UniformRange Coin where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(Coin, Coin) -> g -> m Coin
uniformRM (Coin
l, Coin
h) g
g = forall a. Compactible a => CompactForm a -> a
fromCompact forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (HasCallStack => Coin -> CompactForm Coin
compactCoinOrError Coin
l, HasCallStack => Coin -> CompactForm Coin
compactCoinOrError Coin
h) g
g

instance UniformRange (CompactForm Coin) where
  uniformRM :: forall g (m :: * -> *).
StatefulGen g m =>
(CompactForm Coin, CompactForm Coin) -> g -> m (CompactForm Coin)
uniformRM (CompactCoin Word64
l, CompactCoin Word64
h) g
g = Word64 -> CompactForm Coin
CompactCoin forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
uniformRM (Word64
l, Word64
h) g
g