X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHttpVersion.hs;h=d48f6ec8c58f3d5009c3038ed500eb4e863e5003;hb=70bf5bd248aa426ca4e410b3fb9a0529354aedaf;hp=15ead365cdf6403a2e53eece4dbc117a1c8dcfef;hpb=858129cb755aa09da2b7bd758efb8519f2c89103;p=Lucu.git diff --git a/Network/HTTP/Lucu/HttpVersion.hs b/Network/HTTP/Lucu/HttpVersion.hs index 15ead36..d48f6ec 100644 --- a/Network/HTTP/Lucu/HttpVersion.hs +++ b/Network/HTTP/Lucu/HttpVersion.hs @@ -1,4 +1,8 @@ --- #prune +{-# LANGUAGE + BangPatterns + , UnicodeSyntax + #-} +{-# OPTIONS_HADDOCK prune #-} -- |Manipulation of HTTP version string. module Network.HTTP.Lucu.HttpVersion @@ -8,10 +12,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 +34,28 @@ 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 [ 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)