+{-# OPTIONS_HADDOCK prune #-}
+
+-- |Manipulation of HTTP version string.
module Network.HTTP.Lucu.HttpVersion
( HttpVersion(..)
- , httpVersionP -- Parser HttpVersion
+ , httpVersionP
+ , hPutHttpVersion
)
where
-import qualified Data.ByteString.Lazy.Char8 as B
-import Data.ByteString.Lazy.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as C8
+import Network.HTTP.Lucu.HandleLike
import Network.HTTP.Lucu.Parser
+import Prelude hiding (min)
+
+-- |@'HttpVersion' major minor@ represents \"HTTP\/major.minor\".
+data HttpVersion = HttpVersion !Int !Int
+ deriving (Eq)
-data HttpVersion = HttpVersion Int Int
- deriving (Show, Eq)
+instance Show HttpVersion where
+ show (HttpVersion maj min) = "HTTP/" ++ show maj ++ "." ++ show min
instance Ord HttpVersion where
(HttpVersion majA minA) `compare` (HttpVersion majB minB)
httpVersionP :: Parser HttpVersion
-httpVersionP = do string "HTTP/"
- major <- many1 digit
- char '.'
- minor <- many1 digit
- return $ HttpVersion (read major) (read minor)
+httpVersionP = string "HTTP/"
+ >>
+ -- 頻出するので高速化
+ choice [ string "1.0" >> return (HttpVersion 1 0)
+ , string "1.1" >> return (HttpVersion 1 1)
+ -- 一般の場合
+ , do major <- many1 digit
+ _ <- char '.'
+ minor <- many1 digit
+ return $ HttpVersion (read major) (read minor)
+ ]
+
+hPutHttpVersion :: HandleLike h => h -> HttpVersion -> IO ()
+hPutHttpVersion !h !v
+ = case v of
+ -- 頻出するので高速化
+ HttpVersion 1 0 -> hPutBS h (C8.pack "HTTP/1.0")
+ HttpVersion 1 1 -> hPutBS h (C8.pack "HTTP/1.1")
+ -- 一般の場合
+ HttpVersion !maj !min
+ -> do hPutBS h (C8.pack "HTTP/")
+ hPutStr h (show maj)
+ hPutChar h '.'
+ hPutStr h (show min)