{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
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
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
$c== :: Currency -> Currency -> Bool
== :: Currency -> Currency -> Bool
$c/= :: Currency -> Currency -> Bool
/= :: Currency -> Currency -> Bool
Eq, Eq Currency
Eq Currency =>
(Int -> Currency -> Int) -> (Currency -> Int) -> Hashable Currency
Int -> Currency -> Int
Currency -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Currency -> Int
hashWithSalt :: Int -> Currency -> Int
$chash :: Currency -> Int
hash :: 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
$ccompare :: Currency -> Currency -> Ordering
compare :: Currency -> Currency -> Ordering
$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
>= :: Currency -> Currency -> Bool
$cmax :: Currency -> Currency -> Currency
max :: Currency -> Currency -> Currency
$cmin :: Currency -> Currency -> Currency
min :: Currency -> Currency -> Currency
Ord, (forall (m :: * -> *). Quote m => Currency -> m Exp)
-> (forall (m :: * -> *). Quote m => Currency -> Code m Currency)
-> Lift Currency
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
$clift :: forall (m :: * -> *). Quote m => Currency -> m Exp
lift :: forall (m :: * -> *). Quote m => Currency -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => Currency -> Code m Currency
liftTyped :: forall (m :: * -> *). Quote m => Currency -> Code m Currency
TH.Lift)
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
instance Show Currency where
show :: Currency -> String
show (MkCurrency Text
x) = Text -> String
T.unpack Text
x
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 a. String -> Parser a
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 a. a -> Parser a
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
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) = Text -> Encoding
forall a. Text -> Encoding' a
Aeson.Encoding.text Text
c
mkCurrencyError :: MonadError T.Text m => T.Text -> m Currency
mkCurrencyError :: forall (m :: * -> *). MonadError Text m => 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 a. Text -> m a
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 a. a -> m a
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)
mkCurrencyFail :: MonadFail m => T.Text -> m Currency
mkCurrencyFail :: forall (m :: * -> *). MonadFail m => 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 a. String -> m a
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 a. a -> m a
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
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 a. a -> ParsecT Void Text Identity a
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']
data CurrencyPair = CurrencyPair
{ CurrencyPair -> Currency
currencyPairBase :: !Currency
, CurrencyPair -> Currency
currencyPairQuote :: !Currency
}
deriving (CurrencyPair -> CurrencyPair -> Bool
(CurrencyPair -> CurrencyPair -> Bool)
-> (CurrencyPair -> CurrencyPair -> Bool) -> Eq CurrencyPair
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CurrencyPair -> CurrencyPair -> Bool
== :: CurrencyPair -> CurrencyPair -> Bool
$c/= :: CurrencyPair -> CurrencyPair -> Bool
/= :: 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
$cfrom :: forall x. CurrencyPair -> Rep CurrencyPair x
from :: forall x. CurrencyPair -> Rep CurrencyPair x
$cto :: forall x. Rep CurrencyPair x -> CurrencyPair
to :: forall x. Rep CurrencyPair x -> CurrencyPair
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
$ccompare :: CurrencyPair -> CurrencyPair -> Ordering
compare :: CurrencyPair -> CurrencyPair -> Ordering
$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
>= :: CurrencyPair -> CurrencyPair -> Bool
$cmax :: CurrencyPair -> CurrencyPair -> CurrencyPair
max :: CurrencyPair -> CurrencyPair -> CurrencyPair
$cmin :: CurrencyPair -> CurrencyPair -> CurrencyPair
min :: CurrencyPair -> CurrencyPair -> CurrencyPair
Ord, (forall (m :: * -> *). Quote m => CurrencyPair -> m Exp)
-> (forall (m :: * -> *).
Quote m =>
CurrencyPair -> Code m CurrencyPair)
-> Lift CurrencyPair
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
$clift :: forall (m :: * -> *). Quote m => CurrencyPair -> m Exp
lift :: forall (m :: * -> *). Quote m => CurrencyPair -> m Exp
$cliftTyped :: forall (m :: * -> *).
Quote m =>
CurrencyPair -> Code m CurrencyPair
liftTyped :: forall (m :: * -> *).
Quote m =>
CurrencyPair -> Code m CurrencyPair
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"
toEncoding :: CurrencyPair -> Encoding
toEncoding = Options -> CurrencyPair -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding (Options -> CurrencyPair -> Encoding)
-> Options -> CurrencyPair -> Encoding
forall a b. (a -> b) -> a -> b
$ String -> Options
commonAesonOptions String
"currencyPair"
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
toCurrencyTuple :: CurrencyPair -> (Currency, Currency)
toCurrencyTuple :: CurrencyPair -> (Currency, Currency)
toCurrencyTuple (CurrencyPair Currency
x Currency
y) = (Currency
x, Currency
y)
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