module Paddle.Amount 
  ( Amount(..)
  ) where

import Protolude hiding (Show)
import Prelude (Show(..), read)
import Data.Scientific
import Data.Aeson.Types (Parser)
import Data.Aeson (FromJSON, ToJSON, toJSON, parseJSON, withText, withScientific, Value(Number))

newtype Amount = Amount { Amount -> Scientific
getScientific :: Scientific }

instance Show Amount where
    show :: Amount -> String
show = FPFormat -> Maybe Int -> Scientific -> String
formatScientific FPFormat
Fixed Maybe Int
forall a. Maybe a
Nothing (Scientific -> String)
-> (Amount -> Scientific) -> Amount -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Scientific
getScientific

instance Eq Amount where
    Amount
a1 == :: Amount -> Amount -> Bool
== Amount
a2 = Amount -> Scientific
getScientific Amount
a1 Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
== Amount -> Scientific
getScientific Amount
a2

instance FromJSON Amount where
    parseJSON :: Value -> Parser Amount
parseJSON Value
value =
          String -> (Text -> Parser Amount) -> Value -> Parser Amount
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"amount" Text -> Parser Amount
f Value
value
      Parser Amount -> Parser Amount -> Parser Amount
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> (Scientific -> Parser Amount) -> Value -> Parser Amount
forall a. String -> (Scientific -> Parser a) -> Value -> Parser a
withScientific String
"amount" (Amount -> Parser Amount
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Amount -> Parser Amount)
-> (Scientific -> Amount) -> Scientific -> Parser Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Amount
Amount) Value
value
      where
        f :: Text -> Parser Amount
        -- TODO: use `reads` to `fail` early
        f :: Text -> Parser Amount
f Text
t = Amount -> Parser Amount
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Amount -> Parser Amount) -> Amount -> Parser Amount
forall a b. (a -> b) -> a -> b
$ Scientific -> Amount
Amount (String -> Scientific
forall a. Read a => String -> a
read (Text -> String
forall a b. ConvertText a b => a -> b
toS Text
t))

instance ToJSON Amount where
    toJSON :: Amount -> Value
toJSON = Scientific -> Value
Number (Scientific -> Value) -> (Amount -> Scientific) -> Amount -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Scientific
getScientific