{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module: Network.Greskell.WebSocket.Codec.JSON
-- Description: application\/json codec
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- 
module Network.Greskell.WebSocket.Codec.JSON
       ( jsonCodec
       ) where

import Data.Aeson (ToJSON, FromJSON)
import qualified Data.Aeson as A
import Data.Aeson.Types (parseEither)

import Data.Greskell.GraphSON (FromGraphSON(..))

import Network.Greskell.WebSocket.Codec (Codec(..))

-- | Simple \"application\/json\" codec.
--
-- The encoder uses GraphSON v1 format. The decoder supports all
-- GraphSON v1, v2 and v3.
jsonCodec :: (FromGraphSON s) => Codec s
jsonCodec :: Codec s
jsonCodec = Codec :: forall s.
Text
-> (RequestMessage -> ByteString)
-> (ByteString -> Either String (ResponseMessage s))
-> Codec s
Codec { mimeType :: Text
mimeType = Text
"application/json",
                    encodeWith :: RequestMessage -> ByteString
encodeWith = RequestMessage -> ByteString
encode,
                    decodeWith :: ByteString -> Either String (ResponseMessage s)
decodeWith = ByteString -> Either String (ResponseMessage s)
forall b. FromGraphSON b => ByteString -> Either String b
decode
                  }
  where
    encode :: RequestMessage -> ByteString
encode = RequestMessage -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode
    decode :: ByteString -> Either String b
decode ByteString
bs = (GValue -> Parser b) -> GValue -> Either String b
forall a b. (a -> Parser b) -> a -> Either String b
parseEither GValue -> Parser b
forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON (GValue -> Either String b)
-> Either String GValue -> Either String b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> Either String GValue
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode' ByteString
bs