{-# LANGUAGE OverloadedStrings #-}

module CoinbasePro.WebSocketFeed.Channel.Heartbeat
    ( Heartbeat (..)
    )where

import           Data.Aeson      (FromJSON (..), withObject, (.:))
import           Data.Text       (Text)
import           Data.Time.Clock (UTCTime)


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


instance FromJSON Heartbeat where
    parseJSON :: Value -> Parser Heartbeat
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"heartbeat" forall a b. (a -> b) -> a -> b
$ \Object
o ->
      Int -> Int -> Text -> UTCTime -> Heartbeat
Heartbeat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sequence" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"last_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
"time"