{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Types for the API
module ExchangeRates.Types
    ( Rate(..)
    , oneRate
    , mulRate
    , divRate
    , normaliseRate
    , rateToRational
    , rateToDouble
    , Currency(..)
    , Symbols(..)
    , Rates(..)
    ) where

import Control.Applicative
import Data.Aeson as JSON
import Data.Aeson.Types as JSON
import qualified Data.List.NonEmpty as NE
import Data.List.NonEmpty (NonEmpty(..))
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe
import Data.Ratio
import qualified Data.Text as T
import Data.Text (Text)
import Data.Time
import Data.Validity
import Data.Validity.Containers ()
import Data.Validity.Time ()
import GHC.Generics (Generic)
import GHC.Natural
import GHC.Real (Ratio(..))
import Servant.API
import Text.Read

-- | A positive and non-0 ratio
newtype Rate = Rate
    { unRate :: Ratio Natural
    } deriving (Show, Eq, Generic)

-- | The identity of 'mulRate'
oneRate :: Rate
oneRate = Rate 1

-- | Multiply two rates
mulRate :: Rate -> Rate -> Rate
mulRate (Rate r1) (Rate r2) = normaliseRate $ Rate (r1 * r2)

-- | Divide one rate by another
divRate :: Rate -> Rate -> Rate
divRate (Rate r1) (Rate r2) = normaliseRate $ Rate (r1 / r2)

-- | Ensure that a rate is internally normalised.
-- This is a requirement for 'Validity'
normaliseRate :: Rate -> Rate
normaliseRate = Rate . fromRational . toRational . unRate

-- | Convert a rate to a 'Ratio Integer' instead of 'Ratio Natural'.
--
-- This is a lossless transformation.
rateToRational :: Rate -> Rational
rateToRational (Rate (num :% den)) = fromIntegral num :% fromIntegral den

-- | Convert a rate to a 'Double'.
--
-- This may not be a lossless transformation
rateToDouble :: Rate -> Double
rateToDouble = fromRational . rateToRational

-- | A rate is valid if:
--
-- * The ratio inside is valid.
-- * The ratio is not zero.
-- * The ratio is normalised.
instance Validity Rate where
    validate r@Rate {..} =
        mconcat
            [ unRate <?!> "unRate"
            , (numerator unRate /= 0) <?@> "ratio is not 0"
            , (normaliseRate r == r) <?@> "is normalised"
            ]
    isValid = isValidByValidating

instance FromJSON Rate where
    parseJSON v =
        (Rate <$> parseJSON v) <|>
        -- First try to parse as a ratio
        (do d <- parseJSON v :: JSON.Parser Double
            -- The api has a precision of 0.0001.
            let r@(num :% den) = toRational d
            if r == 0
                then fail "Failed to parse zero rate"
                else pure $
                     normaliseRate $
                     Rate $ naturalFromInteger num % naturalFromInteger den)

instance ToJSON Rate where
    toJSON = toJSON . unRate

-- | A sum-type of the supported currencies on exchangeratesapi.io
data Currency
    = AUD
    | BGN
    | BRL
    | CAD
    | CHF
    | CNY
    | CZK
    | DKK
    | EUR
    | GBP
    | HKD
    | HRK
    | HUF
    | IDR
    | ILS
    | INR
    | JPY
    | KRW
    | MXN
    | MYR
    | NOK
    | NZD
    | PHP
    | PLN
    | RON
    | RUB
    | SEK
    | SGD
    | THB
    | TRY
    | USD
    | ZAR
    deriving (Show, Read, Eq, Ord, Enum, Bounded, Generic)

instance Validity Currency

instance ToHttpApiData Currency where
    toUrlPiece = currencyToText

-- | A nonempty list of 'Currency's
newtype Symbols = Symbols
    { unSymbols :: NonEmpty Currency
    } deriving (Show, Eq, Ord, Generic)

instance Validity Symbols

instance ToHttpApiData Symbols where
    toUrlPiece = T.intercalate "," . map toUrlPiece . NE.toList . unSymbols

-- | The raw response of exchangeratesapi.io
data Rates = Rates
    { ratesBase :: Currency
    , ratesDate :: Day
    , ratesRates :: Map Currency Rate
    } deriving (Show, Eq, Generic)

instance Validity Rates where
    validate Rates {..} =
        mconcat
            [ ratesBase <?!> "ratesBase"
            , ratesDate <?!> "ratesDate"
            , ratesRates <?!> "ratesRates"
            , isNothing (M.lookup ratesBase ratesRates) <?@>
              "does not contain the base rate in the rates."
            ]
    isValid = isValidByValidating

instance FromJSON Currency where
    parseJSON = withText "Currency" currencyTextParser

instance FromJSONKey Currency where
    fromJSONKey = FromJSONKeyTextParser currencyTextParser

currencyTextParser :: Text -> JSON.Parser Currency
currencyTextParser t =
    let s = T.unpack t
     in case readMaybe s of
            Nothing -> fail $ "Not a valid currency: " ++ s
            Just c -> pure c

instance ToJSON Currency where
    toJSON = JSON.String . currencyToText

instance ToJSONKey Currency where
    toJSONKey = toJSONKeyText currencyToText

currencyToText :: Currency -> Text
currencyToText = T.pack . show

instance FromJSON Rates where
    parseJSON =
        withObject "Rates" $ \o ->
            Rates <$> o .: "base" <*> o .: "date" <*> o .: "rates"