Destroy Data.Attoparsec.Parsable; use Data.Default instead

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

diff --git a/Network/HTTP/Lucu/Request.hs b/Network/HTTP/Lucu/Request.hs
index 58286dbe6130733fcdc4b19057a061410df43a29..13ccf9c9420b8265fa244934ed2d98cebc1a497f 100644 (file)
--- 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