Network/HTTP/Lucu/HttpVersion.hs

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