X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHttpVersion.hs;h=0f83bab46962919b2e7f5c183648813fd62ebdf5;hb=73b5fba4907604681d778d3bd54cd65fd84b4454;hp=15ead365cdf6403a2e53eece4dbc117a1c8dcfef;hpb=858129cb755aa09da2b7bd758efb8519f2c89103;p=Lucu.git diff --git a/Network/HTTP/Lucu/HttpVersion.hs b/Network/HTTP/Lucu/HttpVersion.hs index 15ead36..0f83bab 100644 --- a/Network/HTTP/Lucu/HttpVersion.hs +++ b/Network/HTTP/Lucu/HttpVersion.hs @@ -1,4 +1,4 @@ --- #prune +{-# OPTIONS_HADDOCK prune #-} -- |Manipulation of HTTP version string. module Network.HTTP.Lucu.HttpVersion @@ -8,10 +8,10 @@ module Network.HTTP.Lucu.HttpVersion ) 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 System.IO +import Prelude hiding (min) -- |@'HttpVersion' major minor@ represents \"HTTP\/major.minor\". data HttpVersion = HttpVersion !Int !Int @@ -30,17 +30,30 @@ instance Ord HttpVersion where httpVersionP :: Parser HttpVersion -httpVersionP = do string "HTTP/" - major <- many1 digit - char '.' - minor <- many1 digit - return $ HttpVersion (read major) (read minor) - - -hPutHttpVersion :: Handle -> HttpVersion -> IO () -hPutHttpVersion h (HttpVersion maj min) - = h `seq` - do hPutStr h "HTTP/" - hPutStr h (show maj) - hPutChar h '.' - hPutStr h (show min) \ No newline at end of file +httpVersionP = string "HTTP/" + >> + -- 頻出するので高速化 + choice [ do string "1.0" + return $ HttpVersion 1 0 + , do 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)