Network/HTTP/Lucu/HttpVersion.hs

   1 {-# LANGUAGE
   2     OverloadedStrings
   3   , UnicodeSyntax
   4   #-}
   5 -- |An internal module for HTTP version numbers.
   6 module Network.HTTP.Lucu.HttpVersion
   7     ( HttpVersion(..)
   8     , printHttpVersion
   9     , httpVersion
  10     )
  11     where
  12 import Control.Applicative
  13 import Control.Applicative.Unicode
  14 import Data.Ascii (AsciiBuilder)
  15 import qualified Data.Ascii as A
  16 import Data.Attoparsec.Char8
  17 import Data.Monoid.Unicode
  18 import Prelude hiding (min)
  19
  20 -- |An HTTP version consists of major and minor versions.
  21 data HttpVersion
  22     = HttpVersion !Int !Int
  23       deriving (Eq, Show)
  24
  25 instance Ord HttpVersion where
  26     (HttpVersion majA minA) `compare` (HttpVersion majB minB)
  27         | majA > majB = GT
  28         | majA < majB = LT
  29         | minA > minB = GT
  30         | minA < minB = LT
  31         | otherwise   = EQ
  32
  33 -- |Convert an 'HttpVersion' to 'AsciiBuilder'.
  34 printHttpVersion ∷ HttpVersion → AsciiBuilder
  35 printHttpVersion v
  36     = case v of
  37         -- Optimisation for special cases.
  38         HttpVersion 1 0 → A.toAsciiBuilder "HTTP/1.0"
  39         HttpVersion 1 1 → A.toAsciiBuilder "HTTP/1.1"
  40         -- General (but almost never stumbling) cases.
  41         HttpVersion maj min
  42             → A.toAsciiBuilder "HTTP/" ⊕
  43               A.toAsciiBuilder (A.unsafeFromString $ show maj) ⊕
  44               A.toAsciiBuilder "." ⊕
  45               A.toAsciiBuilder (A.unsafeFromString $ show min)
  46
  47 -- |'Parser' for an 'HttpVersion'.
  48 httpVersion ∷ Parser HttpVersion
  49 httpVersion = string "HTTP/"
  50               *>
  51               (HttpVersion <$> decimal ⊛ (char '.' *> decimal))