{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoRebindableSyntax #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module Duckling.AmountOfMoney.Types where
import Control.DeepSeq
import Data.Aeson
import Data.Hashable
import Data.Text (Text)
import GHC.Generics
import Prelude
import qualified Data.HashMap.Strict as H
import Duckling.Resolve (Resolve(..))
data Currency
= Cent
| Dinar
| Dirham
| Dollar
| Pound
| Rial
| Riyal
| Unnamed
| AED
| AUD
| BGN
| BRL
| BYN
| CNY
| EGP
| EUR
| GBP
| HRK
| IDR
| ILS
| INR
| IQD
| JOD
| JPY
| KRW
| KWD
| LBP
| MAD
| MYR
| NOK
| PTS
| QAR
| RON
| RUB
| SAR
| SEK
| SGD
| USD
| VND
deriving (Eq, Generic, Hashable, Show, Ord, NFData)
instance ToJSON Currency where
toJSON Cent = "cent"
toJSON Dollar = "$"
toJSON Pound = "\x00a3"
toJSON Dinar = "dinar"
toJSON Dirham = "dirham"
toJSON Rial = "rial"
toJSON Riyal = "riyal"
toJSON Unnamed = "unknown"
toJSON AED = "AED"
toJSON AUD = "AUD"
toJSON BGN = "BGN"
toJSON BRL = "BRL"
toJSON BYN = "BYN"
toJSON CNY = "CNY"
toJSON EGP = "EGP"
toJSON EUR = "EUR"
toJSON GBP = "GBP"
toJSON HRK = "HRK"
toJSON IDR = "IDR"
toJSON ILS = "ILS"
toJSON IQD = "IQD"
toJSON INR = "INR"
toJSON JOD = "JOD"
toJSON JPY = "JPY"
toJSON KRW = "KRW"
toJSON KWD = "KWD"
toJSON LBP = "LBP"
toJSON MAD = "MAD"
toJSON MYR = "MYR"
toJSON NOK = "NOK"
toJSON PTS = "PTS"
toJSON QAR = "QAR"
toJSON RON = "RON"
toJSON RUB = "RUB"
toJSON SAR = "SAR"
toJSON SEK = "SEK"
toJSON SGD = "SGD"
toJSON USD = "USD"
toJSON VND = "VND"
data AmountOfMoneyData = AmountOfMoneyData
{ value :: Maybe Double
, currency :: Currency
, minValue :: Maybe Double
, maxValue :: Maybe Double
}
deriving (Eq, Generic, Hashable, Show, Ord, NFData)
instance Resolve AmountOfMoneyData where
type ResolvedValue AmountOfMoneyData = AmountOfMoneyValue
resolve _ _ AmountOfMoneyData {value = Nothing, minValue = Nothing
, maxValue = Nothing} = Nothing
resolve _ _ AmountOfMoneyData {value = Just value, currency} =
Just (simple currency value, False)
resolve _ _ AmountOfMoneyData {value = Nothing, currency = c
, minValue = Just from, maxValue = Just to} =
Just (between c (from, to), False)
resolve _ _ AmountOfMoneyData {value = Nothing, currency = c
, minValue = Just v, maxValue = Nothing} =
Just (above c v, False)
resolve _ _ AmountOfMoneyData {value = Nothing, currency = c
, minValue = Nothing, maxValue = Just v} =
Just (under c v, False)
data IntervalDirection = Above | Under
deriving (Eq, Generic, Hashable, Ord, Show, NFData)
data SingleValue = SingleValue
{ vCurrency :: Currency
, vValue :: Double
}
deriving (Eq, Show)
instance ToJSON SingleValue where
toJSON SingleValue {vCurrency, vValue} = object
[ "value" .= vValue
, "unit" .= vCurrency
]
data AmountOfMoneyValue
= SimpleValue SingleValue
| IntervalValue (SingleValue, SingleValue)
| OpenIntervalValue (SingleValue, IntervalDirection)
deriving (Show, Eq)
instance ToJSON AmountOfMoneyValue where
toJSON (SimpleValue value) = case toJSON value of
Object o -> Object $ H.insert "type" (toJSON ("value" :: Text)) o
_ -> Object H.empty
toJSON (IntervalValue (from, to)) = object
[ "type" .= ("interval" :: Text)
, "from" .= toJSON from
, "to" .= toJSON to
]
toJSON (OpenIntervalValue (from, Above)) = object
[ "type" .= ("interval" :: Text)
, "from" .= toJSON from
]
toJSON (OpenIntervalValue (to, Under)) = object
[ "type" .= ("interval" :: Text)
, "to" .= toJSON to
]
simple :: Currency -> Double -> AmountOfMoneyValue
simple c v = SimpleValue $ single c v
between :: Currency -> (Double, Double) -> AmountOfMoneyValue
between c (from, to) = IntervalValue (single c from, single c to)
above :: Currency -> Double -> AmountOfMoneyValue
above = openInterval Above
under :: Currency -> Double -> AmountOfMoneyValue
under = openInterval Under
openInterval :: IntervalDirection -> Currency -> Double -> AmountOfMoneyValue
openInterval direction c v = OpenIntervalValue (single c v, direction)
single :: Currency -> Double -> SingleValue
single c v = SingleValue {vCurrency = c, vValue = v}