{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# 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,
  addCompactCoin,
  sumCompactCoin,
  -- NonZero helpers
  toCompactCoinNonZero,
  unCoinNonZero,
  toCoinNonZero,
  fromCompactCoinNonZero,
  compactCoinNonZero,
) where

import Cardano.Ledger.BaseTypes (
  HasZero (..),
  Inject (..),
  NonZero,
  unNonZero,
  unsafeNonZero,
 )
import Cardano.Ledger.Binary (
  DecCBOR (..),
  Decoder,
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR,
  decodeWord64,
 )
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 qualified Data.Foldable as F (foldl') -- Drop this when ghc >= 9.10
import Data.Group (Abelian, Group (..))
import Data.MemPack
import Data.Monoid (Sum (..))
import Data.PartialOrd (PartialOrd)
import Data.Primitive.Types
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
(Coin -> Coin -> Bool) -> (Coin -> Coin -> Bool) -> Eq Coin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Coin -> Coin -> Bool
== :: Coin -> Coin -> Bool
$c/= :: Coin -> Coin -> Bool
/= :: 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
$ccompare :: Coin -> Coin -> Ordering
compare :: Coin -> Coin -> Ordering
$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
$cmax :: Coin -> Coin -> Coin
max :: Coin -> Coin -> Coin
$cmin :: Coin -> Coin -> Coin
min :: Coin -> Coin -> 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
$csucc :: Coin -> Coin
succ :: Coin -> Coin
$cpred :: Coin -> Coin
pred :: Coin -> Coin
$ctoEnum :: Int -> Coin
toEnum :: Int -> Coin
$cfromEnum :: Coin -> Int
fromEnum :: Coin -> Int
$cenumFrom :: Coin -> [Coin]
enumFrom :: Coin -> [Coin]
$cenumFromThen :: Coin -> Coin -> [Coin]
enumFromThen :: Coin -> Coin -> [Coin]
$cenumFromTo :: Coin -> Coin -> [Coin]
enumFromTo :: Coin -> Coin -> [Coin]
$cenumFromThenTo :: Coin -> Coin -> Coin -> [Coin]
enumFromThenTo :: Coin -> Coin -> 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
$cnoThunks :: Context -> Coin -> IO (Maybe ThunkInfo)
noThunks :: Context -> Coin -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Coin -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Coin -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy Coin -> String
showTypeOf :: Proxy Coin -> String
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
$cfrom :: forall x. Coin -> Rep Coin x
from :: forall x. Coin -> Rep Coin x
$cto :: forall x. Rep Coin x -> Coin
to :: forall x. Rep Coin x -> Coin
Generic
    , [Coin] -> Value
[Coin] -> Encoding
Coin -> Bool
Coin -> Value
Coin -> Encoding
(Coin -> Value)
-> (Coin -> Encoding)
-> ([Coin] -> Value)
-> ([Coin] -> Encoding)
-> (Coin -> Bool)
-> ToJSON Coin
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Coin -> Value
toJSON :: Coin -> Value
$ctoEncoding :: Coin -> Encoding
toEncoding :: Coin -> Encoding
$ctoJSONList :: [Coin] -> Value
toJSONList :: [Coin] -> Value
$ctoEncodingList :: [Coin] -> Encoding
toEncodingList :: [Coin] -> Encoding
$comitField :: Coin -> Bool
omitField :: Coin -> Bool
ToJSON
    , Maybe Coin
Value -> Parser [Coin]
Value -> Parser Coin
(Value -> Parser Coin)
-> (Value -> Parser [Coin]) -> Maybe Coin -> FromJSON Coin
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Coin
parseJSON :: Value -> Parser Coin
$cparseJSONList :: Value -> Parser [Coin]
parseJSONList :: Value -> Parser [Coin]
$comittedField :: Maybe Coin
omittedField :: Maybe Coin
FromJSON
    , Coin -> ()
(Coin -> ()) -> NFData Coin
forall a. (a -> ()) -> NFData a
$crnf :: Coin -> ()
rnf :: 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
$cshowsPrec :: Int -> Coin -> ShowS
showsPrec :: Int -> Coin -> ShowS
$cshow :: Coin -> String
show :: Coin -> String
$cshowList :: [Coin] -> ShowS
showList :: [Coin] -> ShowS
Show) via Quiet Coin
  deriving (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
$c<> :: Coin -> Coin -> Coin
<> :: Coin -> Coin -> Coin
$csconcat :: NonEmpty Coin -> Coin
sconcat :: NonEmpty Coin -> Coin
$cstimes :: forall b. Integral b => b -> Coin -> Coin
stimes :: forall b. Integral b => b -> 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
$cmempty :: Coin
mempty :: Coin
$cmappend :: Coin -> Coin -> Coin
mappend :: Coin -> Coin -> Coin
$cmconcat :: [Coin] -> Coin
mconcat :: [Coin] -> Coin
Monoid, Monoid Coin
Monoid Coin =>
(Coin -> Coin)
-> (Coin -> Coin -> Coin)
-> (forall x. Integral x => Coin -> x -> Coin)
-> Group 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
$cinvert :: Coin -> Coin
invert :: Coin -> Coin
$c~~ :: Coin -> Coin -> Coin
~~ :: Coin -> Coin -> Coin
$cpow :: forall x. Integral x => Coin -> x -> Coin
pow :: forall x. Integral x => Coin -> x -> 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
$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
> :: Coin -> Coin -> Bool
$ccompare :: Coin -> Coin -> Maybe Ordering
compare :: Coin -> Coin -> Maybe Ordering
PartialOrd, 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
$ctoCBOR :: Coin -> Encoding
toCBOR :: Coin -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Coin -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Coin -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Coin] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Coin] -> Size
ToCBOR, Typeable Coin
Typeable Coin =>
(Coin -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy Coin -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [Coin] -> Size)
-> EncCBOR 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
$cencCBOR :: Coin -> Encoding
encCBOR :: Coin -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy Coin -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy Coin -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy [Coin] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy [Coin] -> Size
EncCBOR)

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

instance DecCBOR Coin

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
$c== :: DeltaCoin -> DeltaCoin -> Bool
== :: DeltaCoin -> DeltaCoin -> Bool
$c/= :: DeltaCoin -> DeltaCoin -> Bool
/= :: 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
$ccompare :: DeltaCoin -> DeltaCoin -> Ordering
compare :: DeltaCoin -> DeltaCoin -> Ordering
$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
$cmax :: DeltaCoin -> DeltaCoin -> DeltaCoin
max :: DeltaCoin -> DeltaCoin -> DeltaCoin
$cmin :: DeltaCoin -> DeltaCoin -> DeltaCoin
min :: DeltaCoin -> DeltaCoin -> 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
$cfrom :: forall x. DeltaCoin -> Rep DeltaCoin x
from :: forall x. DeltaCoin -> Rep DeltaCoin x
$cto :: forall x. Rep DeltaCoin x -> DeltaCoin
to :: forall x. Rep DeltaCoin x -> DeltaCoin
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
$csucc :: DeltaCoin -> DeltaCoin
succ :: DeltaCoin -> DeltaCoin
$cpred :: DeltaCoin -> DeltaCoin
pred :: DeltaCoin -> DeltaCoin
$ctoEnum :: Int -> DeltaCoin
toEnum :: Int -> DeltaCoin
$cfromEnum :: DeltaCoin -> Int
fromEnum :: DeltaCoin -> Int
$cenumFrom :: DeltaCoin -> [DeltaCoin]
enumFrom :: DeltaCoin -> [DeltaCoin]
$cenumFromThen :: DeltaCoin -> DeltaCoin -> [DeltaCoin]
enumFromThen :: DeltaCoin -> DeltaCoin -> [DeltaCoin]
$cenumFromTo :: DeltaCoin -> DeltaCoin -> [DeltaCoin]
enumFromTo :: DeltaCoin -> DeltaCoin -> [DeltaCoin]
$cenumFromThenTo :: DeltaCoin -> DeltaCoin -> DeltaCoin -> [DeltaCoin]
enumFromThenTo :: DeltaCoin -> DeltaCoin -> 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
$cnoThunks :: Context -> DeltaCoin -> IO (Maybe ThunkInfo)
noThunks :: Context -> DeltaCoin -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> DeltaCoin -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> DeltaCoin -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy DeltaCoin -> String
showTypeOf :: Proxy DeltaCoin -> String
NoThunks)
  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
$cshowsPrec :: Int -> DeltaCoin -> ShowS
showsPrec :: Int -> DeltaCoin -> ShowS
$cshow :: DeltaCoin -> String
show :: DeltaCoin -> String
$cshowList :: [DeltaCoin] -> ShowS
showList :: [DeltaCoin] -> ShowS
Show) via Quiet DeltaCoin
  deriving (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
$c<> :: DeltaCoin -> DeltaCoin -> DeltaCoin
<> :: DeltaCoin -> DeltaCoin -> DeltaCoin
$csconcat :: NonEmpty DeltaCoin -> DeltaCoin
sconcat :: NonEmpty DeltaCoin -> DeltaCoin
$cstimes :: forall b. Integral b => b -> DeltaCoin -> DeltaCoin
stimes :: forall b. Integral b => b -> 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
$cmempty :: DeltaCoin
mempty :: DeltaCoin
$cmappend :: DeltaCoin -> DeltaCoin -> DeltaCoin
mappend :: DeltaCoin -> DeltaCoin -> DeltaCoin
$cmconcat :: [DeltaCoin] -> DeltaCoin
mconcat :: [DeltaCoin] -> DeltaCoin
Monoid, Monoid DeltaCoin
Monoid DeltaCoin =>
(DeltaCoin -> DeltaCoin)
-> (DeltaCoin -> DeltaCoin -> DeltaCoin)
-> (forall x. Integral x => DeltaCoin -> x -> DeltaCoin)
-> Group 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
$cinvert :: DeltaCoin -> DeltaCoin
invert :: DeltaCoin -> DeltaCoin
$c~~ :: DeltaCoin -> DeltaCoin -> DeltaCoin
~~ :: DeltaCoin -> DeltaCoin -> DeltaCoin
$cpow :: forall x. Integral x => DeltaCoin -> x -> DeltaCoin
pow :: forall x. Integral x => DeltaCoin -> x -> 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
$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
> :: DeltaCoin -> DeltaCoin -> Bool
$ccompare :: DeltaCoin -> DeltaCoin -> Maybe Ordering
compare :: DeltaCoin -> DeltaCoin -> Maybe Ordering
PartialOrd, DeltaCoin -> ()
(DeltaCoin -> ()) -> NFData DeltaCoin
forall a. (a -> ()) -> NFData a
$crnf :: DeltaCoin -> ()
rnf :: DeltaCoin -> ()
NFData, 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
$ctoCBOR :: DeltaCoin -> Encoding
toCBOR :: DeltaCoin -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy DeltaCoin -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy DeltaCoin -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [DeltaCoin] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [DeltaCoin] -> Size
ToCBOR, Typeable DeltaCoin
Typeable DeltaCoin =>
(forall s. Decoder s DeltaCoin)
-> (forall s. Proxy DeltaCoin -> Decoder s ())
-> (Proxy DeltaCoin -> Text)
-> DecCBOR 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 ()
$cdecCBOR :: forall s. Decoder s DeltaCoin
decCBOR :: forall s. Decoder s DeltaCoin
$cdropCBOR :: forall s. Proxy DeltaCoin -> Decoder s ()
dropCBOR :: forall s. Proxy DeltaCoin -> Decoder s ()
$clabel :: Proxy DeltaCoin -> Text
label :: Proxy DeltaCoin -> Text
DecCBOR, Typeable DeltaCoin
Typeable DeltaCoin =>
(DeltaCoin -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy DeltaCoin -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [DeltaCoin] -> Size)
-> EncCBOR 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
$cencCBOR :: DeltaCoin -> Encoding
encCBOR :: DeltaCoin -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy DeltaCoin -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy DeltaCoin -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [DeltaCoin] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [DeltaCoin] -> Size
EncCBOR, [DeltaCoin] -> Value
[DeltaCoin] -> Encoding
DeltaCoin -> Bool
DeltaCoin -> Value
DeltaCoin -> Encoding
(DeltaCoin -> Value)
-> (DeltaCoin -> Encoding)
-> ([DeltaCoin] -> Value)
-> ([DeltaCoin] -> Encoding)
-> (DeltaCoin -> Bool)
-> ToJSON DeltaCoin
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: DeltaCoin -> Value
toJSON :: DeltaCoin -> Value
$ctoEncoding :: DeltaCoin -> Encoding
toEncoding :: DeltaCoin -> Encoding
$ctoJSONList :: [DeltaCoin] -> Value
toJSONList :: [DeltaCoin] -> Value
$ctoEncodingList :: [DeltaCoin] -> Encoding
toEncodingList :: [DeltaCoin] -> Encoding
$comitField :: DeltaCoin -> Bool
omitField :: DeltaCoin -> Bool
ToJSON, Maybe DeltaCoin
Value -> Parser [DeltaCoin]
Value -> Parser DeltaCoin
(Value -> Parser DeltaCoin)
-> (Value -> Parser [DeltaCoin])
-> Maybe DeltaCoin
-> FromJSON DeltaCoin
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser DeltaCoin
parseJSON :: Value -> Parser DeltaCoin
$cparseJSONList :: Value -> Parser [DeltaCoin]
parseJSONList :: Value -> Parser [DeltaCoin]
$comittedField :: Maybe DeltaCoin
omittedField :: Maybe DeltaCoin
FromJSON)

instance Inject Coin DeltaCoin where
  inject :: Coin -> DeltaCoin
inject = Coin -> DeltaCoin
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 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

fromDeltaCoin :: DeltaCoin -> Maybe Coin
fromDeltaCoin :: DeltaCoin -> Maybe Coin
fromDeltaCoin (DeltaCoin Integer
x)
  | Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = Maybe Coin
forall a. Maybe a
Nothing
  | Bool
otherwise = Coin -> Maybe Coin
forall a. a -> Maybe a
Just (Coin -> Maybe Coin) -> Coin -> Maybe Coin
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin 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 b. Integral b => Rational -> b
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 b. Integral b => Rational -> b
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
(CompactForm Coin -> CompactForm Coin -> Bool)
-> (CompactForm Coin -> CompactForm Coin -> Bool)
-> Eq (CompactForm Coin)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompactForm Coin -> CompactForm Coin -> Bool
== :: CompactForm Coin -> CompactForm Coin -> Bool
$c/= :: CompactForm Coin -> CompactForm Coin -> Bool
/= :: 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
$cshowsPrec :: Int -> CompactForm Coin -> ShowS
showsPrec :: Int -> CompactForm Coin -> ShowS
$cshow :: CompactForm Coin -> String
show :: CompactForm Coin -> String
$cshowList :: [CompactForm Coin] -> ShowS
showList :: [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
$cnoThunks :: Context -> CompactForm Coin -> IO (Maybe ThunkInfo)
noThunks :: Context -> CompactForm Coin -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CompactForm Coin -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CompactForm Coin -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (CompactForm Coin) -> String
showTypeOf :: Proxy (CompactForm Coin) -> String
NoThunks, CompactForm Coin -> ()
(CompactForm Coin -> ()) -> NFData (CompactForm Coin)
forall a. (a -> ()) -> NFData a
$crnf :: CompactForm Coin -> ()
rnf :: CompactForm Coin -> ()
NFData, Addr# -> Int# -> CompactForm Coin
ByteArray# -> Int# -> CompactForm Coin
Proxy (CompactForm Coin) -> Int#
CompactForm Coin -> Int#
(Proxy (CompactForm Coin) -> Int#)
-> (CompactForm Coin -> Int#)
-> (Proxy (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.
(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
$csizeOfType# :: Proxy (CompactForm Coin) -> Int#
sizeOfType# :: Proxy (CompactForm Coin) -> Int#
$csizeOf# :: CompactForm Coin -> Int#
sizeOf# :: CompactForm Coin -> Int#
$calignmentOfType# :: Proxy (CompactForm Coin) -> Int#
alignmentOfType# :: Proxy (CompactForm Coin) -> Int#
$calignment# :: CompactForm Coin -> Int#
alignment# :: CompactForm Coin -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> CompactForm Coin
indexByteArray# :: ByteArray# -> Int# -> CompactForm Coin
$creadByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, CompactForm Coin #)
readByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, CompactForm Coin #)
$cwriteByteArray# :: forall s.
MutableByteArray# s
-> Int# -> CompactForm Coin -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s
-> Int# -> CompactForm Coin -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> CompactForm Coin -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> CompactForm Coin -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> CompactForm Coin
indexOffAddr# :: Addr# -> Int# -> CompactForm Coin
$creadOffAddr# :: forall s.
Addr# -> Int# -> State# s -> (# State# s, CompactForm Coin #)
readOffAddr# :: forall s.
Addr# -> Int# -> State# s -> (# State# s, CompactForm Coin #)
$cwriteOffAddr# :: forall s. Addr# -> Int# -> CompactForm Coin -> State# s -> State# s
writeOffAddr# :: forall s. Addr# -> Int# -> CompactForm Coin -> State# s -> State# s
$csetOffAddr# :: forall s.
Addr# -> Int# -> Int# -> CompactForm Coin -> State# s -> State# s
setOffAddr# :: forall s.
Addr# -> Int# -> Int# -> CompactForm Coin -> State# s -> State# s
Prim, Eq (CompactForm Coin)
Eq (CompactForm Coin) =>
(CompactForm Coin -> CompactForm Coin -> Ordering)
-> (CompactForm Coin -> CompactForm Coin -> Bool)
-> (CompactForm Coin -> CompactForm Coin -> Bool)
-> (CompactForm Coin -> CompactForm Coin -> Bool)
-> (CompactForm Coin -> CompactForm Coin -> Bool)
-> (CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> (CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> Ord (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
$ccompare :: CompactForm Coin -> CompactForm Coin -> Ordering
compare :: CompactForm Coin -> CompactForm Coin -> Ordering
$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
>= :: CompactForm Coin -> CompactForm Coin -> Bool
$cmax :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
max :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
$cmin :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
min :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
Ord, Typeable (CompactForm Coin)
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)
-> ToCBOR (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
$ctoCBOR :: CompactForm Coin -> Encoding
toCBOR :: CompactForm Coin -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (CompactForm Coin) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (CompactForm Coin) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [CompactForm Coin] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [CompactForm Coin] -> Size
ToCBOR, [CompactForm Coin] -> Value
[CompactForm Coin] -> Encoding
CompactForm Coin -> Bool
CompactForm Coin -> Value
CompactForm Coin -> Encoding
(CompactForm Coin -> Value)
-> (CompactForm Coin -> Encoding)
-> ([CompactForm Coin] -> Value)
-> ([CompactForm Coin] -> Encoding)
-> (CompactForm Coin -> Bool)
-> ToJSON (CompactForm Coin)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CompactForm Coin -> Value
toJSON :: CompactForm Coin -> Value
$ctoEncoding :: CompactForm Coin -> Encoding
toEncoding :: CompactForm Coin -> Encoding
$ctoJSONList :: [CompactForm Coin] -> Value
toJSONList :: [CompactForm Coin] -> Value
$ctoEncodingList :: [CompactForm Coin] -> Encoding
toEncodingList :: [CompactForm Coin] -> Encoding
$comitField :: CompactForm Coin -> Bool
omitField :: CompactForm Coin -> Bool
ToJSON, Maybe (CompactForm Coin)
Value -> Parser [CompactForm Coin]
Value -> Parser (CompactForm Coin)
(Value -> Parser (CompactForm Coin))
-> (Value -> Parser [CompactForm Coin])
-> Maybe (CompactForm Coin)
-> FromJSON (CompactForm Coin)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser (CompactForm Coin)
parseJSON :: Value -> Parser (CompactForm Coin)
$cparseJSONList :: Value -> Parser [CompactForm Coin]
parseJSONList :: Value -> Parser [CompactForm Coin]
$comittedField :: Maybe (CompactForm Coin)
omittedField :: Maybe (CompactForm Coin)
FromJSON)
    deriving (NonEmpty (CompactForm Coin) -> CompactForm Coin
CompactForm Coin -> CompactForm Coin -> CompactForm Coin
(CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> (NonEmpty (CompactForm Coin) -> CompactForm Coin)
-> (forall b.
    Integral b =>
    b -> CompactForm Coin -> CompactForm Coin)
-> Semigroup (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
$c<> :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
<> :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
$csconcat :: NonEmpty (CompactForm Coin) -> CompactForm Coin
sconcat :: NonEmpty (CompactForm Coin) -> CompactForm Coin
$cstimes :: forall b. Integral b => b -> CompactForm Coin -> CompactForm Coin
stimes :: forall b. Integral b => b -> CompactForm Coin -> CompactForm Coin
Semigroup, Semigroup (CompactForm Coin)
CompactForm Coin
Semigroup (CompactForm Coin) =>
CompactForm Coin
-> (CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> ([CompactForm Coin] -> CompactForm Coin)
-> Monoid (CompactForm Coin)
[CompactForm Coin] -> CompactForm Coin
CompactForm Coin -> CompactForm Coin -> CompactForm Coin
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: CompactForm Coin
mempty :: CompactForm Coin
$cmappend :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
mappend :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
$cmconcat :: [CompactForm Coin] -> CompactForm Coin
mconcat :: [CompactForm Coin] -> CompactForm Coin
Monoid, Monoid (CompactForm Coin)
Monoid (CompactForm Coin) =>
(CompactForm Coin -> CompactForm Coin)
-> (CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> (forall x.
    Integral x =>
    CompactForm Coin -> x -> CompactForm Coin)
-> Group (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
$cinvert :: CompactForm Coin -> CompactForm Coin
invert :: CompactForm Coin -> CompactForm Coin
$c~~ :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
~~ :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
$cpow :: forall x. Integral x => CompactForm Coin -> x -> CompactForm Coin
pow :: forall x. Integral x => CompactForm Coin -> x -> CompactForm Coin
Group, Group (CompactForm Coin)
Group (CompactForm Coin) => Abelian (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 (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 Word64
c) = Word64 -> Coin
word64ToCoin Word64
c

-- | This instance prefixes with a 0 Tag for binary compatibility with compact form of multiassets.
instance MemPack (CompactForm Coin) where
  packedByteCount :: CompactForm Coin -> Int
packedByteCount (CompactCoin Word64
c) =
    Int
packedTagByteCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ VarLen Word64 -> Int
forall a. MemPack a => a -> Int
packedByteCount (Word64 -> VarLen Word64
forall a. a -> VarLen a
VarLen Word64
c)
  {-# INLINE packedByteCount #-}
  packM :: forall s. CompactForm Coin -> Pack s ()
packM (CompactCoin Word64
c) = Tag -> Pack s ()
forall s. Tag -> Pack s ()
packTagM Tag
0 Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> VarLen Word64 -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
forall s. VarLen Word64 -> Pack s ()
packM (Word64 -> VarLen Word64
forall a. a -> VarLen a
VarLen Word64
c)
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b (CompactForm Coin)
unpackM = do
    Unpack b Tag
forall b. Buffer b => Unpack b Tag
unpackTagM Unpack b Tag
-> (Tag -> Unpack b (CompactForm Coin))
-> Unpack b (CompactForm Coin)
forall a b. Unpack b a -> (a -> Unpack b b) -> Unpack b b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Tag
0 -> Word64 -> CompactForm Coin
CompactCoin (Word64 -> CompactForm Coin)
-> (VarLen Word64 -> Word64) -> VarLen Word64 -> CompactForm Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarLen Word64 -> Word64
forall a. VarLen a -> a
unVarLen (VarLen Word64 -> CompactForm Coin)
-> Unpack b (VarLen Word64) -> Unpack b (CompactForm Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b (VarLen Word64)
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b (VarLen Word64)
unpackM
      Tag
n -> forall a (m :: * -> *) b. (MemPack a, MonadFail m) => Tag -> m b
unknownTagM @(CompactForm Coin) Tag
n
  {-# INLINE unpackM #-}

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
$c== :: CompactForm DeltaCoin -> CompactForm DeltaCoin -> Bool
== :: CompactForm DeltaCoin -> CompactForm DeltaCoin -> Bool
$c/= :: CompactForm DeltaCoin -> CompactForm DeltaCoin -> Bool
/= :: 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
$cshowsPrec :: Int -> CompactForm DeltaCoin -> ShowS
showsPrec :: Int -> CompactForm DeltaCoin -> ShowS
$cshow :: CompactForm DeltaCoin -> String
show :: CompactForm DeltaCoin -> String
$cshowList :: [CompactForm DeltaCoin] -> ShowS
showList :: [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
$cnoThunks :: Context -> CompactForm DeltaCoin -> IO (Maybe ThunkInfo)
noThunks :: Context -> CompactForm DeltaCoin -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CompactForm DeltaCoin -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CompactForm DeltaCoin -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (CompactForm DeltaCoin) -> String
showTypeOf :: Proxy (CompactForm DeltaCoin) -> String
NoThunks, CompactForm DeltaCoin -> ()
(CompactForm DeltaCoin -> ()) -> NFData (CompactForm DeltaCoin)
forall a. (a -> ()) -> NFData a
$crnf :: CompactForm DeltaCoin -> ()
rnf :: CompactForm DeltaCoin -> ()
NFData, [CompactForm DeltaCoin] -> Value
[CompactForm DeltaCoin] -> Encoding
CompactForm DeltaCoin -> Bool
CompactForm DeltaCoin -> Value
CompactForm DeltaCoin -> Encoding
(CompactForm DeltaCoin -> Value)
-> (CompactForm DeltaCoin -> Encoding)
-> ([CompactForm DeltaCoin] -> Value)
-> ([CompactForm DeltaCoin] -> Encoding)
-> (CompactForm DeltaCoin -> Bool)
-> ToJSON (CompactForm DeltaCoin)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CompactForm DeltaCoin -> Value
toJSON :: CompactForm DeltaCoin -> Value
$ctoEncoding :: CompactForm DeltaCoin -> Encoding
toEncoding :: CompactForm DeltaCoin -> Encoding
$ctoJSONList :: [CompactForm DeltaCoin] -> Value
toJSONList :: [CompactForm DeltaCoin] -> Value
$ctoEncodingList :: [CompactForm DeltaCoin] -> Encoding
toEncodingList :: [CompactForm DeltaCoin] -> Encoding
$comitField :: CompactForm DeltaCoin -> Bool
omitField :: CompactForm DeltaCoin -> Bool
ToJSON, Addr# -> Int# -> CompactForm DeltaCoin
ByteArray# -> Int# -> CompactForm DeltaCoin
Proxy (CompactForm DeltaCoin) -> Int#
CompactForm DeltaCoin -> Int#
(Proxy (CompactForm DeltaCoin) -> Int#)
-> (CompactForm DeltaCoin -> Int#)
-> (Proxy (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.
(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
$csizeOfType# :: Proxy (CompactForm DeltaCoin) -> Int#
sizeOfType# :: Proxy (CompactForm DeltaCoin) -> Int#
$csizeOf# :: CompactForm DeltaCoin -> Int#
sizeOf# :: CompactForm DeltaCoin -> Int#
$calignmentOfType# :: Proxy (CompactForm DeltaCoin) -> Int#
alignmentOfType# :: Proxy (CompactForm DeltaCoin) -> Int#
$calignment# :: CompactForm DeltaCoin -> Int#
alignment# :: CompactForm DeltaCoin -> Int#
$cindexByteArray# :: ByteArray# -> Int# -> CompactForm DeltaCoin
indexByteArray# :: ByteArray# -> Int# -> CompactForm DeltaCoin
$creadByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, CompactForm DeltaCoin #)
readByteArray# :: forall s.
MutableByteArray# s
-> Int# -> State# s -> (# State# s, CompactForm DeltaCoin #)
$cwriteByteArray# :: forall s.
MutableByteArray# s
-> Int# -> CompactForm DeltaCoin -> State# s -> State# s
writeByteArray# :: forall s.
MutableByteArray# s
-> Int# -> CompactForm DeltaCoin -> State# s -> State# s
$csetByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
setByteArray# :: forall s.
MutableByteArray# s
-> Int# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
$cindexOffAddr# :: Addr# -> Int# -> CompactForm DeltaCoin
indexOffAddr# :: Addr# -> Int# -> CompactForm DeltaCoin
$creadOffAddr# :: forall s.
Addr# -> Int# -> State# s -> (# State# s, CompactForm DeltaCoin #)
readOffAddr# :: forall s.
Addr# -> Int# -> State# s -> (# State# s, CompactForm DeltaCoin #)
$cwriteOffAddr# :: forall s.
Addr# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
writeOffAddr# :: forall s.
Addr# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
$csetOffAddr# :: forall s.
Addr#
-> Int# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
setOffAddr# :: forall s.
Addr#
-> Int# -> Int# -> CompactForm DeltaCoin -> State# s -> State# s
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 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 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 #-}

compactCoinOrError :: HasCallStack => Coin -> CompactForm Coin
compactCoinOrError :: HasCallStack => Coin -> CompactForm Coin
compactCoinOrError Coin
c =
  case Coin -> Maybe (CompactForm Coin)
forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact Coin
c of
    Maybe (CompactForm Coin)
Nothing -> String -> CompactForm Coin
forall a. HasCallStack => String -> a
error (String -> CompactForm Coin) -> String -> CompactForm Coin
forall a b. (a -> b) -> a -> b
$ String
"Invalid ADA value: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Coin -> String
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) = Word64 -> Encoding
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 (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 s. Decoder s Word64
forall a s. DecCBOR a => Decoder s a
decCBOR

instance EncCBOR (CompactForm DeltaCoin) where
  encCBOR :: CompactForm DeltaCoin -> Encoding
encCBOR (CompactDeltaCoin Word64
c) = Word64 -> Encoding
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 (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 s. Decoder s Word64
forall a s. DecCBOR a => Decoder s a
decCBOR

addCompactCoin :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompactCoin :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompactCoin (CompactCoin Word64
x) (CompactCoin Word64
y) = Word64 -> CompactForm Coin
CompactCoin (Word64
x Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
y)

sumCompactCoin :: Foldable t => t (CompactForm Coin) -> CompactForm Coin
sumCompactCoin :: forall (t :: * -> *).
Foldable t =>
t (CompactForm Coin) -> CompactForm Coin
sumCompactCoin = (CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> CompactForm Coin -> t (CompactForm Coin) -> CompactForm Coin
forall b a. (b -> a -> b) -> b -> t a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompactCoin (Word64 -> CompactForm Coin
CompactCoin Word64
0)

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

decodePositiveCoin :: String -> Decoder s Coin
decodePositiveCoin :: forall s. String -> Decoder s Coin
decodePositiveCoin String
errorMessage = do
  Word64
n <- Decoder s Word64
forall s. Decoder s Word64
decodeWord64
  if Word64
n Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0
    then String -> Decoder s Coin
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s Coin) -> String -> Decoder s Coin
forall a b. (a -> b) -> a -> b
$ String
errorMessage String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": Expected a positive Coin. Got 0 (zero)."
    else Coin -> Decoder s Coin
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Coin -> Decoder s Coin) -> Coin -> Decoder s Coin
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin (Word64 -> Integer
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 = CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm Coin -> Coin) -> m (CompactForm Coin) -> m Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g -> m (CompactForm Coin)
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
forall g (m :: * -> *).
StatefulGen g m =>
g -> m (CompactForm Coin)
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 (Word64 -> CompactForm Coin) -> m Word64 -> m (CompactForm Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> g -> m Word64
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
forall g (m :: * -> *). StatefulGen g m => g -> m Word64
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 = CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm Coin -> Coin) -> m (CompactForm Coin) -> m Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CompactForm Coin, CompactForm Coin) -> g -> m (CompactForm Coin)
forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
forall g (m :: * -> *).
StatefulGen g m =>
(CompactForm Coin, CompactForm Coin) -> g -> m (CompactForm Coin)
uniformRM (HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
compactCoinOrError Coin
l, HasCallStack => Coin -> CompactForm Coin
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 (Word64 -> CompactForm Coin) -> m Word64 -> m (CompactForm Coin)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> g -> m Word64
forall a g (m :: * -> *).
(UniformRange a, StatefulGen g m) =>
(a, a) -> g -> m a
forall g (m :: * -> *).
StatefulGen g m =>
(Word64, Word64) -> g -> m Word64
uniformRM (Word64
l, Word64
h) g
g

instance HasZero Coin where
  isZero :: Coin -> Bool
isZero = (Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Coin
Coin Integer
0)

toCompactCoinNonZero :: NonZero Coin -> Maybe (NonZero (CompactForm Coin))
toCompactCoinNonZero :: NonZero Coin -> Maybe (NonZero (CompactForm Coin))
toCompactCoinNonZero = (CompactForm Coin -> NonZero (CompactForm Coin))
-> Maybe (CompactForm Coin) -> Maybe (NonZero (CompactForm Coin))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CompactForm Coin -> NonZero (CompactForm Coin)
forall a. a -> NonZero a
unsafeNonZero (Maybe (CompactForm Coin) -> Maybe (NonZero (CompactForm Coin)))
-> (NonZero Coin -> Maybe (CompactForm Coin))
-> NonZero Coin
-> Maybe (NonZero (CompactForm Coin))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Maybe (CompactForm Coin)
forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact (Coin -> Maybe (CompactForm Coin))
-> (NonZero Coin -> Coin)
-> NonZero Coin
-> Maybe (CompactForm Coin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonZero Coin -> Coin
forall a. NonZero a -> a
unNonZero

fromCompactCoinNonZero :: NonZero (CompactForm Coin) -> NonZero Coin
fromCompactCoinNonZero :: NonZero (CompactForm Coin) -> NonZero Coin
fromCompactCoinNonZero = Coin -> NonZero Coin
forall a. a -> NonZero a
unsafeNonZero (Coin -> NonZero Coin)
-> (NonZero (CompactForm Coin) -> Coin)
-> NonZero (CompactForm Coin)
-> NonZero Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompactForm Coin -> Coin
forall a. Compactible a => CompactForm a -> a
fromCompact (CompactForm Coin -> Coin)
-> (NonZero (CompactForm Coin) -> CompactForm Coin)
-> NonZero (CompactForm Coin)
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonZero (CompactForm Coin) -> CompactForm Coin
forall a. NonZero a -> a
unNonZero

unCoinNonZero :: NonZero Coin -> NonZero Integer
unCoinNonZero :: NonZero Coin -> NonZero Integer
unCoinNonZero = Integer -> NonZero Integer
forall a. a -> NonZero a
unsafeNonZero (Integer -> NonZero Integer)
-> (NonZero Coin -> Integer) -> NonZero Coin -> NonZero Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Integer
unCoin (Coin -> Integer)
-> (NonZero Coin -> Coin) -> NonZero Coin -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonZero Coin -> Coin
forall a. NonZero a -> a
unNonZero

toCoinNonZero :: Integral a => NonZero a -> NonZero Coin
toCoinNonZero :: forall a. Integral a => NonZero a -> NonZero Coin
toCoinNonZero = Coin -> NonZero Coin
forall a. a -> NonZero a
unsafeNonZero (Coin -> NonZero Coin)
-> (NonZero a -> Coin) -> NonZero a -> NonZero Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Coin
Coin (Integer -> Coin) -> (NonZero a -> Integer) -> NonZero a -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Integer
forall a. Integral a => a -> Integer
toInteger (a -> Integer) -> (NonZero a -> a) -> NonZero a -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonZero a -> a
forall a. NonZero a -> a
unNonZero

compactCoinNonZero :: NonZero Word64 -> NonZero (CompactForm Coin)
compactCoinNonZero :: NonZero Word64 -> NonZero (CompactForm Coin)
compactCoinNonZero = CompactForm Coin -> NonZero (CompactForm Coin)
forall a. a -> NonZero a
unsafeNonZero (CompactForm Coin -> NonZero (CompactForm Coin))
-> (NonZero Word64 -> CompactForm Coin)
-> NonZero Word64
-> NonZero (CompactForm Coin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> CompactForm Coin
CompactCoin (Word64 -> CompactForm Coin)
-> (NonZero Word64 -> Word64) -> NonZero Word64 -> CompactForm Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero