module Data.JsonRpc.Instances () where
import GHC.Generics (Generic)
import Control.Applicative ((<$>), pure, (<|>))
import Data.Maybe (fromMaybe)
import Data.List (stripPrefix)
import Data.Aeson (FromJSON (..), genericParseJSON, ToJSON (..), genericToJSON, Value(..))
import Data.Aeson.Types (Options (..))
import qualified Data.Aeson.Types as Aeson
import Data.JsonRpc.Id (Id(..), numberId)
import Data.JsonRpc.Request (Request (..))
import Data.JsonRpc.Success (Success (..))
import Data.JsonRpc.Failure (Failure (..), Error (..))
import Data.JsonRpc.Response (Response (..))
instance FromJSON Id where
parseJSON = d where
d (String t) = pure $ StringId t
d (Number n) = maybe (parseError "Integer check error") pure $ numberId n
d (Object {}) = parseError "object is not allowed"
d (Array {}) = parseError "array is not allowed"
d (Bool {}) = parseError "boolean is not allowed"
d Null = parseError "null is not allowed"
parseError = fail . ("JSON RPC id: " ++)
instance ToJSON Id where
toJSON = d where
d (StringId s) = String s
d (NumberId i) = Number $ fromIntegral i
deriving instance Generic (Request a)
instance FromJSON a => FromJSON (Request a) where
parseJSON = genericParseJSON customOptions
instance ToJSON a => ToJSON (Request a) where
toJSON = genericToJSON customOptions
deriving instance Generic (Success a)
instance FromJSON a => FromJSON (Success a) where
parseJSON = genericParseJSON customOptions
instance ToJSON a => ToJSON (Success a) where
toJSON = genericToJSON customOptions
deriving instance Generic (Error e)
deriving instance Generic (Failure e)
instance FromJSON e => FromJSON (Error e) where
parseJSON = genericParseJSON customOptions
instance ToJSON e => ToJSON (Error e) where
toJSON = genericToJSON customOptions { omitNothingFields = True }
instance FromJSON e => FromJSON (Failure e) where
parseJSON = genericParseJSON customOptions
instance ToJSON e => ToJSON (Failure e) where
toJSON = genericToJSON customOptions
instance (FromJSON e, FromJSON a) => FromJSON (Response e a) where
parseJSON v = Response <$> (Right <$> parseJSON v <|>
Left <$> parseJSON v)
instance (ToJSON e, ToJSON a) => ToJSON (Response e a) where
toJSON (Response r) = case r of
Right a -> toJSON a
Left e -> toJSON e
customOptions :: Options
customOptions =
Aeson.defaultOptions
{ fieldLabelModifier = \s -> fromMaybe s $ stripPrefix "_" s }