module Bitcoin.Protocol.Amount
(
Amount(..)
, btc , mbtc , ubtc , satoshi
, amountMultiplier , amountExponent
, integerAmount, doubleAmount
, amountFromDouble
, showAmount , parseAmount
) where
import Data.Word
import Data.List ( findIndex )
import Data.Maybe
import Text.Show
import Text.Read
newtype Amount = Amount { unAmount :: Word64 } deriving (Eq,Ord)
instance Show Amount where
showsPrec d amt = showParen (d>10) $ showString "BTC " . showString (showAmount amt)
instance Read Amount where
readsPrec d r = readParen (d > 10)
(\r -> [ (fromJust mbAmt,t)
| ("BTC",s) <- lex r
, (m,t) <- lex s
, let mbAmt = parseAmount m
, isJust mbAmt
]) r
amountMultiplier :: Num a => a
amountMultiplier = 100000000
amountExponent :: Int
amountExponent = 8
btc :: Double -> Amount
btc = amountFromDouble
mbtc :: Double -> Amount
mbtc n = amountFromDouble (n/1000)
ubtc :: Double -> Amount
ubtc n = amountFromDouble (n/1000000)
satoshi :: Int -> Amount
satoshi n = Amount $ fromIntegral $ n
integerAmount :: Amount -> Integer
integerAmount (Amount n) = fromIntegral n
doubleAmount :: Amount -> Double
doubleAmount (Amount n) = fromIntegral n / amountMultiplier
amountFromDouble :: Double -> Amount
amountFromDouble d = Amount $ round (d*amountMultiplier)
showAmount :: Amount -> String
showAmount (Amount n) = show a ++ if (b==0) then "" else ("." ++ fr) where
(a,b) = divMod n amountMultiplier
fr = reverse $ dropWhile (=='0') $ reverse $ extend $ show b
extend s = (replicate (amountExponentk) '0' ++ s) where k = length s
parseAmount :: String -> Maybe Amount
parseAmount s =
case splitDecimalPoint s of
[s] -> case maybeReadWord64 s of
Just n -> Just (Amount (n*amountMultiplier))
_ -> Nothing
[s,""] -> case maybeReadWord64 s of
Just n -> Just (Amount (n*amountMultiplier))
_ -> Nothing
[s,t] -> case (maybeReadWord64 s, maybeReadWord64 t) of
(Just a, Just _) -> Just (Amount (a*amountMultiplier + b)) where
b = read
$ take amountExponent
$ (t ++ replicate amountExponent '0')
_ -> Nothing
_ -> Nothing
maybeReadWord64 :: String -> Maybe Word64
maybeReadWord64 s = case reads s of
[(w,"")] -> Just w
_ -> Nothing
splitDecimalPoint :: String -> [String]
splitDecimalPoint s = case findIndex (=='.') s of
Nothing -> [s]
Just i -> [take i s , drop (i+1) s]