{-# OPTIONS_HADDOCK prune #-}

-- |Manipulation of HTTP version string.
module Network.HTTP.Lucu.HttpVersion
    ( HttpVersion(..)
    , httpVersionP
    , hPutHttpVersion
    )
    where

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

instance Ord HttpVersion where
    (HttpVersion majA minA) `compare` (HttpVersion majB minB)
        | majA > majB = GT
        | majA < majB = LT
        | minA > minB = GT
        | minA < minB = LT
        | otherwise   = EQ


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)
                      ]


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)