{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}

-- | This module defines a generalised notion of a "value" - that is, something
-- with which we may quantify a transaction output.
module Cardano.Ledger.Val (
  Val (..),
  inject,
  scale,
  invert,
  sumVal,
  adaOnly,
)
where

import Cardano.Ledger.BaseTypes (Inject (..))
import Cardano.Ledger.Binary (DecCBOR, EncCBOR)
import Cardano.Ledger.Coin (Coin (..), CompactForm (..), DeltaCoin (..))
import Cardano.Ledger.Compactible (Compactible (..))
import Control.DeepSeq (NFData)
import Data.Aeson (ToJSON)
import Data.Coerce
import Data.Foldable as F (foldl')
import Data.Group (Abelian)
import NoThunks.Class (NoThunks)

class
  ( Compactible t
  , Inject Coin t
  , EncCBOR (CompactForm t)
  , DecCBOR (CompactForm t)
  , Abelian t
  , NoThunks t
  , EncCBOR t
  , DecCBOR t
  , ToJSON t
  , NFData t
  , Show t
  , Eq t
  ) =>
  Val t
  where
  -- | the value with nothing in it
  zero :: t
  zero = forall a. Monoid a => a
mempty

  -- | add two value
  (<+>) :: t -> t -> t
  t
x <+> t
y = t
x forall a. Semigroup a => a -> a -> a
<> t
y

  -- | scale a value by an Integral constant
  (<×>) :: Integral i => i -> t -> t

  -- | subtract two values
  (<->) :: t -> t -> t
  t
x <-> t
y = t
x forall t. Val t => t -> t -> t
<+> ((-Integer
1 :: Integer) forall t i. (Val t, Integral i) => i -> t -> t
<×> t
y)

  -- | Is the argument zero?
  isZero :: t -> Bool
  isZero t
t = t
t forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty

  -- | Get the ADA present in the value (since ADA is our "blessed" currency)
  coin :: t -> Coin

  -- | modify the blessed Coin part of t
  modifyCoin :: (Coin -> Coin) -> t -> t

  size :: t -> Integer -- compute size of Val instance

  -- | used to compare values pointwise. Rather than using: (v1 <= v2) use: pointwise (<=) v1 v2
  -- | If a quantity is stored in only one of 'v1' or 'v2', we use 0 for the missing quantity.
  pointwise :: (Integer -> Integer -> Bool) -> t -> t -> Bool

  -- | Check if value contains only ADA. Must hold property:
  --
  -- > inject (coin v) == v
  isAdaOnly :: t -> Bool

  isAdaOnlyCompact :: CompactForm t -> Bool

  coinCompact :: CompactForm t -> CompactForm Coin

  injectCompact :: CompactForm Coin -> CompactForm t

  modifyCompactCoin :: (CompactForm Coin -> CompactForm Coin) -> CompactForm t -> CompactForm t

-- =============================================================
-- Synonyms with types fixed at (Val t). Makes calls easier
-- to read, and gives better error messages, when a mistake is made

infixl 6 <+>

infixl 6 <->

infixl 7 <×>

scale :: (Val t, Integral i) => i -> t -> t
scale :: forall t i. (Val t, Integral i) => i -> t -> t
scale i
i t
v = i
i forall t i. (Val t, Integral i) => i -> t -> t
<×> t
v

sumVal :: (Foldable t, Val v) => t v -> v
sumVal :: forall (t :: * -> *) v. (Foldable t, Val v) => t v -> v
sumVal = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' forall t. Val t => t -> t -> t
(<+>) forall a. Monoid a => a
mempty

invert :: Val t => t -> t
invert :: forall t. Val t => t -> t
invert t
x = (-Integer
1 :: Integer) forall t i. (Val t, Integral i) => i -> t -> t
<×> t
x

-- returns a Value containing only the coin (ada) tokens from the input Value
adaOnly :: Val v => v -> Bool
adaOnly :: forall v. Val v => v -> Bool
adaOnly v
v = (forall t s. Inject t s => t -> s
inject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Val t => t -> Coin
coin) v
v forall a. Eq a => a -> a -> Bool
== v
v
{-# DEPRECATED adaOnly "In favor of `isAdaOnly`" #-}

instance Val Coin where
  i
n <×> :: forall i. Integral i => i -> Coin -> Coin
<×> (Coin Integer
x) = Integer -> Coin
Coin forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral i
n forall a. Num a => a -> a -> a
* Integer
x
  coin :: Coin -> Coin
coin = forall a. a -> a
id
  size :: Coin -> Integer
size Coin
_ = Integer
1
  modifyCoin :: (Coin -> Coin) -> Coin -> Coin
modifyCoin Coin -> Coin
f Coin
v = Coin -> Coin
f Coin
v
  pointwise :: (Integer -> Integer -> Bool) -> Coin -> Coin -> Bool
pointwise Integer -> Integer -> Bool
p (Coin Integer
x) (Coin Integer
y) = Integer -> Integer -> Bool
p Integer
x Integer
y
  isAdaOnly :: Coin -> Bool
isAdaOnly Coin
_ = Bool
True
  isAdaOnlyCompact :: CompactForm Coin -> Bool
isAdaOnlyCompact CompactForm Coin
_ = Bool
True
  coinCompact :: CompactForm Coin -> CompactForm Coin
coinCompact = forall a. a -> a
id
  injectCompact :: CompactForm Coin -> CompactForm Coin
injectCompact = forall a. a -> a
id
  modifyCompactCoin :: (CompactForm Coin -> CompactForm Coin)
-> CompactForm Coin -> CompactForm Coin
modifyCompactCoin = forall a b. (a -> b) -> a -> b
($)

instance Val DeltaCoin where
  i
n <×> :: forall i. Integral i => i -> DeltaCoin -> DeltaCoin
<×> (DeltaCoin Integer
x) = Integer -> DeltaCoin
DeltaCoin forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral i
n forall a. Num a => a -> a -> a
* Integer
x
  coin :: DeltaCoin -> Coin
coin = coerce :: forall a b. Coercible a b => a -> b
coerce
  size :: DeltaCoin -> Integer
size DeltaCoin
_ = Integer
1
  modifyCoin :: (Coin -> Coin) -> DeltaCoin -> DeltaCoin
modifyCoin Coin -> Coin
f DeltaCoin
v = coerce :: forall a b. Coercible a b => a -> b
coerce Coin -> Coin
f DeltaCoin
v
  pointwise :: (Integer -> Integer -> Bool) -> DeltaCoin -> DeltaCoin -> Bool
pointwise Integer -> Integer -> Bool
p (DeltaCoin Integer
x) (DeltaCoin Integer
y) = Integer -> Integer -> Bool
p Integer
x Integer
y
  isAdaOnly :: DeltaCoin -> Bool
isAdaOnly DeltaCoin
_ = Bool
True
  isAdaOnlyCompact :: CompactForm DeltaCoin -> Bool
isAdaOnlyCompact CompactForm DeltaCoin
_ = Bool
True
  coinCompact :: CompactForm DeltaCoin -> CompactForm Coin
coinCompact (CompactDeltaCoin Word64
cc) = Word64 -> CompactForm Coin
CompactCoin Word64
cc
  injectCompact :: CompactForm Coin -> CompactForm DeltaCoin
injectCompact (CompactCoin Word64
cc) = Word64 -> CompactForm DeltaCoin
CompactDeltaCoin Word64
cc
  modifyCompactCoin :: (CompactForm Coin -> CompactForm Coin)
-> CompactForm DeltaCoin -> CompactForm DeltaCoin
modifyCompactCoin CompactForm Coin -> CompactForm Coin
f (CompactDeltaCoin Word64
cc) =
    case CompactForm Coin -> CompactForm Coin
f (Word64 -> CompactForm Coin
CompactCoin Word64
cc) of
      CompactCoin Word64
cc' -> Word64 -> CompactForm DeltaCoin
CompactDeltaCoin Word64
cc'