{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}

module CoinbasePro.MarketData.Types
    ( Product (..)
    , CBTime (..)
    , AggregateBookLevel (..)
    , FullBookLevel (..)
    , Trade (..)
    ) where

import           Data.Aeson        (FromJSON (..), withObject, (.:))
import           Data.Aeson.Casing (snakeCase)
import           Data.Aeson.TH     (defaultOptions, deriveJSON,
                                    fieldLabelModifier)
import           Data.Text         (Text, pack)
import           Data.Time.Clock   (UTCTime)
import           Web.HttpApiData   (ToHttpApiData (..))

import           CoinbasePro.Types (Price, ProductId, Side, Size, TradeId)


data Product = Product
    { Product -> ProductId
productId      :: ProductId
    , Product -> Text
baseCurrency   :: Text
    , Product -> Text
quoteCurrency  :: Text
    , Product -> Double
baseIncrement  :: Double
    , Product -> Double
quoteIncrement :: Double
    , Product -> Double
minMarketFunds :: Double
    , Product -> Text
displayName    :: Text
    } deriving (Product -> Product -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Product -> Product -> Bool
$c/= :: Product -> Product -> Bool
== :: Product -> Product -> Bool
$c== :: Product -> Product -> Bool
Eq, Int -> Product -> ShowS
[Product] -> ShowS
Product -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Product] -> ShowS
$cshowList :: [Product] -> ShowS
show :: Product -> String
$cshow :: Product -> String
showsPrec :: Int -> Product -> ShowS
$cshowsPrec :: Int -> Product -> ShowS
Show)


instance FromJSON Product where
    parseJSON :: Value -> Parser Product
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"product" forall a b. (a -> b) -> a -> b
$ \Object
o -> ProductId
-> Text -> Text -> Double -> Double -> Double -> Text -> Product
Product
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"base_currency"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"quote_currency"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"base_increment")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"quote_increment")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Read a => String -> a
read forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"min_market_funds")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"display_name"


instance ToHttpApiData Product where
    toUrlPiece :: Product -> Text
toUrlPiece   = forall a. ToHttpApiData a => a -> Text
toUrlPiece forall b c a. (b -> c) -> (a -> b) -> a -> c
. Product -> ProductId
productId
    toQueryParam :: Product -> Text
toQueryParam = forall a. ToHttpApiData a => a -> Text
toQueryParam forall b c a. (b -> c) -> (a -> b) -> a -> c
. Product -> ProductId
productId


newtype CBTime = CBTime { CBTime -> UTCTime
unCBTime :: UTCTime } deriving (CBTime -> CBTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CBTime -> CBTime -> Bool
$c/= :: CBTime -> CBTime -> Bool
== :: CBTime -> CBTime -> Bool
$c== :: CBTime -> CBTime -> Bool
Eq, Int -> CBTime -> ShowS
[CBTime] -> ShowS
CBTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CBTime] -> ShowS
$cshowList :: [CBTime] -> ShowS
show :: CBTime -> String
$cshow :: CBTime -> String
showsPrec :: Int -> CBTime -> ShowS
$cshowsPrec :: Int -> CBTime -> ShowS
Show, Eq CBTime
CBTime -> CBTime -> Bool
CBTime -> CBTime -> Ordering
CBTime -> CBTime -> CBTime
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 :: CBTime -> CBTime -> CBTime
$cmin :: CBTime -> CBTime -> CBTime
max :: CBTime -> CBTime -> CBTime
$cmax :: CBTime -> CBTime -> CBTime
>= :: CBTime -> CBTime -> Bool
$c>= :: CBTime -> CBTime -> Bool
> :: CBTime -> CBTime -> Bool
$c> :: CBTime -> CBTime -> Bool
<= :: CBTime -> CBTime -> Bool
$c<= :: CBTime -> CBTime -> Bool
< :: CBTime -> CBTime -> Bool
$c< :: CBTime -> CBTime -> Bool
compare :: CBTime -> CBTime -> Ordering
$ccompare :: CBTime -> CBTime -> Ordering
Ord)


instance FromJSON CBTime where
    parseJSON :: Value -> Parser CBTime
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"time" forall a b. (a -> b) -> a -> b
$ \Object
o ->
      UTCTime -> CBTime
CBTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"iso"


data AggregateBookLevel = Best | TopFifty
    deriving (AggregateBookLevel -> AggregateBookLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AggregateBookLevel -> AggregateBookLevel -> Bool
$c/= :: AggregateBookLevel -> AggregateBookLevel -> Bool
== :: AggregateBookLevel -> AggregateBookLevel -> Bool
$c== :: AggregateBookLevel -> AggregateBookLevel -> Bool
Eq, Int -> AggregateBookLevel -> ShowS
[AggregateBookLevel] -> ShowS
AggregateBookLevel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AggregateBookLevel] -> ShowS
$cshowList :: [AggregateBookLevel] -> ShowS
show :: AggregateBookLevel -> String
$cshow :: AggregateBookLevel -> String
showsPrec :: Int -> AggregateBookLevel -> ShowS
$cshowsPrec :: Int -> AggregateBookLevel -> ShowS
Show)


instance ToHttpApiData AggregateBookLevel where
    toUrlPiece :: AggregateBookLevel -> Text
toUrlPiece = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. AggregateBookLevel -> Int
aggregateBookLevel
    toQueryParam :: AggregateBookLevel -> Text
toQueryParam = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. AggregateBookLevel -> Int
aggregateBookLevel


aggregateBookLevel :: AggregateBookLevel -> Int
aggregateBookLevel :: AggregateBookLevel -> Int
aggregateBookLevel AggregateBookLevel
Best     = Int
1
aggregateBookLevel AggregateBookLevel
TopFifty = Int
2


data FullBookLevel = FullBookLevel


instance ToHttpApiData FullBookLevel where
    toUrlPiece :: FullBookLevel -> Text
toUrlPiece = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. FullBookLevel -> Int
fullBookLevel
    toQueryParam :: FullBookLevel -> Text
toQueryParam = String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. FullBookLevel -> Int
fullBookLevel


fullBookLevel :: FullBookLevel -> Int
fullBookLevel :: FullBookLevel -> Int
fullBookLevel FullBookLevel
FullBookLevel = Int
3


data Trade = Trade
    { Trade -> UTCTime
time    :: UTCTime
    , Trade -> TradeId
tradeId :: TradeId
    , Trade -> Price
price   :: Price
    , Trade -> Size
size    :: Size
    , Trade -> Side
side    :: Side
    } deriving (Trade -> Trade -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Trade -> Trade -> Bool
$c/= :: Trade -> Trade -> Bool
== :: Trade -> Trade -> Bool
$c== :: Trade -> Trade -> Bool
Eq, Int -> Trade -> ShowS
[Trade] -> ShowS
Trade -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Trade] -> ShowS
$cshowList :: [Trade] -> ShowS
show :: Trade -> String
$cshow :: Trade -> String
showsPrec :: Int -> Trade -> ShowS
$cshowsPrec :: Int -> Trade -> ShowS
Show)


deriveJSON defaultOptions { fieldLabelModifier = snakeCase } ''Trade