{-# LANGUAGE OverloadedStrings #-}
module Network.Greskell.WebSocket.Codec.JSON
( jsonCodec
) where
import Data.Aeson (FromJSON, ToJSON)
import qualified Data.Aeson as A
import Data.Aeson.Types (parseEither)
import Data.Greskell.GraphSON (FromGraphSON (..))
import Network.Greskell.WebSocket.Codec (Codec (..))
jsonCodec :: (FromGraphSON s) => Codec s
jsonCodec :: forall s. FromGraphSON s => Codec s
jsonCodec = 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