From d461726b9a02fa8a1c15b60a1449b1cb18b8fe92 Mon Sep 17 00:00:00 2001 From: Alp Mestanogullari Date: Sat, 22 Nov 2014 14:35:03 +0100 Subject: [PATCH] -Wall police --- src/Servant/API/QueryParam.hs | 2 +- src/Servant/API/Raw.hs | 4 ++-- src/Servant/Common/BaseUrl.hs | 12 +++++----- src/Servant/Common/Req.hs | 38 ++++++++++++++++---------------- src/Servant/Utils/StaticFiles.hs | 4 ++-- 5 files changed, 30 insertions(+), 30 deletions(-) diff --git a/src/Servant/API/QueryParam.hs b/src/Servant/API/QueryParam.hs index 965cd489..540c53a4 100644 --- a/src/Servant/API/QueryParam.hs +++ b/src/Servant/API/QueryParam.hs @@ -106,7 +106,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout) clientWithRoute Proxy req paramlist = clientWithRoute (Proxy :: Proxy sublayout) $ - foldl' (\ value req -> appendToQueryString pname req value) req paramlist' + foldl' (\ value req' -> appendToQueryString pname req' value) req paramlist' where pname = cs pname' pname' = symbolVal (Proxy :: Proxy sym) diff --git a/src/Servant/API/Raw.hs b/src/Servant/API/Raw.hs index 340fe3e2..f2f9b64f 100644 --- a/src/Servant/API/Raw.hs +++ b/src/Servant/API/Raw.hs @@ -29,8 +29,8 @@ instance HasClient Raw where type Client Raw = Method -> BaseUrl -> EitherT String IO (Int, ByteString) clientWithRoute :: Proxy Raw -> Req -> Client Raw - clientWithRoute Proxy req method host = - performRequest method req (const True) host + clientWithRoute Proxy req httpMethod host = + performRequest httpMethod req (const True) host instance HasDocs Raw where diff --git a/src/Servant/Common/BaseUrl.hs b/src/Servant/Common/BaseUrl.hs index 8740303c..15ef6dac 100644 --- a/src/Servant/Common/BaseUrl.hs +++ b/src/Servant/Common/BaseUrl.hs @@ -19,13 +19,13 @@ data BaseUrl = BaseUrl { deriving (Show, Eq, Ord, Generic) showBaseUrl :: BaseUrl -> String -showBaseUrl (BaseUrl scheme host port) = +showBaseUrl (BaseUrl urlscheme host port) = schemeString ++ "//" ++ host ++ portString where - schemeString = case scheme of + schemeString = case urlscheme of Http -> "http:" Https -> "https:" - portString = case (scheme, port) of + portString = case (urlscheme, port) of (Http, 80) -> "" (Https, 443) -> "" _ -> ":" ++ show port @@ -46,6 +46,6 @@ parseBaseUrl s = case parseURI (removeTrailingSlash s) of then Left ("invalid base url: " ++ s) else parseBaseUrl ("http://" ++ s) where - removeTrailingSlash s = case lastMay s of - Just '/' -> init s - _ -> s + removeTrailingSlash str = case lastMay str of + Just '/' -> init str + _ -> str diff --git a/src/Servant/Common/Req.hs b/src/Servant/Common/Req.hs index ecf851a6..62c469d8 100644 --- a/src/Servant/Common/Req.hs +++ b/src/Servant/Common/Req.hs @@ -49,15 +49,15 @@ setRQBody :: ByteString -> Req -> Req setRQBody b req = req { reqBody = b } reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request -reqToRequest req (BaseUrl scheme host port) = fmap (setrqb . setQS ) $ parseUrl url +reqToRequest req (BaseUrl reqScheme reqHost reqPort) = fmap (setrqb . setQS ) $ parseUrl url - where url = show $ nullURI { uriScheme = case scheme of + where url = show $ nullURI { uriScheme = case reqScheme of Http -> "http:" Https -> "https:" , uriAuthority = Just $ URIAuth { uriUserInfo = "" - , uriRegName = host - , uriPort = ":" ++ show port + , uriRegName = reqHost + , uriPort = ":" ++ show reqPort } , uriPath = reqPath req } @@ -79,14 +79,14 @@ __withGlobalManager action = modifyMVar __manager $ \ manager -> do displayHttpRequest :: Method -> String -displayHttpRequest method = "HTTP " ++ cs method ++ " request" +displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request" performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT String IO (Int, ByteString) -performRequest method req isWantedStatus host = do - partialRequest <- liftIO $ reqToRequest req host +performRequest reqMethod req isWantedStatus reqHost = do + partialRequest <- liftIO $ reqToRequest req reqHost - let request = partialRequest { Client.method = method + let request = partialRequest { Client.method = reqMethod , checkStatus = \ _status _headers _cookies -> Nothing } @@ -95,12 +95,12 @@ performRequest method req isWantedStatus host = do Client.httpLbs request manager case eResponse of Left status -> - left (displayHttpRequest method ++ " failed with status: " ++ showStatus status) + left (displayHttpRequest reqMethod ++ " failed with status: " ++ showStatus status) Right response -> do let status = Client.responseStatus response unless (isWantedStatus (statusCode status)) $ - left (displayHttpRequest method ++ " failed with status: " ++ showStatus status) + left (displayHttpRequest reqMethod ++ " failed with status: " ++ showStatus status) return $ (statusCode status, Client.responseBody response) where showStatus (Status code message) = @@ -109,20 +109,20 @@ performRequest method req isWantedStatus host = do performRequestJSON :: FromJSON result => Method -> Req -> Int -> BaseUrl -> EitherT String IO result -performRequestJSON method req wantedStatus host = do - (_status, responseBody) <- performRequest method req (== wantedStatus) host +performRequestJSON reqMethod req wantedStatus reqHost = do + (_status, respBody) <- performRequest reqMethod req (== wantedStatus) reqHost either - (\ message -> left (displayHttpRequest method ++ " returned invalid json: " ++ message)) + (\ message -> left (displayHttpRequest reqMethod ++ " returned invalid json: " ++ message)) return - (decodeLenient responseBody) + (decodeLenient respBody) catchStatusCodeException :: IO a -> IO (Either Status a) -catchStatusCodeException action = catch (Right <$> action) $ - \ e -> case e of - Client.StatusCodeException status _ _ -> - return $ Left status - e -> throwIO e +catchStatusCodeException action = + catch (Right <$> action) $ \e -> + case e of + Client.StatusCodeException status _ _ -> return $ Left status + exc -> throwIO exc -- | Like 'Data.Aeson.decode' but allows all JSON values instead of just -- objects and arrays. diff --git a/src/Servant/Utils/StaticFiles.hs b/src/Servant/Utils/StaticFiles.hs index 6399115b..4c46ba7d 100644 --- a/src/Servant/Utils/StaticFiles.hs +++ b/src/Servant/Utils/StaticFiles.hs @@ -23,11 +23,11 @@ serveDocumentation proxy _request respond = respond $ responseLBS ok200 [] $ cs $ toHtml $ markdown $ docs proxy toHtml :: String -> String -toHtml markdown = +toHtml md = "" ++ "" ++ "
" ++
-  markdown ++
+  md ++
   "
" ++ "" ++ ""