-- Copyright (c) 2016-present, Facebook, Inc.
-- All rights reserved.
--
-- This source code is licensed under the BSD-style license found in the
-- LICENSE file in the root directory of this source tree.


{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}

module Duckling.AmountOfMoney.Helpers
  ( currencyOnly
  , valueOnly
  , isSimpleAmountOfMoney
  , isCent
  , isCents
  , isDollarCoin
  , isCurrencyOnly
  , isDime
  , isMoneyWithValue
  , isWithoutCents
  , withCents
  , withInterval
  , withMax
  , withMin
  , withValue
  , mkLatent
  , dollarCoins
  )
  where

import Data.HashMap.Strict (HashMap)
import Data.Maybe (isJust)
import Data.String
import Data.Text (Text)
import Prelude

import Duckling.AmountOfMoney.Types
  ( Currency (..)
  , AmountOfMoneyData (..)
  , amountOfMoneyData'
  )
import Duckling.Numeral.Types (getIntValue, isInteger)
import Duckling.Dimensions.Types
import Duckling.Types hiding (Entity(..))

import qualified Data.HashMap.Strict as HashMap

-- -----------------------------------------------------------------
-- Dollar coin Types

dollarCoins :: HashMap Text Double
dollarCoins :: HashMap Text Double
dollarCoins = [(Text, Double)] -> HashMap Text Double
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
  [ (Text
"nickel", Double
0.05)
  , (Text
"nickels", Double
0.05)
  , (Text
"dime", Double
0.1)
  , (Text
"dimes", Double
0.1)
  , (Text
"quarter", Double
0.25)
  , (Text
"quarters", Double
0.25)
  ]

-- -----------------------------------------------------------------
-- Patterns

isCents :: Predicate
isCents :: Predicate
isCents (Token Dimension a
AmountOfMoney AmountOfMoneyData{value = Just _, currency = Cent}) = Bool
True
isCents Token
_ = Bool
False

isWithoutCents :: Predicate
isWithoutCents :: Predicate
isWithoutCents (Token Dimension a
AmountOfMoney AmountOfMoneyData{currency = Cent}) = Bool
False
isWithoutCents (Token Dimension a
AmountOfMoney AmountOfMoneyData{value = Just v}) = Double -> Bool
isInteger Double
v
isWithoutCents Token
_ = Bool
False

isMoneyWithValue :: Predicate
isMoneyWithValue :: Predicate
isMoneyWithValue (Token Dimension a
AmountOfMoney AmountOfMoneyData{value = v1, minValue = v2, maxValue = v3}) =
 (Maybe Double -> Bool) -> [Maybe Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Maybe Double -> Bool
forall a. Maybe a -> Bool
isJust [Maybe Double
v1, Maybe Double
v2, Maybe Double
v3]
isMoneyWithValue Token
_ = Bool
False

isCurrencyOnly :: Predicate
isCurrencyOnly :: Predicate
isCurrencyOnly (Token Dimension a
AmountOfMoney AmountOfMoneyData
  {value = Nothing, minValue = Nothing, maxValue = Nothing}) = Bool
True
isCurrencyOnly Token
_ = Bool
False

isDollarCoin :: Predicate
isDollarCoin :: Predicate
isDollarCoin (Token Dimension a
AmountOfMoney AmountOfMoneyData{value = Just d, currency}) =
  Double -> [Double] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Double
d [Double
0.05, Double
0.1, Double
0.25] Bool -> Bool -> Bool
&& Currency -> [Currency] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Currency
currency [Currency
Dollar, Currency
AUD, Currency
CAD, Currency
JMD,
                                             Currency
NZD,    Currency
SGD, Currency
TTD, Currency
USD]
isDollarCoin Token
_ = Bool
False

isSimpleAmountOfMoney :: Predicate
isSimpleAmountOfMoney :: Predicate
isSimpleAmountOfMoney (Token Dimension a
AmountOfMoney AmountOfMoneyData
  {value = Just _, minValue = Nothing, maxValue = Nothing}) = Bool
True
isSimpleAmountOfMoney Token
_ = Bool
False

isDime :: Predicate
isDime :: Predicate
isDime (Token Dimension a
AmountOfMoney AmountOfMoneyData
  {value = Just d, currency = Cent}) =
  Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\Int
i -> (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
10) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Int
getIntValue Double
d
isDime Token
_ = Bool
False

isCent :: Predicate
isCent :: Predicate
isCent (Token Dimension a
AmountOfMoney AmountOfMoneyData
  {value = Just c, currency = Cent}) =
  Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\Int
i -> Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9) (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ Double -> Maybe Int
getIntValue Double
c
isCent Token
_ = Bool
False

-- -----------------------------------------------------------------
-- Production

currencyOnly :: Currency -> AmountOfMoneyData
currencyOnly :: Currency -> AmountOfMoneyData
currencyOnly Currency
c = AmountOfMoneyData
amountOfMoneyData'{currency :: Currency
currency = Currency
c}

valueOnly :: Double -> AmountOfMoneyData
valueOnly :: Double -> AmountOfMoneyData
valueOnly Double
x = AmountOfMoneyData
amountOfMoneyData'{value :: Maybe Double
value = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
x}

withValue :: Double -> AmountOfMoneyData -> AmountOfMoneyData
withValue :: Double -> AmountOfMoneyData -> AmountOfMoneyData
withValue Double
x AmountOfMoneyData
fd = AmountOfMoneyData
fd {value :: Maybe Double
value = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
x}

withCents :: Double -> AmountOfMoneyData -> AmountOfMoneyData
withCents :: Double -> AmountOfMoneyData -> AmountOfMoneyData
withCents Double
x fd :: AmountOfMoneyData
fd@AmountOfMoneyData {value :: AmountOfMoneyData -> Maybe Double
value = Just Double
value} = AmountOfMoneyData
fd
  {value :: Maybe Double
value = Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Double
value Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100}
withCents Double
x AmountOfMoneyData {value :: AmountOfMoneyData -> Maybe Double
value = Maybe Double
Nothing} =
  AmountOfMoneyData
amountOfMoneyData'{value :: Maybe Double
value = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
x, currency :: Currency
currency = Currency
Cent}

withInterval :: (Double, Double) -> AmountOfMoneyData -> AmountOfMoneyData
withInterval :: (Double, Double) -> AmountOfMoneyData -> AmountOfMoneyData
withInterval (Double
from, Double
to) AmountOfMoneyData
fd = AmountOfMoneyData
fd
  {minValue :: Maybe Double
minValue = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
from, maxValue :: Maybe Double
maxValue = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
to, value :: Maybe Double
value = Maybe Double
forall a. Maybe a
Nothing}

withMin :: Double -> AmountOfMoneyData -> AmountOfMoneyData
withMin :: Double -> AmountOfMoneyData -> AmountOfMoneyData
withMin Double
x AmountOfMoneyData
fd = AmountOfMoneyData
fd {minValue :: Maybe Double
minValue = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
x}

withMax :: Double -> AmountOfMoneyData -> AmountOfMoneyData
withMax :: Double -> AmountOfMoneyData -> AmountOfMoneyData
withMax Double
x AmountOfMoneyData
fd = AmountOfMoneyData
fd {maxValue :: Maybe Double
maxValue = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
x}

mkLatent :: AmountOfMoneyData -> AmountOfMoneyData
mkLatent :: AmountOfMoneyData -> AmountOfMoneyData
mkLatent AmountOfMoneyData
fd = AmountOfMoneyData
fd {latent :: Bool
latent = Bool
True}