Network/HTTP/Lucu/HttpVersion.hs

   1 -- #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.Parser
  13 import           System.IO
  14
  15 -- |@'HttpVersion' major minor@ represents \"HTTP\/major.minor\".
  16 data HttpVersion = HttpVersion !Int !Int
  17                    deriving (Eq)
  18
  19 instance Show HttpVersion where
  20     show (HttpVersion maj min) = "HTTP/" ++ show maj ++ "." ++ show min
  21
  22 instance Ord HttpVersion where
  23     (HttpVersion majA minA) `compare` (HttpVersion majB minB)
  24         | majA > majB = GT
  25         | majA < majB = LT
  26         | minA > minB = GT
  27         | minA < minB = LT
  28         | otherwise   = EQ
  29
  30
  31 httpVersionP :: Parser HttpVersion
  32 httpVersionP = do string "HTTP/"
  33                   major <- many1 digit
  34                   char '.'
  35                   minor <- many1 digit
  36                   return $ HttpVersion (read' major) (read' minor)
  37     where
  38       read' "1" = 1 -- この二つが
  39       read' "0" = 0 -- 壓倒的に頻出する
  40       read' s   = read s
  41
  42
  43 hPutHttpVersion :: Handle -> HttpVersion -> IO ()
  44 hPutHttpVersion h (HttpVersion maj min)
  45     = h `seq`
  46       do C8.hPut  h (C8.pack "HTTP/")
  47          hPutStr  h (show maj)
  48          hPutChar h '.'
  49          hPutStr  h (show min)