{-# LANGUAGE OverloadedStrings #-}

module CoinbasePro.WebSocketFeed.Channel.Level2
    ( Snapshot (..)
    , SnapshotLevel (..)
    , Change (..)
    , L2Update(..)
    ) where

import           Data.Aeson  (FromJSON (..), withArray, withObject, (.:))
import           Data.Text   (Text)
import qualified Data.Vector as V


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


instance FromJSON SnapshotLevel where
    parseJSON :: Value -> Parser SnapshotLevel
parseJSON = String
-> (Array -> Parser SnapshotLevel) -> Value -> Parser SnapshotLevel
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"snapshot level" ((Array -> Parser SnapshotLevel) -> Value -> Parser SnapshotLevel)
-> (Array -> Parser SnapshotLevel) -> Value -> Parser SnapshotLevel
forall a b. (a -> b) -> a -> b
$ \Array
a -> do
        let l :: [Value]
l = Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
a
        String
p  <- Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser String) -> Value -> Parser String
forall a b. (a -> b) -> a -> b
$ [Value] -> Value
forall a. [a] -> a
head [Value]
l
        String
sz <- Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser String) -> Value -> Parser String
forall a b. (a -> b) -> a -> b
$ [Value]
l [Value] -> Int -> Value
forall a. [a] -> Int -> a
!! Int
1
        SnapshotLevel -> Parser SnapshotLevel
forall (m :: * -> *) a. Monad m => a -> m a
return (SnapshotLevel -> Parser SnapshotLevel)
-> SnapshotLevel -> Parser SnapshotLevel
forall a b. (a -> b) -> a -> b
$ Double -> Double -> SnapshotLevel
SnapshotLevel (String -> Double
forall a. Read a => String -> a
read String
p) (String -> Double
forall a. Read a => String -> a
read String
sz)


data Snapshot = Snapshot
    { Snapshot -> Text
sProductId :: Text
    , Snapshot -> [SnapshotLevel]
bids       :: [SnapshotLevel]
    , Snapshot -> [SnapshotLevel]
asks       :: [SnapshotLevel]
    } deriving (Snapshot -> Snapshot -> Bool
(Snapshot -> Snapshot -> Bool)
-> (Snapshot -> Snapshot -> Bool) -> Eq Snapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Snapshot -> Snapshot -> Bool
$c/= :: Snapshot -> Snapshot -> Bool
== :: Snapshot -> Snapshot -> Bool
$c== :: Snapshot -> Snapshot -> Bool
Eq, Eq Snapshot
Eq Snapshot
-> (Snapshot -> Snapshot -> Ordering)
-> (Snapshot -> Snapshot -> Bool)
-> (Snapshot -> Snapshot -> Bool)
-> (Snapshot -> Snapshot -> Bool)
-> (Snapshot -> Snapshot -> Bool)
-> (Snapshot -> Snapshot -> Snapshot)
-> (Snapshot -> Snapshot -> Snapshot)
-> Ord Snapshot
Snapshot -> Snapshot -> Bool
Snapshot -> Snapshot -> Ordering
Snapshot -> Snapshot -> Snapshot
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 :: Snapshot -> Snapshot -> Snapshot
$cmin :: Snapshot -> Snapshot -> Snapshot
max :: Snapshot -> Snapshot -> Snapshot
$cmax :: Snapshot -> Snapshot -> Snapshot
>= :: Snapshot -> Snapshot -> Bool
$c>= :: Snapshot -> Snapshot -> Bool
> :: Snapshot -> Snapshot -> Bool
$c> :: Snapshot -> Snapshot -> Bool
<= :: Snapshot -> Snapshot -> Bool
$c<= :: Snapshot -> Snapshot -> Bool
< :: Snapshot -> Snapshot -> Bool
$c< :: Snapshot -> Snapshot -> Bool
compare :: Snapshot -> Snapshot -> Ordering
$ccompare :: Snapshot -> Snapshot -> Ordering
$cp1Ord :: Eq Snapshot
Ord, Int -> Snapshot -> ShowS
[Snapshot] -> ShowS
Snapshot -> String
(Int -> Snapshot -> ShowS)
-> (Snapshot -> String) -> ([Snapshot] -> ShowS) -> Show Snapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Snapshot] -> ShowS
$cshowList :: [Snapshot] -> ShowS
show :: Snapshot -> String
$cshow :: Snapshot -> String
showsPrec :: Int -> Snapshot -> ShowS
$cshowsPrec :: Int -> Snapshot -> ShowS
Show)


instance FromJSON Snapshot where
    parseJSON :: Value -> Parser Snapshot
parseJSON = String -> (Object -> Parser Snapshot) -> Value -> Parser Snapshot
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"snapshot" ((Object -> Parser Snapshot) -> Value -> Parser Snapshot)
-> (Object -> Parser Snapshot) -> Value -> Parser Snapshot
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      Text -> [SnapshotLevel] -> [SnapshotLevel] -> Snapshot
Snapshot (Text -> [SnapshotLevel] -> [SnapshotLevel] -> Snapshot)
-> Parser Text
-> Parser ([SnapshotLevel] -> [SnapshotLevel] -> Snapshot)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"product_id" Parser ([SnapshotLevel] -> [SnapshotLevel] -> Snapshot)
-> Parser [SnapshotLevel] -> Parser ([SnapshotLevel] -> Snapshot)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Object
o Object -> Text -> Parser [SnapshotLevel]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"bids" Parser ([SnapshotLevel] -> Snapshot)
-> Parser [SnapshotLevel] -> Parser Snapshot
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Object
o Object -> Text -> Parser [SnapshotLevel]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"asks"


data Change = Change
    { Change -> Text
side   :: Text
    , Change -> Double
cPrice :: Double
    , Change -> Double
cSize  :: Double
    } deriving (Change -> Change -> Bool
(Change -> Change -> Bool)
-> (Change -> Change -> Bool) -> Eq Change
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Change -> Change -> Bool
$c/= :: Change -> Change -> Bool
== :: Change -> Change -> Bool
$c== :: Change -> Change -> Bool
Eq, Eq Change
Eq Change
-> (Change -> Change -> Ordering)
-> (Change -> Change -> Bool)
-> (Change -> Change -> Bool)
-> (Change -> Change -> Bool)
-> (Change -> Change -> Bool)
-> (Change -> Change -> Change)
-> (Change -> Change -> Change)
-> Ord Change
Change -> Change -> Bool
Change -> Change -> Ordering
Change -> Change -> Change
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 :: Change -> Change -> Change
$cmin :: Change -> Change -> Change
max :: Change -> Change -> Change
$cmax :: Change -> Change -> Change
>= :: Change -> Change -> Bool
$c>= :: Change -> Change -> Bool
> :: Change -> Change -> Bool
$c> :: Change -> Change -> Bool
<= :: Change -> Change -> Bool
$c<= :: Change -> Change -> Bool
< :: Change -> Change -> Bool
$c< :: Change -> Change -> Bool
compare :: Change -> Change -> Ordering
$ccompare :: Change -> Change -> Ordering
$cp1Ord :: Eq Change
Ord, Int -> Change -> ShowS
[Change] -> ShowS
Change -> String
(Int -> Change -> ShowS)
-> (Change -> String) -> ([Change] -> ShowS) -> Show Change
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Change] -> ShowS
$cshowList :: [Change] -> ShowS
show :: Change -> String
$cshow :: Change -> String
showsPrec :: Int -> Change -> ShowS
$cshowsPrec :: Int -> Change -> ShowS
Show)


instance FromJSON Change where
    parseJSON :: Value -> Parser Change
parseJSON = String -> (Array -> Parser Change) -> Value -> Parser Change
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"change" ((Array -> Parser Change) -> Value -> Parser Change)
-> (Array -> Parser Change) -> Value -> Parser Change
forall a b. (a -> b) -> a -> b
$ \Array
a -> do
        let l :: [Value]
l = Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
a
        Text
sd <- Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser Text) -> Value -> Parser Text
forall a b. (a -> b) -> a -> b
$ [Value] -> Value
forall a. [a] -> a
head [Value]
l
        String
p  <- Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser String) -> Value -> Parser String
forall a b. (a -> b) -> a -> b
$ [Value]
l [Value] -> Int -> Value
forall a. [a] -> Int -> a
!! Int
1
        String
sz <- Value -> Parser String
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser String) -> Value -> Parser String
forall a b. (a -> b) -> a -> b
$ [Value]
l [Value] -> Int -> Value
forall a. [a] -> Int -> a
!! Int
2
        Change -> Parser Change
forall (m :: * -> *) a. Monad m => a -> m a
return (Change -> Parser Change) -> Change -> Parser Change
forall a b. (a -> b) -> a -> b
$ Text -> Double -> Double -> Change
Change Text
sd (String -> Double
forall a. Read a => String -> a
read String
p) (String -> Double
forall a. Read a => String -> a
read String
sz)


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


instance FromJSON L2Update where
    parseJSON :: Value -> Parser L2Update
parseJSON = String -> (Object -> Parser L2Update) -> Value -> Parser L2Update
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"l2update" ((Object -> Parser L2Update) -> Value -> Parser L2Update)
-> (Object -> Parser L2Update) -> Value -> Parser L2Update
forall a b. (a -> b) -> a -> b
$ \Object
o ->
      Text -> [Change] -> L2Update
L2Update (Text -> [Change] -> L2Update)
-> Parser Text -> Parser ([Change] -> L2Update)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"product_id" Parser ([Change] -> L2Update) -> Parser [Change] -> Parser L2Update
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Object
o Object -> Text -> Parser [Change]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"changes"