X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHttpVersion.hs;h=a5db1e29193a10aaeec1b4c67ca57092f906a477;hb=3fe5ca3bca04e0124a5f2440e893dc5375e0bb51;hp=e1ed0f38024fd9836629c84eee5d9bef20fd46cc;hpb=8e78bc83bfe67a376293c346ae0b30f1a684c787;p=Lucu.git diff --git a/Network/HTTP/Lucu/HttpVersion.hs b/Network/HTTP/Lucu/HttpVersion.hs index e1ed0f3..a5db1e2 100644 --- a/Network/HTTP/Lucu/HttpVersion.hs +++ b/Network/HTTP/Lucu/HttpVersion.hs @@ -1,22 +1,29 @@ --- #prune +{-# LANGUAGE + BangPatterns + , OverloadedStrings + , UnicodeSyntax + #-} -- |Manipulation of HTTP version string. module Network.HTTP.Lucu.HttpVersion ( HttpVersion(..) , httpVersionP - , hPutHttpVersion + , printHttpVersion ) where - -import Network.HTTP.Lucu.Parser -import System.IO +import qualified Blaze.Text.Int as BT +import Control.Applicative +import Control.Applicative.Unicode +import Data.Ascii (AsciiBuilder) +import qualified Data.Ascii as A +import Data.Attoparsec.Char8 +import Data.Monoid.Unicode +import Prelude hiding (min) -- |@'HttpVersion' major minor@ represents \"HTTP\/major.minor\". -data HttpVersion = HttpVersion !Int !Int - deriving (Eq) - -instance Show HttpVersion where - show (HttpVersion maj min) = "HTTP/" ++ show maj ++ "." ++ show min +data HttpVersion + = HttpVersion !Int !Int + deriving (Eq, Show) instance Ord HttpVersion where (HttpVersion majA minA) `compare` (HttpVersion majB minB) @@ -26,19 +33,24 @@ instance Ord HttpVersion where | minA < minB = LT | otherwise = EQ - -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 ∷ Parser HttpVersion +httpVersionP = string "HTTP/" + *> + choice [ string "1.1" *> pure (HttpVersion 1 1) + , string "1.0" *> pure (HttpVersion 1 0) + , HttpVersion <$> decimal ⊛ (char '.' *> decimal) + ] + +-- |Convert an 'HttpVersion' to 'AsciiBuilder'. +printHttpVersion ∷ HttpVersion → AsciiBuilder +printHttpVersion v + = case v of + -- 頻出するので高速化 + HttpVersion 1 0 → A.toAsciiBuilder "HTTP/1.0" + HttpVersion 1 1 → A.toAsciiBuilder "HTTP/1.1" + -- 一般の場合 + HttpVersion maj min + → A.toAsciiBuilder "HTTP/" ⊕ + A.unsafeFromBuilder (BT.integral maj) ⊕ + A.toAsciiBuilder "." ⊕ + A.unsafeFromBuilder (BT.integral min)