X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHttpVersion.hs;h=4531c837782ef9b6eda9edd4849e3771f2b0b0a1;hp=d48f6ec8c58f3d5009c3038ed500eb4e863e5003;hb=9bb89434103e9a22f100d6ecb7e65a5d461e0454;hpb=86d100e294fa482456980021cca10393b9830ec1 diff --git a/Network/HTTP/Lucu/HttpVersion.hs b/Network/HTTP/Lucu/HttpVersion.hs index d48f6ec..4531c83 100644 --- a/Network/HTTP/Lucu/HttpVersion.hs +++ b/Network/HTTP/Lucu/HttpVersion.hs @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns + , OverloadedStrings , UnicodeSyntax #-} {-# OPTIONS_HADDOCK prune #-} @@ -11,18 +12,15 @@ module Network.HTTP.Lucu.HttpVersion , hPutHttpVersion ) where - -import qualified Data.ByteString.Char8 as C8 -import Network.HTTP.Lucu.HandleLike -import Network.HTTP.Lucu.Parser -import Prelude hiding (min) +import Control.Monad.Unicode +import Data.Attoparsec.Char8 +import Network.HTTP.Lucu.HandleLike +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) @@ -32,30 +30,26 @@ 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" ≫ return (HttpVersion 1 1) + , string "1.0" ≫ return (HttpVersion 1 0) + , do major ← decimal + _ ← char '.' + minor ← decimal + return $ HttpVersion major minor ] - -hPutHttpVersion :: HandleLike h => h -> HttpVersion -> IO () +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 1 0 → hPutBS h "HTTP/1.0" + HttpVersion 1 1 → hPutBS h "HTTP/1.1" -- 一般の場合 HttpVersion !maj !min - -> do hPutBS h (C8.pack "HTTP/") - hPutStr h (show maj) - hPutChar h '.' - hPutStr h (show min) + → do hPutBS h "HTTP/" + hPutStr h (show maj) + hPutChar h '.' + hPutStr h (show min)