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

module CoinbasePro.WebSocketFeed.Channel.Full.Match
    ( Match (..)
    ) where

import           Data.Aeson.Casing (snakeCase)
import           Data.Aeson.TH     (defaultOptions, deriveJSON,
                                    fieldLabelModifier)
import           Data.Time.Clock   (UTCTime)

import           CoinbasePro.Types (OrderId, Price, ProductId, ProfileId,
                                    Sequence, Side, Size, UserId)


type TradeId = Int


data Match = Match
    { Match -> TradeId
tradeId      :: TradeId
    , Match -> TradeId
sequence     :: Sequence
    , Match -> OrderId
makerOrderId :: OrderId
    , Match -> OrderId
takerOrderId :: OrderId
    , Match -> UTCTime
time         :: UTCTime
    , Match -> ProductId
productId    :: ProductId
    , Match -> Size
size         :: Size
    , Match -> Price
price        :: Price
    , Match -> Side
side         :: Side
    , Match -> Maybe UserId
userId       :: Maybe UserId
    , Match -> Maybe UserId
profileId    :: Maybe ProfileId
    } deriving (Match -> Match -> Bool
(Match -> Match -> Bool) -> (Match -> Match -> Bool) -> Eq Match
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Match -> Match -> Bool
$c/= :: Match -> Match -> Bool
== :: Match -> Match -> Bool
$c== :: Match -> Match -> Bool
Eq, Eq Match
Eq Match
-> (Match -> Match -> Ordering)
-> (Match -> Match -> Bool)
-> (Match -> Match -> Bool)
-> (Match -> Match -> Bool)
-> (Match -> Match -> Bool)
-> (Match -> Match -> Match)
-> (Match -> Match -> Match)
-> Ord Match
Match -> Match -> Bool
Match -> Match -> Ordering
Match -> Match -> Match
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 :: Match -> Match -> Match
$cmin :: Match -> Match -> Match
max :: Match -> Match -> Match
$cmax :: Match -> Match -> Match
>= :: Match -> Match -> Bool
$c>= :: Match -> Match -> Bool
> :: Match -> Match -> Bool
$c> :: Match -> Match -> Bool
<= :: Match -> Match -> Bool
$c<= :: Match -> Match -> Bool
< :: Match -> Match -> Bool
$c< :: Match -> Match -> Bool
compare :: Match -> Match -> Ordering
$ccompare :: Match -> Match -> Ordering
$cp1Ord :: Eq Match
Ord, TradeId -> Match -> ShowS
[Match] -> ShowS
Match -> String
(TradeId -> Match -> ShowS)
-> (Match -> String) -> ([Match] -> ShowS) -> Show Match
forall a.
(TradeId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Match] -> ShowS
$cshowList :: [Match] -> ShowS
show :: Match -> String
$cshow :: Match -> String
showsPrec :: TradeId -> Match -> ShowS
$cshowsPrec :: TradeId -> Match -> ShowS
Show)


deriveJSON defaultOptions {fieldLabelModifier = snakeCase} ''Match