{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}

module CoinbasePro.Authenticated.Fills
    ( Fill (..)
    , TradeId
    , Liquidity (..)
    ) where

import           Data.Aeson        (FromJSON (..), withObject, withText, (.:))

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


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


instance FromJSON Liquidity where
    parseJSON :: Value -> Parser Liquidity
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"liquidity" forall a b. (a -> b) -> a -> b
$
      \case
        Text
"M" -> forall (m :: * -> *) a. Monad m => a -> m a
return Liquidity
Maker
        Text
"T" -> forall (m :: * -> *) a. Monad m => a -> m a
return Liquidity
Taker
        Text
_   -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"parse error"


data Fill = Fill
    { Fill -> TradeId
tradeId   :: TradeId
    , Fill -> ProductId
productId :: ProductId
    , Fill -> Side
side      :: Side
    , Fill -> Price
price     :: Price
    , Fill -> Size
size      :: Size
    , Fill -> OrderId
orderId   :: OrderId
    , Fill -> CreatedAt
createdAt :: CreatedAt
    , Fill -> Liquidity
liquidity :: Liquidity
    , Fill -> Double
fee       :: Double
    , Fill -> Bool
settled   :: Bool
    } deriving (Fill -> Fill -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fill -> Fill -> Bool
$c/= :: Fill -> Fill -> Bool
== :: Fill -> Fill -> Bool
$c== :: Fill -> Fill -> Bool
Eq, Int -> Fill -> ShowS
[Fill] -> ShowS
Fill -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fill] -> ShowS
$cshowList :: [Fill] -> ShowS
show :: Fill -> String
$cshow :: Fill -> String
showsPrec :: Int -> Fill -> ShowS
$cshowsPrec :: Int -> Fill -> ShowS
Show)


instance FromJSON Fill where
    parseJSON :: Value -> Parser Fill
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"fill" forall a b. (a -> b) -> a -> b
$ \Object
o -> TradeId
-> ProductId
-> Side
-> Price
-> Size
-> OrderId
-> CreatedAt
-> Liquidity
-> Double
-> Bool
-> Fill
Fill
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> TradeId
TradeId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"trade_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
"product_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
"side"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"price"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"order_id"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (UTCTime -> CreatedAt
CreatedAt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"liquidity")
        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
"fee")
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"settled"