-{-# OPTIONS_HADDOCK prune #-}
-
--- |Manipulation of HTTP version string.
+{-# LANGUAGE
+ FlexibleInstances
+ , MultiParamTypeClasses
+ , OverloadedStrings
+ , TemplateHaskell
+ , UnicodeSyntax
+ #-}
+-- |An internal module for HTTP version numbers.
module Network.HTTP.Lucu.HttpVersion
( HttpVersion(..)
- , httpVersionP
- , hPutHttpVersion
)
where
+import Control.Applicative
+import Control.Applicative.Unicode
+import Data.Ascii (Ascii, AsciiBuilder)
+import Data.Attoparsec.Char8
+import Data.Attoparsec.Parsable
+import Data.ByteString (ByteString)
+import Data.Convertible.Base
+import Data.Convertible.Instances.Ascii ()
+import Data.Convertible.Utils
+import Data.Monoid.Unicode
+import Prelude hiding (min)
+import Prelude.Unicode
-import qualified Data.ByteString.Char8 as C8
-import Network.HTTP.Lucu.HandleLike
-import Network.HTTP.Lucu.Parser
-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
+-- |An HTTP version consists of major and minor versions.
+data HttpVersion
+ = HttpVersion !Int !Int
+ deriving (Eq, Show)
instance Ord HttpVersion where
(HttpVersion majA minA) `compare` (HttpVersion majB minB)
| minA < minB = LT
| otherwise = EQ
+instance ConvertSuccess HttpVersion Ascii where
+ {-# INLINE convertSuccess #-}
+ convertSuccess = convertSuccessVia ((⊥) ∷ AsciiBuilder)
-httpVersionP :: Parser HttpVersion
-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)
- ]
+instance ConvertSuccess HttpVersion AsciiBuilder where
+ {-# INLINE convertSuccess #-}
+ convertSuccess v
+ = case v of
+ -- Optimisation for special cases.
+ HttpVersion 1 0 → cs ("HTTP/1.0" ∷ Ascii)
+ HttpVersion 1 1 → cs ("HTTP/1.1" ∷ Ascii)
+ -- General (but almost never occuring) cases.
+ HttpVersion maj min
+ → cs ("HTTP/" ∷ Ascii) ⊕
+ convertUnsafe (show maj) ⊕
+ cs ("." ∷ Ascii) ⊕
+ convertUnsafe (show min)
+deriveAttempts [ ([t| HttpVersion |], [t| Ascii |])
+ , ([t| HttpVersion |], [t| AsciiBuilder |])
+ ]
-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)
+instance Parsable ByteString HttpVersion where
+ {-# INLINEABLE parser #-}
+ parser = string "HTTP/"
+ *>
+ (HttpVersion <$> decimal ⊛ (char '.' *> decimal))