git.iko.soy/typeable/servant
on master help sign in
-Wall police
d461726Alp Mestanogullari
src/Servant/API/QueryParam.hs+1−1
compare with master
unifiedsplit
@@ -106,7 +106,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
106
106
107 clientWithRoute Proxy req paramlist =
107 clientWithRoute Proxy req paramlist =
108 clientWithRoute (Proxy :: Proxy sublayout) $
108 clientWithRoute (Proxy :: Proxy sublayout) $
109− foldl' (\ value req -> appendToQueryString pname req value) req paramlist'
109+ foldl' (\ value req' -> appendToQueryString pname req' value) req paramlist'
110
110
111 where pname = cs pname'
111 where pname = cs pname'
112 pname' = symbolVal (Proxy :: Proxy sym)
112 pname' = symbolVal (Proxy :: Proxy sym)
src/Servant/API/Raw.hs+2−2
@@ -29,8 +29,8 @@ instance HasClient Raw where
29 type Client Raw = Method -> BaseUrl -> EitherT String IO (Int, ByteString)
29 type Client Raw = Method -> BaseUrl -> EitherT String IO (Int, ByteString)
30
30
31 clientWithRoute :: Proxy Raw -> Req -> Client Raw
31 clientWithRoute :: Proxy Raw -> Req -> Client Raw
32− clientWithRoute Proxy req method host =
32+ clientWithRoute Proxy req httpMethod host =
33− performRequest method req (const True) host
33+ performRequest httpMethod req (const True) host
34
34
35
35
36instance HasDocs Raw where
36instance HasDocs Raw where
src/Servant/Common/BaseUrl.hs+6−6
@@ -19,13 +19,13 @@ data BaseUrl = BaseUrl {
19 deriving (Show, Eq, Ord, Generic)
19 deriving (Show, Eq, Ord, Generic)
20
20
21showBaseUrl :: BaseUrl -> String
21showBaseUrl :: BaseUrl -> String
22−showBaseUrl (BaseUrl scheme host port) =
22+showBaseUrl (BaseUrl urlscheme host port) =
23 schemeString ++ "//" ++ host ++ portString
23 schemeString ++ "//" ++ host ++ portString
24 where
24 where
25− schemeString = case scheme of
25+ schemeString = case urlscheme of
26 Http -> "http:"
26 Http -> "http:"
27 Https -> "https:"
27 Https -> "https:"
28− portString = case (scheme, port) of
28+ portString = case (urlscheme, port) of
29 (Http, 80) -> ""
29 (Http, 80) -> ""
30 (Https, 443) -> ""
30 (Https, 443) -> ""
31 _ -> ":" ++ show port
31 _ -> ":" ++ show port
@@ -46,6 +46,6 @@ parseBaseUrl s = case parseURI (removeTrailingSlash s) of
46 then Left ("invalid base url: " ++ s)
46 then Left ("invalid base url: " ++ s)
47 else parseBaseUrl ("http://" ++ s)
47 else parseBaseUrl ("http://" ++ s)
48 where
48 where
49− removeTrailingSlash s = case lastMay s of
49+ removeTrailingSlash str = case lastMay str of
50− Just '/' -> init s
50+ Just '/' -> init str
51− _ -> s
51+ _ -> str
src/Servant/Common/Req.hs+19−19
@@ -49,15 +49,15 @@ setRQBody :: ByteString -> Req -> Req
49setRQBody b req = req { reqBody = b }
49setRQBody b req = req { reqBody = b }
50
50
51reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request
51reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request
52−reqToRequest req (BaseUrl scheme host port) = fmap (setrqb . setQS ) $ parseUrl url
52+reqToRequest req (BaseUrl reqScheme reqHost reqPort) = fmap (setrqb . setQS ) $ parseUrl url
53
53
54− where url = show $ nullURI { uriScheme = case scheme of
54+ where url = show $ nullURI { uriScheme = case reqScheme of
55 Http -> "http:"
55 Http -> "http:"
56 Https -> "https:"
56 Https -> "https:"
57 , uriAuthority = Just $
57 , uriAuthority = Just $
58 URIAuth { uriUserInfo = ""
58 URIAuth { uriUserInfo = ""
59− , uriRegName = host
59+ , uriRegName = reqHost
60− , uriPort = ":" ++ show port
60+ , uriPort = ":" ++ show reqPort
61 }
61 }
62 , uriPath = reqPath req
62 , uriPath = reqPath req
63 }
63 }
@@ -79,14 +79,14 @@ __withGlobalManager action = modifyMVar __manager $ \ manager -> do
79
79
80
80
81displayHttpRequest :: Method -> String
81displayHttpRequest :: Method -> String
82−displayHttpRequest method = "HTTP " ++ cs method ++ " request"
82+displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"
83
83
84
84
85performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT String IO (Int, ByteString)
85performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT String IO (Int, ByteString)
86−performRequest method req isWantedStatus host = do
86+performRequest reqMethod req isWantedStatus reqHost = do
87− partialRequest <- liftIO $ reqToRequest req host
87+ partialRequest <- liftIO $ reqToRequest req reqHost
88
88
89− let request = partialRequest { Client.method = method
89+ let request = partialRequest { Client.method = reqMethod
90 , checkStatus = \ _status _headers _cookies -> Nothing
90 , checkStatus = \ _status _headers _cookies -> Nothing
91 }
91 }
92
92
@@ -95,12 +95,12 @@ performRequest method req isWantedStatus host = do
95 Client.httpLbs request manager
95 Client.httpLbs request manager
96 case eResponse of
96 case eResponse of
97 Left status ->
97 Left status ->
98− left (displayHttpRequest method ++ " failed with status: " ++ showStatus status)
98+ left (displayHttpRequest reqMethod ++ " failed with status: " ++ showStatus status)
99
99
100 Right response -> do
100 Right response -> do
101 let status = Client.responseStatus response
101 let status = Client.responseStatus response
102 unless (isWantedStatus (statusCode status)) $
102 unless (isWantedStatus (statusCode status)) $
103− left (displayHttpRequest method ++ " failed with status: " ++ showStatus status)
103+ left (displayHttpRequest reqMethod ++ " failed with status: " ++ showStatus status)
104 return $ (statusCode status, Client.responseBody response)
104 return $ (statusCode status, Client.responseBody response)
105 where
105 where
106 showStatus (Status code message) =
106 showStatus (Status code message) =
@@ -109,20 +109,20 @@ performRequest method req isWantedStatus host = do
109
109
110performRequestJSON :: FromJSON result =>
110performRequestJSON :: FromJSON result =>
111 Method -> Req -> Int -> BaseUrl -> EitherT String IO result
111 Method -> Req -> Int -> BaseUrl -> EitherT String IO result
112−performRequestJSON method req wantedStatus host = do
112+performRequestJSON reqMethod req wantedStatus reqHost = do
113− (_status, responseBody) <- performRequest method req (== wantedStatus) host
113+ (_status, respBody) <- performRequest reqMethod req (== wantedStatus) reqHost
114 either
114 either
115− (\ message -> left (displayHttpRequest method ++ " returned invalid json: " ++ message))
115+ (\ message -> left (displayHttpRequest reqMethod ++ " returned invalid json: " ++ message))
116 return
116 return
117− (decodeLenient responseBody)
117+ (decodeLenient respBody)
118
118
119
119
120catchStatusCodeException :: IO a -> IO (Either Status a)
120catchStatusCodeException :: IO a -> IO (Either Status a)
121−catchStatusCodeException action = catch (Right <$> action) $
121+catchStatusCodeException action =
122+ catch (Right <$> action) $ \e ->
122− \ e -> case e of
123+ case e of
123− Client.StatusCodeException status _ _ ->
124+ Client.StatusCodeException status _ _ -> return $ Left status
124− return $ Left status
125− e -> throwIO e
125+ exc -> throwIO exc
126
126
127-- | Like 'Data.Aeson.decode' but allows all JSON values instead of just
127-- | Like 'Data.Aeson.decode' but allows all JSON values instead of just
128-- objects and arrays.
128-- objects and arrays.
src/Servant/Utils/StaticFiles.hs+2−2
@@ -23,11 +23,11 @@ serveDocumentation proxy _request respond =
23 respond $ responseLBS ok200 [] $ cs $ toHtml $ markdown $ docs proxy
23 respond $ responseLBS ok200 [] $ cs $ toHtml $ markdown $ docs proxy
24
24
25toHtml :: String -> String
25toHtml :: String -> String
26−toHtml markdown =
26+toHtml md =
27 "<html>" ++
27 "<html>" ++
28 "<body>" ++
28 "<body>" ++
29 "<pre>" ++
29 "<pre>" ++
30− markdown ++
30+ md ++
31 "</pre>" ++
31 "</pre>" ++
32 "</body>" ++
32 "</body>" ++
33 "</html>"
33 "</html>"