Skip to content

Commit b9c9786

Browse files
sebrightsebright
committed
Qualified Aeson imports
1 parent e9be9ca commit b9c9786

File tree

3 files changed

+70
-69
lines changed

3 files changed

+70
-69
lines changed

‎src/Network/JsonRpc/Server.hs‎

Lines changed: 17 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,7 @@ import Network.JsonRpc.Types
3535
import Data.Text (Text, append, pack)
3636
import Data.Maybe (catMaybes)
3737
import qualified Data.ByteString.Lazy as B
38-
import Data.Aeson
38+
import qualified Data.Aeson as A
3939
import qualified Data.Vector as V
4040
import qualified Data.HashMap.Strict as H
4141
import Control.Applicative ((<$>))
@@ -70,8 +70,8 @@ import Prelude hiding (length)
7070

7171
-- | Creates a method from a name, function, and parameter descriptions.
7272
-- The parameter names must be unique.
73-
toMethod :: (MethodParams f p m r, ToJSON r, Monad m) => Text -> f -> p -> Method m
74-
toMethod name f params = let f' args = toJSON <$> apply f params args
73+
toMethod :: (MethodParams f p m r, A.ToJSON r, Monad m) => Text -> f -> p -> Method m
74+
toMethod name f params = let f' args = A.toJSON <$> apply f params args
7575
in Method name f'
7676

7777
-- | Creates a set of methods to be called by name. The names must be unique.
@@ -98,22 +98,22 @@ callWithBatchStrategy :: Monad m =>
9898
-- 'Nothing' in the case of a notification,
9999
-- all wrapped in the given monad.
100100
callWithBatchStrategy strategy fs input = either returnErr callMethod request
101-
where request :: Either RpcError (Either Value [Value])
101+
where request :: Either RpcError (Either A.Value [A.Value])
102102
request = runIdentity $ runErrorT $ parseVal =<< parseJson input
103-
parseJson = maybe invalidJson return . decode
103+
parseJson = maybe invalidJson return . A.decode
104104
parseVal val = case val of
105-
obj@(Object _) -> return $ Left obj
106-
Array vec | V.null vec -> throwError $ invalidRpcError "Empty batch request"
105+
obj@(A.Object _) -> return $ Left obj
106+
A.Array vec | V.null vec -> throwError $ invalidRpcError "Empty batch request"
107107
| otherwise -> return $ Right $ V.toList vec
108108
_ -> throwError $ invalidRpcError "Not a JSON object or array"
109109
callMethod rq = case rq of
110110
Left val -> encodeJust `liftM` singleCall fs val
111111
Right vals -> encodeJust `liftM` batchCall strategy fs vals
112-
where encodeJust r = (encode . toJSON) <$> r
113-
returnErr = return . Just . encode . toJSON . nullIdResponse
112+
where encodeJust r = (A.encode . A.toJSON) <$> r
113+
returnErr = return . Just . A.encode . A.toJSON . nullIdResponse
114114
invalidJson = throwError $ rpcError (-32700) "Invalid JSON"
115115

116-
singleCall :: Monad m => Methods m -> Value -> m (Maybe Response)
116+
singleCall :: Monad m => Methods m -> A.Value -> m (Maybe Response)
117117
singleCall (Methods fs) val = case parsed of
118118
Left err -> return $ nullIdResponse err
119119
Right (Request name args i) ->
@@ -125,10 +125,10 @@ singleCall (Methods fs) val = case parsed of
125125
nullIdResponse :: RpcError -> Maybe Response
126126
nullIdResponse err = toResponse (Just IdNull) (Left err :: Either RpcError ())
127127

128-
parseValue :: (FromJSON a, Monad m) => Value -> RpcResult m a
129-
parseValue val = case fromJSON val of
130-
Error msg -> throwError $ invalidRpcError $ pack msg
131-
Success x -> return x
128+
parseValue :: (A.FromJSON a, Monad m) => A.Value -> RpcResult m a
129+
parseValue val = case A.fromJSON val of
130+
A.Error msg -> throwError $ invalidRpcError $ pack msg
131+
A.Success x -> return x
132132

133133
lookupMethod :: Monad m => Text -> H.HashMap Text (Method m) -> RpcResult m (Method m)
134134
lookupMethod name = maybe notFound return . H.lookup name
@@ -139,12 +139,12 @@ invalidRpcError = rpcErrorWithData (-32600) "Invalid JSON RPC 2.0 request"
139139

140140
batchCall :: Monad m => (forall a. [m a] -> m [a])
141141
-> Methods m
142-
-> [Value]
142+
-> [A.Value]
143143
-> m (Maybe [Response])
144144
batchCall strategy mths vals = (noNull . catMaybes) `liftM` results
145145
where results = strategy $ map (singleCall mths) vals
146146
noNull rs = if null rs then Nothing else Just rs
147147

148-
toResponse :: ToJSON a => Maybe Id -> Either RpcError a -> Maybe Response
149-
toResponse (Just i) r = Just $ Response i $ toJSON <$> r
148+
toResponse :: A.ToJSON a => Maybe Id -> Either RpcError a -> Maybe Response
149+
toResponse (Just i) r = Just $ Response i $ A.toJSON <$> r
150150
toResponse Nothing _ = Nothing

‎src/Network/JsonRpc/Types.hs‎

Lines changed: 34 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,8 @@ module Network.JsonRpc.Types ( RpcResult
2222
import Data.String (fromString)
2323
import Data.Maybe (catMaybes)
2424
import Data.Text (Text, append, unpack)
25-
import Data.Aeson
25+
import qualified Data.Aeson as A
26+
import Data.Aeson ((.=), (.:), (.:?), (.!=))
2627
import Data.Aeson.Types (emptyObject)
2728
import qualified Data.Vector as V
2829
import qualified Data.HashMap.Strict as H
@@ -51,38 +52,38 @@ infixr :+:
5152
-- monad ('m'), and return type ('r'). 'p' has one 'Parameter' for
5253
-- every argument of 'f' and is terminated by @()@. The return type
5354
-- of 'f' is @RpcResult m r@. This class is treated as closed.
54-
class (Monad m, Functor m, ToJSON r) => MethodParams f p m r | f -> p m r where
55+
class (Monad m, Functor m, A.ToJSON r) => MethodParams f p m r | f -> p m r where
5556
apply :: f -> p -> Args -> RpcResult m r
5657

57-
instance (Monad m, Functor m, ToJSON r) => MethodParams (RpcResult m r) () m r where
58+
instance (Monad m, Functor m, A.ToJSON r) => MethodParams (RpcResult m r) () m r where
5859
apply r _ args | Left _ <- args = r
5960
| Right ar <- args, V.null ar = r
6061
| otherwise = throwError $ rpcError (-32602) "Too many unnamed arguments"
6162

62-
instance (FromJSON a, MethodParams f p m r) => MethodParams (a -> f) (a :+: p) m r where
63+
instance (A.FromJSON a, MethodParams f p m r) => MethodParams (a -> f) (a :+: p) m r where
6364
apply f (param :+: ps) args = arg >>= \a -> apply (f a) ps nextArgs
6465
where arg = either (parseArg name) return =<<
6566
(Left <$> lookupValue <|> Right <$> paramDefault param)
6667
lookupValue = either (lookupArg name) (headArg name) args
6768
nextArgs = tailOrEmpty <$> args
6869
name = paramName param
6970

70-
lookupArg :: Monad m => Text -> Object -> RpcResult m Value
71+
lookupArg :: Monad m => Text -> A.Object -> RpcResult m A.Value
7172
lookupArg name hm = case H.lookup name hm of
7273
Nothing -> throwError $ missingArgError name
7374
Just v -> return v
7475

75-
headArg :: Monad m => Text -> V.Vector a -> RpcResult m a
76+
headArg :: Monad m => Text -> A.Array -> RpcResult m A.Value
7677
headArg name vec | V.null vec = throwError $ missingArgError name
7778
| otherwise = return $ V.head vec
7879

79-
tailOrEmpty :: V.Vector a -> V.Vector a
80+
tailOrEmpty :: A.Array -> A.Array
8081
tailOrEmpty vec = if V.null vec then V.empty else V.tail vec
8182

82-
parseArg :: (Monad m, FromJSON r) => Text -> Value -> RpcResult m r
83-
parseArg name val = case fromJSON val of
84-
Error msg -> throwError $ rpcErrorWithData (-32602) ("Wrong type for argument: " `append` name) msg
85-
Success x -> return x
83+
parseArg :: (Monad m, A.FromJSON r) => Text -> A.Value -> RpcResult m r
84+
parseArg name val = case A.fromJSON val of
85+
A.Error msg -> throwError $ rpcErrorWithData (-32602) ("Wrong type for argument: " `append` name) msg
86+
A.Success x -> return x
8687

8788
paramDefault :: Monad m => Parameter a -> RpcResult m a
8889
paramDefault (Optional _ d) = return d
@@ -96,58 +97,58 @@ paramName (Optional n _) = n
9697
paramName (Required n) = n
9798

9899
-- | Single method.
99-
data Method m = Method Text (Args -> RpcResult m Value)
100+
data Method m = Method Text (Args -> RpcResult m A.Value)
100101

101102
-- | Multiple methods.
102103
newtype Methods m = Methods (H.HashMap Text (Method m))
103104

104-
type Args = Either Object Array
105+
type Args = Either A.Object A.Array
105106

106107
data Request = Request Text Args (Maybe Id)
107108

108-
instance FromJSON Request where
109-
parseJSON (Object x) = (checkVersion =<< x .:? versionKey .!= jsonRpcVersion) *>
109+
instance A.FromJSON Request where
110+
parseJSON (A.Object x) = (checkVersion =<< x .:? versionKey .!= jsonRpcVersion) *>
110111
(Request <$>
111112
x .: "method" <*>
112113
(parseParams =<< x .:? "params" .!= emptyObject) <*>
113114
(Just <$> x .: idKey <|> return Nothing)) -- (.:?) parses Null value as Nothing
114-
where parseParams (Object obj) = return $ Left obj
115-
parseParams (Array ar) = return $ Right ar
115+
where parseParams (A.Object obj) = return $ Left obj
116+
parseParams (A.Array ar) = return $ Right ar
116117
parseParams _ = empty
117118
checkVersion ver = when (ver /= jsonRpcVersion) (fail $ "Wrong JSON RPC version: " ++ unpack ver)
118119
parseJSON _ = empty
119120

120-
data Response = Response Id (Either RpcError Value)
121+
data Response = Response Id (Either RpcError A.Value)
121122

122-
instance ToJSON Response where
123-
toJSON (Response i result) = object pairs
123+
instance A.ToJSON Response where
124+
toJSON (Response i result) = A.object pairs
124125
where pairs = [ versionKey .= jsonRpcVersion
125126
, either ("error" .=) ("result" .=) result
126127
, idKey .= i]
127128

128129
data Id = IdString Text | IdNumber Number | IdNull
129130

130-
instance FromJSON Id where
131-
parseJSON (String x) = return $ IdString x
132-
parseJSON (Number x) = return $ IdNumber x
133-
parseJSON Null = return IdNull
131+
instance A.FromJSON Id where
132+
parseJSON (A.String x) = return $ IdString x
133+
parseJSON (A.Number x) = return $ IdNumber x
134+
parseJSON A.Null = return IdNull
134135
parseJSON _ = empty
135136

136-
instance ToJSON Id where
137-
toJSON (IdString x) = String x
138-
toJSON (IdNumber x) = Number x
139-
toJSON IdNull = Null
137+
instance A.ToJSON Id where
138+
toJSON (IdString x) = A.String x
139+
toJSON (IdNumber x) = A.Number x
140+
toJSON IdNull = A.Null
140141

141142
-- | Error to be returned to the client.
142-
data RpcError = RpcError Int Text (Maybe Value)
143+
data RpcError = RpcError Int Text (Maybe A.Value)
143144
deriving Show
144145

145146
instance Error RpcError where
146147
noMsg = strMsg "unknown error"
147148
strMsg msg = RpcError (-32000) (fromString msg) Nothing
148149

149-
instance ToJSON RpcError where
150-
toJSON (RpcError code msg data') = object pairs
150+
instance A.ToJSON RpcError where
151+
toJSON (RpcError code msg data') = A.object pairs
151152
where pairs = catMaybes [ Just $ "code" .= code
152153
, Just $ "message" .= msg
153154
, ("data" .=) <$> data' ]
@@ -161,8 +162,8 @@ rpcError code msg = RpcError code msg Nothing
161162

162163
-- | Creates an 'RpcError' with the given code, message, and additional data.
163164
-- See 'rpcError' for the recommended error code ranges.
164-
rpcErrorWithData :: ToJSON a => Int -> Text -> a -> RpcError
165-
rpcErrorWithData code msg errorData = RpcError code msg $ Just $ toJSON errorData
165+
rpcErrorWithData :: A.ToJSON a => Int -> Text -> a -> RpcError
166+
rpcErrorWithData code msg errorData = RpcError code msg $ Just $ A.toJSON errorData
166167

167168
jsonRpcVersion, versionKey, idKey :: Text
168169
jsonRpcVersion = "2.0"

‎tests/TestTypes.hs‎

Lines changed: 19 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,8 @@ module TestTypes ( TestRequest (..)
66
, TestId (..)
77
, versionKey) where
88

9-
import Data.Aeson
9+
import qualified Data.Aeson as A
10+
import Data.Aeson ((.=), (.:), (.:?))
1011
import Data.Maybe (catMaybes)
1112
import Data.Text (Text, pack)
1213
import Data.Attoparsec.Number (Number)
@@ -16,31 +17,31 @@ import Control.Monad (when, guard)
1617

1718
data TestRpcError = TestRpcError { errCode :: Int
1819
, errMsg :: Text
19-
, errData :: Maybe Value}
20+
, errData :: Maybe A.Value}
2021
deriving (Eq, Show)
2122

22-
instance FromJSON TestRpcError where
23-
parseJSON (Object obj) = do
23+
instance A.FromJSON TestRpcError where
24+
parseJSON (A.Object obj) = do
2425
d <- obj .:? "data"
2526
when (size obj /= maybe 2 (const 3) d) $ fail "Wrong number of keys"
2627
TestRpcError <$> obj .: "code" <*> obj .: "message" <*> pure d
2728
parseJSON _ = empty
2829

29-
data TestRequest = TestRequest Text (Maybe (Either Object Array)) (Maybe TestId)
30+
data TestRequest = TestRequest Text (Maybe (Either A.Object A.Array)) (Maybe TestId)
3031

31-
instance ToJSON TestRequest where
32-
toJSON (TestRequest name params i) = object pairs
32+
instance A.ToJSON TestRequest where
33+
toJSON (TestRequest name params i) = A.object pairs
3334
where pairs = catMaybes [Just $ "method" .= name, idPair, paramsPair]
3435
idPair = ("id" .=) <$> i
3536
paramsPair = either toPair toPair <$> params
3637
where toPair v = "params" .= v
3738

3839
data TestResponse = TestResponse { rspId :: TestId
39-
, rspResult :: Either TestRpcError Value }
40+
, rspResult :: Either TestRpcError A.Value }
4041
deriving (Eq, Show)
4142

42-
instance FromJSON TestResponse where
43-
parseJSON (Object obj) = do
43+
instance A.FromJSON TestResponse where
44+
parseJSON (A.Object obj) = do
4445
guard (size obj == 3)
4546
guard . (pack "2.0" ==) =<< obj .: versionKey
4647
TestResponse <$> obj .: "id" <*>
@@ -50,17 +51,16 @@ instance FromJSON TestResponse where
5051
data TestId = IdString Text | IdNumber Number | IdNull
5152
deriving (Eq, Show)
5253

53-
instance FromJSON TestId where
54-
parseJSON (String x) = return $ IdString x
55-
parseJSON (Number x) = return $ IdNumber x
56-
parseJSON Null = return IdNull
54+
instance A.FromJSON TestId where
55+
parseJSON (A.String x) = return $ IdString x
56+
parseJSON (A.Number x) = return $ IdNumber x
57+
parseJSON A.Null = return IdNull
5758
parseJSON _ = empty
5859

59-
instance ToJSON TestId where
60-
toJSON i = case i of
61-
IdString x -> String x
62-
IdNumber x -> Number x
63-
IdNull -> Null
60+
instance A.ToJSON TestId where
61+
toJSON (IdString x) = A.String x
62+
toJSON (IdNumber x) = A.Number x
63+
toJSON IdNull = A.Null
6464

6565
versionKey :: Text
6666
versionKey = "jsonrpc"

0 commit comments

Comments
 (0)