Network/HTTP/Lucu/HttpVersion.hs

   1 {-# OPTIONS_HADDOCK prune #-}
   2
   3 -- |Manipulation of HTTP version string.
   4 module Network.HTTP.Lucu.HttpVersion
   5     ( HttpVersion(..)
   6     , httpVersionP
   7     , hPutHttpVersion
   8     )
   9     where
  10
  11 import qualified Data.ByteString.Char8 as C8
  12 import           Network.HTTP.Lucu.HandleLike
  13 import           Network.HTTP.Lucu.Parser
  14 import           Prelude hiding (min)
  15
  16 -- |@'HttpVersion' major minor@ represents \"HTTP\/major.minor\".
  17 data HttpVersion = HttpVersion !Int !Int
  18                    deriving (Eq)
  19
  20 instance Show HttpVersion where
  21     show (HttpVersion maj min) = "HTTP/" ++ show maj ++ "." ++ show min
  22
  23 instance Ord HttpVersion where
  24     (HttpVersion majA minA) `compare` (HttpVersion majB minB)
  25         | majA > majB = GT
  26         | majA < majB = LT
  27         | minA > minB = GT
  28         | minA < minB = LT
  29         | otherwise   = EQ
  30
  31
  32 httpVersionP :: Parser HttpVersion
  33 httpVersionP = string "HTTP/"
  34                >>
  35                -- 頻出するので高速化
  36                choice [ string "1.0" >> return (HttpVersion 1 0)
  37                       , string "1.1" >> return (HttpVersion 1 1)
  38                         -- 一般の場合
  39                       , do major <- many1 digit
  40                            _     <- char '.'
  41                            minor <- many1 digit
  42                            return $ HttpVersion (read major) (read minor)
  43                       ]
  44
  45
  46 hPutHttpVersion :: HandleLike h => h -> HttpVersion -> IO ()
  47 hPutHttpVersion !h !v
  48     = case v of
  49         -- 頻出するので高速化
  50         HttpVersion 1 0 -> hPutBS h (C8.pack "HTTP/1.0")
  51         HttpVersion 1 1 -> hPutBS h (C8.pack "HTTP/1.1")
  52         -- 一般の場合
  53         HttpVersion !maj !min
  54             -> do hPutBS   h (C8.pack "HTTP/")
  55                   hPutStr  h (show maj)
  56                   hPutChar h '.'
  57                   hPutStr  h (show min)