Merge branch 'parsable'

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

diff --git a/Network/HTTP/Lucu/Request.hs b/Network/HTTP/Lucu/Request.hs
index 58286dbe6130733fcdc4b19057a061410df43a29..2fcfc9123e3c8e07f343ba3d9211556d4a4c2ed7 100644 (file)
--- a/Network/HTTP/Lucu/Request.hs
+++ b/Network/HTTP/Lucu/Request.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE
 {-# LANGUAGE

-    OverloadedStrings
+    MultiParamTypeClasses
+  , OverloadedStrings

   , UnicodeSyntax
   , ViewPatterns
   #-}
   , UnicodeSyntax
   , ViewPatterns
   #-}


@@ -10,13 +11,14 @@ module Network.HTTP.Lucu.Request
     ( Method(..)
     , Request(..)
     , reqMustHaveBody
     ( Method(..)
     , Request(..)
     , reqMustHaveBody

-    , request

     )
     where
 import Control.Applicative
 import Control.Monad.Unicode
 import Data.Ascii (Ascii)
 import Data.Attoparsec.Char8
     )
     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 Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.HttpVersion
 import qualified Data.ByteString.Char8 as C8
 import Network.HTTP.Lucu.Headers
 import Network.HTTP.Lucu.HttpVersion


@@ -61,28 +63,30 @@ reqMustHaveBody (reqMethod → m)
     | m ≡ PUT   = True
     | otherwise = False
 
     | m ≡ PUT   = True
     | otherwise = False
 

--- |'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
-                        }
+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
+                           }

 
 requestLine ∷ Parser (Method, URI, HttpVersion)
 
 requestLine ∷ Parser (Method, URI, HttpVersion)

+{-# INLINEABLE requestLine #-}

 requestLine = do meth ← method
                  sp
                  u ← uri
                  sp
 requestLine = do meth ← method
                  sp
                  u ← uri
                  sp

-                 ver ← httpVersion
+                 ver ← parser

                  crlf
                  return (meth, u, ver)
 
 method ∷ Parser Method
                  crlf
                  return (meth, u, ver)
 
 method ∷ Parser Method

+{-# INLINEABLE method #-}

 method = choice
          [ string "OPTIONS" ≫ return OPTIONS
          , string "GET"     ≫ return GET
 method = choice
          [ string "OPTIONS" ≫ return OPTIONS
          , string "GET"     ≫ return GET


@@ -96,6 +100,7 @@ method = choice
          ]
 
 uri ∷ Parser URI
          ]
 
 uri ∷ Parser URI

+{-# INLINEABLE uri #-}

 uri = do bs ← takeWhile1 (\c → (¬) (isCtl c ∨ c ≡ '\x20'))
          let str = C8.unpack bs
          case parseURIReference str of
 uri = do bs ← takeWhile1 (\c → (¬) (isCtl c ∨ c ≡ '\x20'))
          let str = C8.unpack bs
          case parseURIReference str of