X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FRequest.hs;h=712a6107f2932f93d603e9e272013e65c2553578;hb=9ac730212cb361eb10e5fe4ad0eec6758e2b200a;hp=b316730d1112174b26e8aec564b20dd4c38c2ea0;hpb=8e78bc83bfe67a376293c346ae0b30f1a684c787;p=Lucu.git diff --git a/Network/HTTP/Lucu/Request.hs b/Network/HTTP/Lucu/Request.hs index b316730..712a610 100644 --- a/Network/HTTP/Lucu/Request.hs +++ b/Network/HTTP/Lucu/Request.hs @@ -1,4 +1,4 @@ --- #prune +{-# OPTIONS_HADDOCK prune #-} -- |Definition of things related on HTTP request. -- @@ -45,7 +45,7 @@ instance HasHeaders Request where requestP :: Parser Request -requestP = do many crlf +requestP = do _ <- many crlf (method, uri, version) <- requestLineP headers <- headersP return Request { @@ -58,32 +58,32 @@ requestP = do many crlf requestLineP :: Parser (Method, URI, HttpVersion) requestLineP = do method <- methodP - sp + _ <- sp uri <- uriP - sp + _ <- sp ver <- httpVersionP - crlf + _ <- crlf return (method, uri, ver) methodP :: Parser Method -methodP = (let methods = [ ("OPTIONS", OPTIONS) - , ("GET" , GET ) - , ("HEAD" , HEAD ) - , ("POST" , POST ) - , ("PUT" , PUT ) - , ("DELETE" , DELETE ) - , ("TRACE" , TRACE ) - , ("CONNECT", CONNECT) - ] - in foldl (<|>) (fail "") $ map (\ (str, mth) - -> string str >> return mth) methods) +methodP = ( let methods = [ ("OPTIONS", OPTIONS) + , ("GET" , GET ) + , ("HEAD" , HEAD ) + , ("POST" , POST ) + , ("PUT" , PUT ) + , ("DELETE" , DELETE ) + , ("TRACE" , TRACE ) + , ("CONNECT", CONNECT) + ] + in choice $ map (\ (str, mth) + -> string str >> return mth) methods ) <|> - token >>= return . ExtensionMethod + fmap ExtensionMethod token uriP :: Parser URI uriP = do str <- many1 $ satisfy (\ c -> not (isCtl c || c == ' ')) case parseURIReference str of - Nothing -> fail "" + Nothing -> failP Just uri -> return uri \ No newline at end of file