Haddock overhaul

[Lucu.git] / Network / HTTP / Lucu / Request.hs

diff --git a/Network/HTTP/Lucu/Request.hs b/Network/HTTP/Lucu/Request.hs
index b690c3e612435844eef847ff8feffbec1b39407e..853907a479c851c48896705e2b42a2a720c78f83 100644 (file)
--- a/Network/HTTP/Lucu/Request.hs
+++ b/Network/HTTP/Lucu/Request.hs
@@ -1,15 +1,15 @@
 {-# LANGUAGE
     OverloadedStrings
   , UnicodeSyntax
+  , ViewPatterns
   #-}
-{-# OPTIONS_HADDOCK prune #-}
-
 -- |Definition of things related on HTTP request.
 --
 -- In general you don't have to use this module directly.
 module Network.HTTP.Lucu.Request
     ( Method(..)
     , Request(..)
+    , reqMustHaveBody
     , requestP
     )
     where
@@ -25,7 +25,7 @@ import Network.URI
 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
@@ -37,7 +37,7 @@ data Method = OPTIONS
             | 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
@@ -48,9 +48,20 @@ data Request
     deriving (Eq, Show)
 
 instance HasHeaders Request where
+    {-# INLINE getHeaders #-}
     getHeaders = reqHeaders
+    {-# INLINE setHeaders #-}
     setHeaders req hdr = req { reqHeaders = hdr }
 
+-- |Returns 'True' iff the 'Request' must have an entity body.
+reqMustHaveBody ∷ Request → Bool
+{-# INLINEABLE reqMustHaveBody #-}
+reqMustHaveBody (reqMethod → m)
+    | m ≡ POST  = True
+    | m ≡ PUT   = True
+    | otherwise = False
+
+-- |'Parser' for a 'Request'.
 requestP ∷ Parser Request
 requestP = do skipMany crlf
               (method, uri, version) ← requestLineP