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

{-# LANGUAGE DataKinds   #-}
{-# LANGUAGE DerivingVia #-}

module Haspara.Currency where

import           Control.Monad.Except       (MonadError(throwError))
import qualified Data.Aeson                 as Aeson
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
-- $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:
--
-- >>> 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
(Currency -> Currency -> Bool)
-> (Currency -> Currency -> Bool) -> Eq Currency
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, Int -> Currency -> Int
Currency -> Int
(Int -> Currency -> Int) -> (Currency -> Int) -> Hashable Currency
forall 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
Eq Currency
-> (Currency -> Currency -> Ordering)
-> (Currency -> Currency -> Bool)
-> (Currency -> Currency -> Bool)
-> (Currency -> Currency -> Bool)
-> (Currency -> Currency -> Bool)
-> (Currency -> Currency -> Currency)
-> (Currency -> Currency -> Currency)
-> Ord 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
$cp1Ord :: Eq Currency
Ord, Currency -> Q Exp
Currency -> Q (TExp Currency)
(Currency -> Q Exp)
-> (Currency -> Q (TExp Currency)) -> Lift Currency
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Currency -> Q (TExp Currency)
$cliftTyped :: Currency -> Q (TExp Currency)
lift :: Currency -> Q Exp
$clift :: Currency -> Q Exp
TH.Lift)


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


-- | 'Show' instance for 'Currency'.
--
-- >>> "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'.
--
-- >>> 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 = String -> (Text -> Parser Currency) -> Value -> Parser Currency
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"Currency" ((Text -> Parser Currency) -> Value -> Parser Currency)
-> (Text -> Parser Currency) -> Value -> Parser Currency
forall a b. (a -> b) -> a -> b
$ (Text -> Parser Currency)
-> (Currency -> Parser Currency)
-> Either Text Currency
-> Parser Currency
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser Currency
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Currency)
-> (Text -> String) -> Text -> Parser Currency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) Currency -> Parser Currency
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Currency -> Parser Currency)
-> (Text -> Either Text Currency) -> Text -> Parser Currency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text Currency
forall (m :: * -> *). MonadError Text m => Text -> m Currency
mkCurrencyError


-- | 'Aeson.ToJSON' instance for 'Currency'.
--
-- >>> Aeson.encode ("USD" :: Currency)
-- "\"USD\""
instance Aeson.ToJSON Currency where
  toJSON :: Currency -> Value
toJSON (MkCurrency Text
c) = Text -> Value
Aeson.String Text
c


-- | Smart constructor for 'Currency' values within 'MonadError' context.
--
-- >>> 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 :: Text -> m Currency
mkCurrencyError Text
x = (ParseErrorBundle Text Void -> m Currency)
-> (Text -> m Currency)
-> Either (ParseErrorBundle Text Void) Text
-> m Currency
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
  (m Currency -> ParseErrorBundle Text Void -> m Currency
forall a b. a -> b -> a
const (m Currency -> ParseErrorBundle Text Void -> m Currency)
-> (Text -> m Currency)
-> Text
-> ParseErrorBundle Text Void
-> m Currency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m Currency
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> ParseErrorBundle Text Void -> m Currency)
-> Text -> ParseErrorBundle Text Void -> m Currency
forall a b. (a -> b) -> a -> b
$ Text
"Currency code error! Expecting at least 3 uppercase ASCII letters, but received: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x)
  (Currency -> m Currency
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Currency -> m Currency)
-> (Text -> Currency) -> Text -> m Currency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Currency
MkCurrency)
  (Parsec Void Text Text
-> String -> Text -> Either (ParseErrorBundle Text Void) Text
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.
--
-- >>> 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 :: Text -> m Currency
mkCurrencyFail = (Text -> m Currency)
-> (Currency -> m Currency) -> Either Text Currency -> m Currency
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> m Currency
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Currency) -> (Text -> String) -> Text -> m Currency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) Currency -> m Currency
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Currency -> m Currency)
-> (Text -> Either Text Currency) -> Text -> m Currency
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text Currency
forall (m :: * -> *). MonadError Text m => Text -> m Currency
mkCurrencyError


-- | Parser that parses currency codes.
--
-- >>> 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 <- Int
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
MP.count Int
3 ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
validChar
  String
optionals <- ParsecT Void Text Identity Char
-> ParsecT Void Text Identity String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
validChar
  Text -> Parsec Void Text Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parsec Void Text Text)
-> (String -> Text) -> String -> Parsec Void Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Parsec Void Text Text)
-> String -> Parsec Void Text Text
forall a b. (a -> b) -> a -> b
$ String
mandatory String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
optionals
  where
    validChar :: ParsecT Void Text Identity (Token Text)
validChar = [Token Text] -> ParsecT Void Text Identity (Token Text)
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
-- $currencyPair


-- | Type encoding of a currency pair.
--
-- 'CurrencyPair' values are constructed via the data constructor:
--
-- >>> 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
(CurrencyPair -> CurrencyPair -> Bool)
-> (CurrencyPair -> CurrencyPair -> Bool) -> Eq CurrencyPair
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. CurrencyPair -> Rep CurrencyPair x)
-> (forall x. Rep CurrencyPair x -> CurrencyPair)
-> Generic CurrencyPair
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
Eq CurrencyPair
-> (CurrencyPair -> CurrencyPair -> Ordering)
-> (CurrencyPair -> CurrencyPair -> Bool)
-> (CurrencyPair -> CurrencyPair -> Bool)
-> (CurrencyPair -> CurrencyPair -> Bool)
-> (CurrencyPair -> CurrencyPair -> Bool)
-> (CurrencyPair -> CurrencyPair -> CurrencyPair)
-> (CurrencyPair -> CurrencyPair -> CurrencyPair)
-> Ord 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
$cp1Ord :: Eq CurrencyPair
Ord, CurrencyPair -> Q Exp
CurrencyPair -> Q (TExp CurrencyPair)
(CurrencyPair -> Q Exp)
-> (CurrencyPair -> Q (TExp CurrencyPair)) -> Lift CurrencyPair
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: CurrencyPair -> Q (TExp CurrencyPair)
$cliftTyped :: CurrencyPair -> Q (TExp CurrencyPair)
lift :: CurrencyPair -> Q Exp
$clift :: CurrencyPair -> Q Exp
TH.Lift)


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


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


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


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