( Method(..)
, Request(..)
, reqMustHaveBody
- , requestP
+ , request
)
where
import Control.Applicative
import Prelude.Unicode
-- |This is the definition of HTTP request methods, which shouldn't
--- require any description.
+-- require any descriptions.
data Method = OPTIONS
| GET
| HEAD
| ExtensionMethod !Ascii
deriving (Eq, Show)
--- |This is the definition of HTTP reqest.
+-- |This is the definition of an HTTP reqest.
data Request
= Request {
reqMethod ∷ !Method
| m ≡ PUT = True
| otherwise = False
-requestP ∷ Parser Request
-requestP = do skipMany crlf
- (method, uri, version) ← requestLineP
- headers ← headersP
- return Request {
- reqMethod = method
- , reqURI = uri
- , reqVersion = version
- , reqHeaders = headers
- }
+-- |'Parser' for a 'Request'.
+request ∷ Parser Request
+request = do skipMany crlf
+ (meth, u, ver) ← requestLine
+ hdrs ← headers
+ return Request {
+ reqMethod = meth
+ , reqURI = u
+ , reqVersion = ver
+ , reqHeaders = hdrs
+ }
-requestLineP ∷ Parser (Method, URI, HttpVersion)
-requestLineP = do method ← methodP
- sp
- uri ← uriP
- sp
- ver ← httpVersionP
- crlf
- return (method, uri, ver)
+requestLine ∷ Parser (Method, URI, HttpVersion)
+requestLine = do meth ← method
+ sp
+ u ← uri
+ sp
+ ver ← httpVersion
+ crlf
+ return (meth, u, ver)
-methodP ∷ Parser Method
-methodP = choice
- [ string "OPTIONS" ≫ return OPTIONS
- , string "GET" ≫ return GET
- , string "HEAD" ≫ return HEAD
- , string "POST" ≫ return POST
- , string "PUT" ≫ return PUT
- , string "DELETE" ≫ return DELETE
- , string "TRACE" ≫ return TRACE
- , string "CONNECT" ≫ return CONNECT
- , ExtensionMethod <$> token
- ]
+method ∷ Parser Method
+method = choice
+ [ string "OPTIONS" ≫ return OPTIONS
+ , string "GET" ≫ return GET
+ , string "HEAD" ≫ return HEAD
+ , string "POST" ≫ return POST
+ , string "PUT" ≫ return PUT
+ , string "DELETE" ≫ return DELETE
+ , string "TRACE" ≫ return TRACE
+ , string "CONNECT" ≫ return CONNECT
+ , ExtensionMethod <$> token
+ ]
-uriP ∷ Parser URI
-uriP = do bs ← takeWhile1 (\c → (¬) (isCtl c ∨ c ≡ '\x20'))
- let str = C8.unpack bs
- case parseURIReference str of
- Nothing -> fail ("Unparsable URI: " ⧺ str)
- Just uri -> return uri
+uri ∷ Parser URI
+uri = do bs ← takeWhile1 (\c → (¬) (isCtl c ∨ c ≡ '\x20'))
+ let str = C8.unpack bs
+ case parseURIReference str of
+ Nothing → fail ("Unparsable URI: " ⧺ str)
+ Just u → return u