{-# LANGUAGE
    BangPatterns
  , OverloadedStrings
  , UnicodeSyntax
  #-}
{-# OPTIONS_HADDOCK prune #-}

-- |Manipulation of HTTP version string.
module Network.HTTP.Lucu.HttpVersion
    ( HttpVersion(..)
    , httpVersionP
    , hPutHttpVersion
    )
    where
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, Show)

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.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 !h !v
    = case v of
        -- 頻出するので高速化
        HttpVersion 1 0 → hPutBS h "HTTP/1.0"
        HttpVersion 1 1 → hPutBS h "HTTP/1.1"
        -- 一般の場合
        HttpVersion !maj !min
            → do hPutBS   h "HTTP/"
                 hPutStr  h (show maj)
                 hPutChar h '.'
                 hPutStr  h (show min)