{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

-- | This module provides definitions for modeling and working with currencies.
module Haspara.Currency where

import Control.Monad.Except (MonadError (throwError))
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Encoding as Aeson.Encoding
import Data.Hashable (Hashable)
import Data.String (IsString (..))
import qualified Data.Text as T
import Data.Void (Void)
import GHC.Generics (Generic)
import Haspara.Internal.Aeson (commonAesonOptions)
import qualified Language.Haskell.TH.Syntax as TH
import qualified Text.Megaparsec as MP


-- * Currency


-- | Type encoding for currency symbol values with a syntax of @[A-Z]{3}[A-Z]*@.
--
-- 'Currency' values can be constructed via 'mkCurrencyError' that works in
-- @'MonadError' 'T.Text'@ context:
--
-- >>> :set -XOverloadedStrings
-- >>> mkCurrencyError "EUR" :: Either T.Text Currency
-- Right EUR
--
-- ... or via 'mkCurrencyFail' that works in 'MonadFail' context:
--
-- >>> mkCurrencyFail "EUR" :: Maybe Currency
-- Just EUR
--
-- An 'IsString' instance is provided as well which is unsafe but convenient:
--
-- >>> "EUR" :: Currency
-- EUR
newtype Currency = MkCurrency {Currency -> Text
currencyCode :: T.Text}
  deriving (Currency -> Currency -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Currency -> Currency -> Bool
$c/= :: Currency -> Currency -> Bool
== :: Currency -> Currency -> Bool
$c== :: Currency -> Currency -> Bool
Eq, Eq Currency
Int -> Currency -> Int
Currency -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Currency -> Int
$chash :: Currency -> Int
hashWithSalt :: Int -> Currency -> Int
$chashWithSalt :: Int -> Currency -> Int
Hashable, Eq Currency
Currency -> Currency -> Bool
Currency -> Currency -> Ordering
Currency -> Currency -> Currency
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Currency -> Currency -> Currency
$cmin :: Currency -> Currency -> Currency
max :: Currency -> Currency -> Currency
$cmax :: Currency -> Currency -> Currency
>= :: Currency -> Currency -> Bool
$c>= :: Currency -> Currency -> Bool
> :: Currency -> Currency -> Bool
$c> :: Currency -> Currency -> Bool
<= :: Currency -> Currency -> Bool
$c<= :: Currency -> Currency -> Bool
< :: Currency -> Currency -> Bool
$c< :: Currency -> Currency -> Bool
compare :: Currency -> Currency -> Ordering
$ccompare :: Currency -> Currency -> Ordering
Ord, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Currency -> m Exp
forall (m :: * -> *). Quote m => Currency -> Code m Currency
liftTyped :: forall (m :: * -> *). Quote m => Currency -> Code m Currency
$cliftTyped :: forall (m :: * -> *). Quote m => Currency -> Code m Currency
lift :: forall (m :: * -> *). Quote m => Currency -> m Exp
$clift :: forall (m :: * -> *). Quote m => Currency -> m Exp
TH.Lift)


-- | 'IsString' instance for 'Currency'.
--
-- >>> :set -XOverloadedStrings
-- >>> "USD" :: Currency
-- USD
instance IsString Currency where
  fromString :: String -> Currency
fromString = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadError Text m => Text -> m Currency
mkCurrencyError forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack


-- | 'Show' instance for 'Currency'.
--
-- >>> :set -XOverloadedStrings
-- >>> "USD" :: Currency
-- USD
instance Show Currency where
  show :: Currency -> String
show (MkCurrency Text
x) = Text -> String
T.unpack Text
x


-- | 'Aeson.FromJSON' instance for 'Currency'.
--
-- >>> :set -XOverloadedStrings
-- >>> Aeson.eitherDecode "\"\"" :: Either String Currency
-- Left "Error in $: Currency code error! Expecting at least 3 uppercase ASCII letters, but received: "
-- >>> Aeson.eitherDecode "\"A\"" :: Either String Currency
-- Left "Error in $: Currency code error! Expecting at least 3 uppercase ASCII letters, but received: A"
-- >>> Aeson.eitherDecode "\"AB\"" :: Either String Currency
-- Left "Error in $: Currency code error! Expecting at least 3 uppercase ASCII letters, but received: AB"
-- >>> Aeson.eitherDecode "\"ABC\"" :: Either String Currency
-- Right ABC
-- >>> Aeson.eitherDecode "\"ABCD\"" :: Either String Currency
-- Right ABCD
instance Aeson.FromJSON Currency where
  parseJSON :: Value -> Parser Currency
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"Currency" forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadError Text m => Text -> m Currency
mkCurrencyError


-- | 'Aeson.ToJSON' instance for 'Currency'.
--
-- >>> :set -XOverloadedStrings
-- >>> Aeson.encode ("USD" :: Currency)
-- "\"USD\""
instance Aeson.ToJSON Currency where
  toJSON :: Currency -> Value
toJSON (MkCurrency Text
c) = Text -> Value
Aeson.String Text
c
  toEncoding :: Currency -> Encoding
toEncoding (MkCurrency Text
c) = forall a. Text -> Encoding' a
Aeson.Encoding.text Text
c


-- | Smart constructor for 'Currency' values within 'MonadError' context.
--
-- >>> :set -XOverloadedStrings
-- >>> mkCurrencyError "" :: Either T.Text Currency
-- Left "Currency code error! Expecting at least 3 uppercase ASCII letters, but received: "
-- >>> mkCurrencyError " " :: Either T.Text Currency
-- Left "Currency code error! Expecting at least 3 uppercase ASCII letters, but received:  "
-- >>> mkCurrencyError "AB" :: Either T.Text Currency
-- Left "Currency code error! Expecting at least 3 uppercase ASCII letters, but received: AB"
-- >>> mkCurrencyError " ABC " :: Either T.Text Currency
-- Left "Currency code error! Expecting at least 3 uppercase ASCII letters, but received:  ABC "
-- >>> mkCurrencyError "ABC" :: Either T.Text Currency
-- Right ABC
mkCurrencyError :: MonadError T.Text m => T.Text -> m Currency
mkCurrencyError :: forall (m :: * -> *). MonadError Text m => Text -> m Currency
mkCurrencyError Text
x =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text
"Currency code error! Expecting at least 3 uppercase ASCII letters, but received: " forall a. Semigroup a => a -> a -> a
<> Text
x)
    (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Currency
MkCurrency)
    (forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.runParser Parsec Void Text Text
currencyCodeParser String
"Currency Code" Text
x)


-- | Smart constructor for 'Currency' values within 'MonadFail' context.
--
-- >>> :set -XOverloadedStrings
-- >>> mkCurrencyFail "" :: Maybe Currency
-- Nothing
-- >>> mkCurrencyFail "US" :: Maybe Currency
-- Nothing
-- >>> mkCurrencyFail "usd" :: Maybe Currency
-- Nothing
-- >>> mkCurrencyFail "USD" :: Maybe Currency
-- Just USD
mkCurrencyFail :: MonadFail m => T.Text -> m Currency
mkCurrencyFail :: forall (m :: * -> *). MonadFail m => Text -> m Currency
mkCurrencyFail = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadError Text m => Text -> m Currency
mkCurrencyError


-- | Parser that parses currency codes.
--
-- >>> :set -XOverloadedStrings
-- >>> MP.runParser currencyCodeParser "Example" ""
-- Left (ParseErrorBundle {bundleErrors = TrivialError 0 (Just EndOfInput) (fromList []) :| [], bundlePosState = PosState {pstateInput = "", pstateOffset = 0, pstateSourcePos = SourcePos {sourceName = "Example", sourceLine = Pos 1, sourceColumn = Pos 1}, pstateTabWidth = Pos 8, pstateLinePrefix = ""}})
-- >>> MP.runParser currencyCodeParser "Example" " "
-- Left (ParseErrorBundle {bundleErrors = TrivialError 0 (Just (Tokens (' ' :| ""))) (fromList []) :| [], bundlePosState = PosState {pstateInput = " ", pstateOffset = 0, pstateSourcePos = SourcePos {sourceName = "Example", sourceLine = Pos 1, sourceColumn = Pos 1}, pstateTabWidth = Pos 8, pstateLinePrefix = ""}})
-- >>> MP.runParser currencyCodeParser "Example" "a"
-- Left (ParseErrorBundle {bundleErrors = TrivialError 0 (Just (Tokens ('a' :| ""))) (fromList []) :| [], bundlePosState = PosState {pstateInput = "a", pstateOffset = 0, pstateSourcePos = SourcePos {sourceName = "Example", sourceLine = Pos 1, sourceColumn = Pos 1}, pstateTabWidth = Pos 8, pstateLinePrefix = ""}})
-- >>> MP.runParser currencyCodeParser "Example" "A"
-- Left (ParseErrorBundle {bundleErrors = TrivialError 1 (Just EndOfInput) (fromList []) :| [], bundlePosState = PosState {pstateInput = "A", pstateOffset = 0, pstateSourcePos = SourcePos {sourceName = "Example", sourceLine = Pos 1, sourceColumn = Pos 1}, pstateTabWidth = Pos 8, pstateLinePrefix = ""}})
-- >>> MP.runParser currencyCodeParser "Example" "AB"
-- Left (ParseErrorBundle {bundleErrors = TrivialError 2 (Just EndOfInput) (fromList []) :| [], bundlePosState = PosState {pstateInput = "AB", pstateOffset = 0, pstateSourcePos = SourcePos {sourceName = "Example", sourceLine = Pos 1, sourceColumn = Pos 1}, pstateTabWidth = Pos 8, pstateLinePrefix = ""}})
-- >>> MP.runParser currencyCodeParser "Example" "ABC"
-- Right "ABC"
-- >>> MP.runParser currencyCodeParser "Example" "ABCD"
-- Right "ABCD"
-- >>> MP.runParser currencyCodeParser "Example" " ABCD "
-- Left (ParseErrorBundle {bundleErrors = TrivialError 0 (Just (Tokens (' ' :| ""))) (fromList []) :| [], bundlePosState = PosState {pstateInput = " ABCD ", pstateOffset = 0, pstateSourcePos = SourcePos {sourceName = "Example", sourceLine = Pos 1, sourceColumn = Pos 1}, pstateTabWidth = Pos 8, pstateLinePrefix = ""}})
currencyCodeParser :: MP.Parsec Void T.Text T.Text
currencyCodeParser :: Parsec Void Text Text
currencyCodeParser = do
  String
mandatory <- forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
MP.count Int
3 ParsecT Void Text Identity (Token Text)
validChar
  String
optionals <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many ParsecT Void Text Identity (Token Text)
validChar
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
mandatory forall a. Semigroup a => a -> a -> a
<> String
optionals
  where
    validChar :: ParsecT Void Text Identity (Token Text)
validChar = forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
MP.oneOf [Char
'A' .. Char
'Z']


-- * Currency Pair


-- | Type encoding of a currency pair.
--
-- 'CurrencyPair' values are constructed via the data constructor:
--
-- >>> :set -XOverloadedStrings
-- >>> CurrencyPair "EUR" "USD"
-- EUR/USD
--
-- 'Aeson.FromJSON' and 'Aeson.ToJSON' instances are provided as well:
--
-- >>> Aeson.decode "{\"base\": \"EUR\", \"quote\": \"EUR\"}" :: Maybe CurrencyPair
-- Just EUR/EUR
-- >>> Aeson.encode (CurrencyPair "EUR" "USD")
-- "{\"base\":\"EUR\",\"quote\":\"USD\"}"
data CurrencyPair = CurrencyPair
  { CurrencyPair -> Currency
currencyPairBase :: !Currency
  -- ^ /Base currency/ of the currency pair. Also referred to as /counter currency/.
  , CurrencyPair -> Currency
currencyPairQuote :: !Currency
  -- ^ /Quote currency/ of the currency pair. Also referred to as /transaction currency/.
  }
  deriving (CurrencyPair -> CurrencyPair -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CurrencyPair -> CurrencyPair -> Bool
$c/= :: CurrencyPair -> CurrencyPair -> Bool
== :: CurrencyPair -> CurrencyPair -> Bool
$c== :: CurrencyPair -> CurrencyPair -> Bool
Eq, forall x. Rep CurrencyPair x -> CurrencyPair
forall x. CurrencyPair -> Rep CurrencyPair x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CurrencyPair x -> CurrencyPair
$cfrom :: forall x. CurrencyPair -> Rep CurrencyPair x
Generic, Eq CurrencyPair
CurrencyPair -> CurrencyPair -> Bool
CurrencyPair -> CurrencyPair -> Ordering
CurrencyPair -> CurrencyPair -> CurrencyPair
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CurrencyPair -> CurrencyPair -> CurrencyPair
$cmin :: CurrencyPair -> CurrencyPair -> CurrencyPair
max :: CurrencyPair -> CurrencyPair -> CurrencyPair
$cmax :: CurrencyPair -> CurrencyPair -> CurrencyPair
>= :: CurrencyPair -> CurrencyPair -> Bool
$c>= :: CurrencyPair -> CurrencyPair -> Bool
> :: CurrencyPair -> CurrencyPair -> Bool
$c> :: CurrencyPair -> CurrencyPair -> Bool
<= :: CurrencyPair -> CurrencyPair -> Bool
$c<= :: CurrencyPair -> CurrencyPair -> Bool
< :: CurrencyPair -> CurrencyPair -> Bool
$c< :: CurrencyPair -> CurrencyPair -> Bool
compare :: CurrencyPair -> CurrencyPair -> Ordering
$ccompare :: CurrencyPair -> CurrencyPair -> Ordering
Ord, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => CurrencyPair -> m Exp
forall (m :: * -> *).
Quote m =>
CurrencyPair -> Code m CurrencyPair
liftTyped :: forall (m :: * -> *).
Quote m =>
CurrencyPair -> Code m CurrencyPair
$cliftTyped :: forall (m :: * -> *).
Quote m =>
CurrencyPair -> Code m CurrencyPair
lift :: forall (m :: * -> *). Quote m => CurrencyPair -> m Exp
$clift :: forall (m :: * -> *). Quote m => CurrencyPair -> m Exp
TH.Lift)


instance Aeson.FromJSON CurrencyPair where
  parseJSON :: Value -> Parser CurrencyPair
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
Aeson.genericParseJSON forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"currencyPair"


instance Aeson.ToJSON CurrencyPair where
  toJSON :: CurrencyPair -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"currencyPair"
  toEncoding :: CurrencyPair -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"currencyPair"


-- | 'Show' instance for 'CurrencyPair'.
--
-- >>> :set -XOverloadedStrings
-- >>> CurrencyPair "EUR" "USD"
-- EUR/USD
instance Show CurrencyPair where
  show :: CurrencyPair -> String
show (CurrencyPair Currency
x Currency
y) = forall a. Show a => a -> String
show Currency
x forall a. Semigroup a => a -> a -> a
<> String
"/" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Currency
y


-- | Converts a 'CurrencyPair' to a 2-tuple of 'Currency' values.
--
-- >>> :set -XOverloadedStrings
-- >>> toCurrencyTuple (CurrencyPair "EUR" "USD")
-- (EUR,USD)
toCurrencyTuple :: CurrencyPair -> (Currency, Currency)
toCurrencyTuple :: CurrencyPair -> (Currency, Currency)
toCurrencyTuple (CurrencyPair Currency
x Currency
y) = (Currency
x, Currency
y)


-- | Converts a 2-tuple of 'Currency' values to a 'CurrencyPair'.
--
-- >>> :set -XOverloadedStrings
-- >>> fromCurrencyTuple ("EUR", "USD")
-- EUR/USD
fromCurrencyTuple :: (Currency, Currency) -> CurrencyPair
fromCurrencyTuple :: (Currency, Currency) -> CurrencyPair
fromCurrencyTuple = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Currency -> Currency -> CurrencyPair
CurrencyPair