X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FRequest.hs;h=ea855ba30cffc108ac7764766196b63a03ff8ce0;hb=243b99439640480fc148d2e175247dacce04a222;hp=2fcfc9123e3c8e07f343ba3d9211556d4a4c2ed7;hpb=1de2506621977a383b991cadce024f626023908b;p=Lucu.git

diff --git a/Network/HTTP/Lucu/Request.hs b/Network/HTTP/Lucu/Request.hs
index 2fcfc91..ea855ba 100644
--- a/Network/HTTP/Lucu/Request.hs
+++ b/Network/HTTP/Lucu/Request.hs
@@ -1,33 +1,31 @@
 {-# LANGUAGE
-    MultiParamTypeClasses
+    FlexibleInstances
+  , MultiParamTypeClasses
   , OverloadedStrings
+  , TypeSynonymInstances
   , UnicodeSyntax
   , ViewPatterns
   #-}
--- |Definition of things related on HTTP request.
---
--- In general you don't have to use this module directly.
+-- |Definition of HTTP requests.
 module Network.HTTP.Lucu.Request
     ( Method(..)
     , Request(..)
-    , reqMustHaveBody
+    , reqHasBody
     )
     where
 import Control.Applicative
 import Control.Monad.Unicode
 import Data.Ascii (Ascii)
 import Data.Attoparsec.Char8
-import Data.Attoparsec.Parsable
-import Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as C8
+import Data.Default
 import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.HttpVersion
 import Network.HTTP.Lucu.Parser.Http
 import Network.URI
 import Prelude.Unicode
 
--- |This is the definition of HTTP request methods, which shouldn't
--- require any descriptions.
+-- |Definition of HTTP request methods.
 data Method = OPTIONS
             | GET
             | HEAD
@@ -39,7 +37,7 @@ data Method = OPTIONS
             | ExtensionMethod !Ascii
               deriving (Eq, Show)
 
--- |This is the definition of an HTTP reqest.
+-- |Definition of HTTP requests.
 data Request
     = Request {
         reqMethod  ∷ !Method
@@ -55,50 +53,50 @@ instance HasHeaders Request where
     {-# 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)
+-- |Returns 'True' iff the 'Request' would have an entity body.
+reqHasBody ∷ Request → Bool
+{-# INLINEABLE reqHasBody #-}
+reqHasBody (reqMethod → m)
     | m ≡ POST  = True
     | m ≡ PUT   = True
     | otherwise = False
 
-instance Parsable ByteString Request where
-    {-# INLINEABLE parser #-}
-    parser = do skipMany crlf
-                (meth, u, ver) ← requestLine
-                hdrs           ← parser
-                return Request {
-                             reqMethod  = meth
-                           , reqURI     = u
-                           , reqVersion = ver
-                           , reqHeaders = hdrs
-                           }
+instance Default (Parser Method) where
+    {-# INLINEABLE def #-}
+    def = 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
+          ]
+
+instance Default (Parser Request) where
+    {-# INLINEABLE def #-}
+    def = do skipMany crlf
+             (meth, u, ver) ← requestLine
+             hdrs           ← def
+             return Request {
+                          reqMethod  = meth
+                        , reqURI     = u
+                        , reqVersion = ver
+                        , reqHeaders = hdrs
+                        }
 
 requestLine ∷ Parser (Method, URI, HttpVersion)
 {-# INLINEABLE requestLine #-}
-requestLine = do meth ← method
+requestLine = do meth ← def
                  sp
                  u ← uri
                  sp
-                 ver ← parser
+                 ver ← def
                  crlf
                  return (meth, u, ver)
 
-method ∷ Parser Method
-{-# INLINEABLE 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
-         ]
-
 uri ∷ Parser URI
 {-# INLINEABLE uri #-}
 uri = do bs ← takeWhile1 (\c → (¬) (isCtl c ∨ c ≡ '\x20'))