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

module CoinbasePro.WebSocketFeed.Response
    ( ResponseMessageType(..)
    , ResponseChannel(..)
    , Subscription (..)
    ) where


import           Data.Aeson                        (FromJSON (..), withObject,
                                                    withText, (.:))
import           Data.Aeson.Types                  (typeMismatch)
import           Data.Text                         (Text)

import           CoinbasePro.WebSocketFeed.Request (ChannelName (..))


data ResponseMessageType = Subscriptions
    deriving (ResponseMessageType -> ResponseMessageType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResponseMessageType -> ResponseMessageType -> Bool
$c/= :: ResponseMessageType -> ResponseMessageType -> Bool
== :: ResponseMessageType -> ResponseMessageType -> Bool
$c== :: ResponseMessageType -> ResponseMessageType -> Bool
Eq, Eq ResponseMessageType
ResponseMessageType -> ResponseMessageType -> Bool
ResponseMessageType -> ResponseMessageType -> Ordering
ResponseMessageType -> ResponseMessageType -> ResponseMessageType
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 :: ResponseMessageType -> ResponseMessageType -> ResponseMessageType
$cmin :: ResponseMessageType -> ResponseMessageType -> ResponseMessageType
max :: ResponseMessageType -> ResponseMessageType -> ResponseMessageType
$cmax :: ResponseMessageType -> ResponseMessageType -> ResponseMessageType
>= :: ResponseMessageType -> ResponseMessageType -> Bool
$c>= :: ResponseMessageType -> ResponseMessageType -> Bool
> :: ResponseMessageType -> ResponseMessageType -> Bool
$c> :: ResponseMessageType -> ResponseMessageType -> Bool
<= :: ResponseMessageType -> ResponseMessageType -> Bool
$c<= :: ResponseMessageType -> ResponseMessageType -> Bool
< :: ResponseMessageType -> ResponseMessageType -> Bool
$c< :: ResponseMessageType -> ResponseMessageType -> Bool
compare :: ResponseMessageType -> ResponseMessageType -> Ordering
$ccompare :: ResponseMessageType -> ResponseMessageType -> Ordering
Ord)


instance Show ResponseMessageType where
    show :: ResponseMessageType -> String
show ResponseMessageType
Subscriptions = String
"subscriptions"


instance FromJSON ResponseMessageType where
    parseJSON :: Value -> Parser ResponseMessageType
parseJSON Value
v = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"response message type" (
      \case
        Text
"subscriptions" -> forall (m :: * -> *) a. Monad m => a -> m a
return ResponseMessageType
Subscriptions
        Text
_               -> forall a. String -> Value -> Parser a
typeMismatch String
"response message type" Value
v) Value
v


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


instance FromJSON ResponseChannel where
    parseJSON :: Value -> Parser ResponseChannel
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"response channel" forall a b. (a -> b) -> a -> b
$ \Object
o ->
      ChannelName -> [Text] -> ResponseChannel
ResponseChannel forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name" 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_ids"


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


instance FromJSON Subscription where
    parseJSON :: Value -> Parser Subscription
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"subscription" forall a b. (a -> b) -> a -> b
$ \Object
o ->
      ResponseMessageType -> [ResponseChannel] -> Subscription
Subscription forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channels"