{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      :  Network.Ethereum.Unit
-- Copyright   :  Aleksandr Krupenkin 2016-2021
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  unportable
--
-- Ethereum has a metric system of denominations used as units of ether.
-- Each denomination has its own unique name (some bear the family name
-- of seminal figures playing a role in evolution of computer science
-- and cryptoeconomics). The smallest denomination aka base unit of ether
-- is called 'Wei'. Below is a list of the named denominations and their
-- value in 'Wei'. Following a common (although somewhat ambiguous) pattern,
-- ether also designates a unit (of 1e18 or one quintillion 'Wei') of the
-- currency. Note that the currency is not called Ethereum as many mistakenly
-- think, nor is Ethereum a unit.
--
-- In Haskell the Ethereum unit system presented as set of types: 'Wei',
-- 'Szabo', 'Finney', etc. They are members of 'Unit' typeclass. Also available
-- standart 'Show', 'Read', 'Num' operations over Ethereum units.
--
-- @
-- > let x = 1.2 :: Ether
-- > toWei x
-- 1200000000000000000
--
-- > let y = x + 2
-- > y
-- 3.20 ether
--
-- > let z = 15 :: Szabo
-- > y + z
--
-- <interactive>:6:5: error:
--    • Couldn't match type ‘Network.Ethereum.Unit.U4’
--                    with ‘Network.Ethereum.Unit.U6’
--      Expected type: Ether
--      Actual type: Szabo
-- @
--

module Network.Ethereum.Unit
    (
    -- * The @Unit@ type class
      Unit(..)

    -- * Ethereum value metrics
    , Wei
    , Babbage
    , Lovelace
    , Shannon
    , Szabo
    , Finney
    , Ether
    , KEther
    ) where

import           Data.Proxy                      (Proxy (..))
import           Data.Text.Lazy                  (Text, unpack)
import           GHC.Generics                    (Generic)
import           GHC.Read
import           Text.ParserCombinators.ReadPrec
import           Text.Printf
import qualified Text.Read.Lex                   as L

-- | Ethereum value unit
class (Read a, Show a, UnitSpec a, Fractional a) => Unit a where
    -- | Make a value from integer wei
    fromWei :: Integral b => b -> a

    -- | Convert a value to integer wei
    toWei :: Integral b => a -> b

-- | Unit specification
class UnitSpec a where
    divider :: RealFrac b => proxy a -> b
    name    :: proxy a -> Text

-- | Value abstraction
newtype Value a = MkValue { Value a -> Integer
unValue :: Integer }
  deriving (Value a -> Value a -> Bool
(Value a -> Value a -> Bool)
-> (Value a -> Value a -> Bool) -> Eq (Value a)
forall a. Value a -> Value a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value a -> Value a -> Bool
$c/= :: forall a. Value a -> Value a -> Bool
== :: Value a -> Value a -> Bool
$c== :: forall a. Value a -> Value a -> Bool
Eq, Eq (Value a)
Eq (Value a)
-> (Value a -> Value a -> Ordering)
-> (Value a -> Value a -> Bool)
-> (Value a -> Value a -> Bool)
-> (Value a -> Value a -> Bool)
-> (Value a -> Value a -> Bool)
-> (Value a -> Value a -> Value a)
-> (Value a -> Value a -> Value a)
-> Ord (Value a)
Value a -> Value a -> Bool
Value a -> Value a -> Ordering
Value a -> Value a -> Value a
forall a. Eq (Value a)
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
forall a. Value a -> Value a -> Bool
forall a. Value a -> Value a -> Ordering
forall a. Value a -> Value a -> Value a
min :: Value a -> Value a -> Value a
$cmin :: forall a. Value a -> Value a -> Value a
max :: Value a -> Value a -> Value a
$cmax :: forall a. Value a -> Value a -> Value a
>= :: Value a -> Value a -> Bool
$c>= :: forall a. Value a -> Value a -> Bool
> :: Value a -> Value a -> Bool
$c> :: forall a. Value a -> Value a -> Bool
<= :: Value a -> Value a -> Bool
$c<= :: forall a. Value a -> Value a -> Bool
< :: Value a -> Value a -> Bool
$c< :: forall a. Value a -> Value a -> Bool
compare :: Value a -> Value a -> Ordering
$ccompare :: forall a. Value a -> Value a -> Ordering
$cp1Ord :: forall a. Eq (Value a)
Ord, (forall x. Value a -> Rep (Value a) x)
-> (forall x. Rep (Value a) x -> Value a) -> Generic (Value a)
forall x. Rep (Value a) x -> Value a
forall x. Value a -> Rep (Value a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Value a) x -> Value a
forall a x. Value a -> Rep (Value a) x
$cto :: forall a x. Rep (Value a) x -> Value a
$cfrom :: forall a x. Value a -> Rep (Value a) x
Generic)

mkValue :: forall a b . (UnitSpec a, RealFrac b) => b -> Value a
mkValue :: b -> Value a
mkValue = Integer -> Value a
forall a. Integer -> Value a
MkValue (Integer -> Value a) -> (b -> Integer) -> b -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (b -> Integer) -> (b -> b) -> b -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> b -> b
forall a. Num a => a -> a -> a
* Proxy a -> b
forall a b (proxy :: * -> *).
(UnitSpec a, RealFrac b) =>
proxy a -> b
divider (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a))

instance UnitSpec a => Unit (Value a) where
    fromWei :: b -> Value a
fromWei = Integer -> Value a
forall a. Integer -> Value a
MkValue (Integer -> Value a) -> (b -> Integer) -> b -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Integer
forall a. Integral a => a -> Integer
toInteger
    toWei :: Value a -> b
toWei   = Integer -> b
forall a. Num a => Integer -> a
fromInteger (Integer -> b) -> (Value a -> Integer) -> Value a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value a -> Integer
forall a. Value a -> Integer
unValue

instance UnitSpec a => UnitSpec (Value a) where
    divider :: proxy (Value a) -> b
divider = b -> proxy (Value a) -> b
forall a b. a -> b -> a
const (b -> proxy (Value a) -> b) -> b -> proxy (Value a) -> b
forall a b. (a -> b) -> a -> b
$ Proxy a -> b
forall a b (proxy :: * -> *).
(UnitSpec a, RealFrac b) =>
proxy a -> b
divider (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
    name :: proxy (Value a) -> Text
name    = Text -> proxy (Value a) -> Text
forall a b. a -> b -> a
const (Text -> proxy (Value a) -> Text)
-> Text -> proxy (Value a) -> Text
forall a b. (a -> b) -> a -> b
$ Proxy a -> Text
forall a (proxy :: * -> *). UnitSpec a => proxy a -> Text
name (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)

instance UnitSpec a => Num (Value a) where
   Value a
a + :: Value a -> Value a -> Value a
+ Value a
b = Integer -> Value a
forall a. Integer -> Value a
MkValue (Value a -> Integer
forall a. Value a -> Integer
unValue Value a
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Value a -> Integer
forall a. Value a -> Integer
unValue Value a
b)
   Value a
a - :: Value a -> Value a -> Value a
- Value a
b = Integer -> Value a
forall a. Integer -> Value a
MkValue (Value a -> Integer
forall a. Value a -> Integer
unValue Value a
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Value a -> Integer
forall a. Value a -> Integer
unValue Value a
b)
   Value a
a * :: Value a -> Value a -> Value a
* Value a
b = Integer -> Value a
forall a. Integer -> Value a
MkValue (Value a -> Integer
forall a. Value a -> Integer
unValue Value a
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Value a -> Integer
forall a. Value a -> Integer
unValue Value a
b)

   signum :: Value a -> Value a
signum (MkValue Integer
a) = Integer -> Value a
forall a. Integer -> Value a
MkValue (Integer -> Integer
forall a. Num a => a -> a
abs Integer
a)
   abs :: Value a -> Value a
abs (MkValue Integer
a)    = Integer -> Value a
forall a. Integer -> Value a
MkValue (Integer -> Integer
forall a. Num a => a -> a
abs Integer
a)
   fromInteger :: Integer -> Value a
fromInteger        = Double -> Value a
forall a b. (UnitSpec a, RealFrac b) => b -> Value a
mkValue (Double -> Value a) -> (Integer -> Double) -> Integer -> Value a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance UnitSpec a => Fractional (Value a) where
    Value a
a / :: Value a -> Value a -> Value a
/ Value a
b = Integer -> Value a
forall a. Integer -> Value a
MkValue (Value a -> Integer
forall a. Value a -> Integer
unValue Value a
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Value a -> Integer
forall a. Value a -> Integer
unValue Value a
b)
    fromRational :: Rational -> Value a
fromRational = Rational -> Value a
forall a b. (UnitSpec a, RealFrac b) => b -> Value a
mkValue

instance UnitSpec a => Show (Value a) where
    show :: Value a -> String
show Value a
val = String -> Double -> Text -> String
forall r. PrintfType r => String -> r
printf String
"%F %s" (Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
d :: Double) (Value a -> Text
forall a (proxy :: * -> *). UnitSpec a => proxy a -> Text
name Value a
val)
      where
        x :: Double
x = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Value a -> Integer
forall a. Value a -> Integer
unValue Value a
val)
        d :: Double
d = Value a -> Double
forall a b (proxy :: * -> *).
(UnitSpec a, RealFrac b) =>
proxy a -> b
divider Value a
val

instance UnitSpec a => Read (Value a) where
    readPrec :: ReadPrec (Value a)
readPrec = ReadPrec (Value a) -> ReadPrec (Value a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (Value a) -> ReadPrec (Value a))
-> ReadPrec (Value a) -> ReadPrec (Value a)
forall a b. (a -> b) -> a -> b
$ do
        Double
x <- ReadPrec Double
forall a. Read a => ReadPrec a
readPrec
        let res :: Value a
res = Double -> Value a
forall a b. (UnitSpec a, RealFrac b) => b -> Value a
mkValue Double
x
            resName :: String
resName = Text -> String
unpack (Value a -> Text
forall a (proxy :: * -> *). UnitSpec a => proxy a -> Text
name Value a
res)
        ReadPrec () -> ReadPrec ()
forall a. ReadPrec a -> ReadPrec a
step (ReadPrec () -> ReadPrec ()) -> ReadPrec () -> ReadPrec ()
forall a b. (a -> b) -> a -> b
$ Lexeme -> ReadPrec ()
expectP (String -> Lexeme
L.Ident String
resName)
        Value a -> ReadPrec (Value a)
forall (m :: * -> *) a. Monad m => a -> m a
return Value a
res

data U0
data U1
data U2
data U3
data U4
data U5
data U6
data U7

-- | Wei unit type
type Wei = Value U0

instance UnitSpec U0 where
    divider :: proxy U0 -> b
divider = b -> proxy U0 -> b
forall a b. a -> b -> a
const b
1
    name :: proxy U0 -> Text
name    = Text -> proxy U0 -> Text
forall a b. a -> b -> a
const Text
"wei"

-- | Babbage unit type
type Babbage = Value U1

instance UnitSpec U1 where
    divider :: proxy U1 -> b
divider = b -> proxy U1 -> b
forall a b. a -> b -> a
const b
1e3
    name :: proxy U1 -> Text
name    = Text -> proxy U1 -> Text
forall a b. a -> b -> a
const Text
"babbage"

-- | Lovelace unit type
type Lovelace = Value U2

instance UnitSpec U2 where
    divider :: proxy U2 -> b
divider = b -> proxy U2 -> b
forall a b. a -> b -> a
const b
1e6
    name :: proxy U2 -> Text
name    = Text -> proxy U2 -> Text
forall a b. a -> b -> a
const Text
"lovelace"

-- | Shannon unit type
type Shannon = Value U3

instance UnitSpec U3 where
    divider :: proxy U3 -> b
divider = b -> proxy U3 -> b
forall a b. a -> b -> a
const b
1e9
    name :: proxy U3 -> Text
name    = Text -> proxy U3 -> Text
forall a b. a -> b -> a
const Text
"shannon"

-- | Szabo unit type
type Szabo = Value U4

instance UnitSpec U4 where
    divider :: proxy U4 -> b
divider = b -> proxy U4 -> b
forall a b. a -> b -> a
const b
1e12
    name :: proxy U4 -> Text
name    = Text -> proxy U4 -> Text
forall a b. a -> b -> a
const Text
"szabo"

-- | Finney unit type
type Finney = Value U5

instance UnitSpec U5 where
    divider :: proxy U5 -> b
divider = b -> proxy U5 -> b
forall a b. a -> b -> a
const b
1e15
    name :: proxy U5 -> Text
name    = Text -> proxy U5 -> Text
forall a b. a -> b -> a
const Text
"finney"

-- | Ether unit type
type Ether  = Value U6

instance UnitSpec U6 where
    divider :: proxy U6 -> b
divider = b -> proxy U6 -> b
forall a b. a -> b -> a
const b
1e18
    name :: proxy U6 -> Text
name    = Text -> proxy U6 -> Text
forall a b. a -> b -> a
const Text
"ether"

-- | KEther unit type
type KEther = Value U7

instance UnitSpec U7 where
    divider :: proxy U7 -> b
divider = b -> proxy U7 -> b
forall a b. a -> b -> a
const b
1e21
    name :: proxy U7 -> Text
name    = Text -> proxy U7 -> Text
forall a b. a -> b -> a
const Text
"kether"