X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHttpVersion.hs;h=9ad1c0a07ccd964d9cdcee554ff604a5c558856d;hb=6126eb9;hp=ca25640a768c31e9f98dee79f29cee615dd72a0e;hpb=9ac730212cb361eb10e5fe4ad0eec6758e2b200a;p=Lucu.git diff --git a/Network/HTTP/Lucu/HttpVersion.hs b/Network/HTTP/Lucu/HttpVersion.hs index ca25640..9ad1c0a 100644 --- a/Network/HTTP/Lucu/HttpVersion.hs +++ b/Network/HTTP/Lucu/HttpVersion.hs @@ -1,24 +1,27 @@ -{-# OPTIONS_HADDOCK prune #-} - +{-# LANGUAGE + OverloadedStrings + , UnicodeSyntax + #-} -- |Manipulation of HTTP version string. module Network.HTTP.Lucu.HttpVersion ( HttpVersion(..) , httpVersionP - , hPutHttpVersion + , printHttpVersion ) where - -import qualified Data.ByteString.Char8 as C8 -import Network.HTTP.Lucu.HandleLike -import Network.HTTP.Lucu.Parser -import Prelude hiding (min) +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) @@ -28,30 +31,24 @@ instance Ord HttpVersion where | minA < minB = LT | otherwise = EQ - -httpVersionP :: Parser HttpVersion +httpVersionP ∷ Parser HttpVersion 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) + *> + choice [ string "1.1" *> pure (HttpVersion 1 1) + , string "1.0" *> pure (HttpVersion 1 0) + , HttpVersion <$> decimal ⊛ (char '.' *> decimal) ] - -hPutHttpVersion :: HandleLike h => h -> HttpVersion -> IO () -hPutHttpVersion !h !v +-- |Convert an 'HttpVersion' to 'AsciiBuilder'. +printHttpVersion ∷ HttpVersion → AsciiBuilder +printHttpVersion 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 1 0 → A.toAsciiBuilder "HTTP/1.0" + HttpVersion 1 1 → A.toAsciiBuilder "HTTP/1.1" -- 一般の場合 - HttpVersion !maj !min - -> do hPutBS h (C8.pack "HTTP/") - hPutStr h (show maj) - hPutChar h '.' - hPutStr h (show min) + HttpVersion maj min + → A.toAsciiBuilder "HTTP/" ⊕ + A.unsafeFromBuilder (BT.integral maj) ⊕ + A.toAsciiBuilder "." ⊕ + A.unsafeFromBuilder (BT.integral min)