X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FRequest.hs;h=13ccf9c9420b8265fa244934ed2d98cebc1a497f;hp=58286dbe6130733fcdc4b19057a061410df43a29;hb=90fca0675b1694e69b8e431c989343855cbd125d;hpb=3eb69879d3b336c7c3e613c0ce4bfb3c67989ff3 diff --git a/Network/HTTP/Lucu/Request.hs b/Network/HTTP/Lucu/Request.hs index 58286db..13ccf9c 100644 --- a/Network/HTTP/Lucu/Request.hs +++ b/Network/HTTP/Lucu/Request.hs @@ -1,5 +1,8 @@ {-# LANGUAGE - OverloadedStrings + FlexibleInstances + , MultiParamTypeClasses + , OverloadedStrings + , TypeSynonymInstances , UnicodeSyntax , ViewPatterns #-} @@ -9,8 +12,7 @@ module Network.HTTP.Lucu.Request ( Method(..) , Request(..) - , reqMustHaveBody - , request + , reqHasBody ) where import Control.Applicative @@ -18,6 +20,7 @@ import Control.Monad.Unicode import Data.Ascii (Ascii) import Data.Attoparsec.Char8 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 @@ -53,19 +56,19 @@ 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 --- |'Parser' for a 'Request'. -request ∷ Parser Request -request = do skipMany crlf +instance Default (Parser Request) where + {-# INLINEABLE def #-} + def = do skipMany crlf (meth, u, ver) ← requestLine - hdrs ← headers + hdrs ← def return Request { reqMethod = meth , reqURI = u @@ -74,15 +77,17 @@ request = do skipMany crlf } requestLine ∷ Parser (Method, URI, HttpVersion) +{-# INLINEABLE requestLine #-} requestLine = do meth ← method sp u ← uri sp - ver ← httpVersion + ver ← def crlf return (meth, u, ver) method ∷ Parser Method +{-# INLINEABLE method #-} method = choice [ string "OPTIONS" ≫ return OPTIONS , string "GET" ≫ return GET @@ -96,6 +101,7 @@ method = choice ] uri ∷ Parser URI +{-# INLINEABLE uri #-} uri = do bs ← takeWhile1 (\c → (¬) (isCtl c ∨ c ≡ '\x20')) let str = C8.unpack bs case parseURIReference str of