{-# LANGUAGE
    OverloadedStrings
  , RecordWildCards
  , DoAndIfThenElse
  #-}

module WebSocket.RPC where

import qualified Data.Text as T
import Data.Aeson as A
import Data.Aeson.Types (typeMismatch)



data WSRPCClient
  = Subscribe
  | Supply
  | Unsubscribe
  deriving (Show, Eq)

instance ToJSON WSRPCClient where
  toJSON x = case x of
    Subscribe   -> String "subscribe"
    Supply      -> String "supply"
    Unsubscribe -> String "unsubscribe"

instance FromJSON WSRPCClient where
  parseJSON (String x)
    | x == "subscribe"   = pure Subscribe
    | x == "supply"      = pure Supply
    | x == "unsubscribe" = pure Unsubscribe
    | otherwise          = fail "not a WSRPCClient string"
  parseJSON x = typeMismatch "WSRPCClient" x


data WSRPCServer
  = Reply
  | Complete
  deriving (Show, Eq)

instance ToJSON WSRPCServer where
  toJSON x = case x of
    Reply    -> "reply"
    Complete -> "complete"

instance FromJSON WSRPCServer where
  parseJSON (String x)
    | x == "reply"    = pure Reply
    | x == "complete" = pure Complete
    | otherwise       = fail "not a WSRPCServer string"
  parseJSON x = typeMismatch "WSRPCServer" x


-- | Represents the encoded data going both directions
data WSRPC direction a = WSRPC
  { wsrpcIdent     :: Int
  , wsrpcMethod    :: T.Text -- ^ user defined
  , wsrpcDirection :: direction
  , wsrpcValue     :: a
  } deriving (Show, Eq)

instance (ToJSON direction, ToJSON a) => ToJSON (WSRPC direction a) where
  toJSON WSRPC{..} = object
    [ "version"   .= rpcVersion
    , "ident"     .= wsrpcIdent
    , "method"    .= wsrpcMethod
    , "direction" .= wsrpcDirection
    , "value"     .= wsrpcValue
    ]

instance (FromJSON direction, FromJSON a) => FromJSON (WSRPC direction a) where
  parseJSON (Object o) = do
    v <- o .: "version"
    if v /= rpcVersion
    then fail ("RPC version isn't " ++ T.unpack rpcVersion)
    else do
      ident     <- o .: "ident"
      method    <- o .: "method"
      direction <- o .: "direction"
      value     <- o .: "value"
      pure WSRPC
        { wsrpcIdent     = ident
        , wsrpcMethod    = method
        , wsrpcDirection = direction
        , wsrpcValue     = value
        }
  parseJSON x = typeMismatch "WSRPC" x


rpcVersion :: T.Text
rpcVersion = "0.0.1"
