Network/HTTP/Lucu/HttpVersion.hs

   1 {-# LANGUAGE
   2     FlexibleInstances
   3   , MultiParamTypeClasses
   4   , OverloadedStrings
   5   , TemplateHaskell
   6   , UnicodeSyntax
   7   #-}
   8 -- |An internal module for HTTP version numbers.
   9 module Network.HTTP.Lucu.HttpVersion
  10     ( HttpVersion(..)
  11     , httpVersion
  12     )
  13     where
  14 import Control.Applicative
  15 import Control.Applicative.Unicode
  16 import Data.Ascii (Ascii, AsciiBuilder)
  17 import Data.Attoparsec.Char8
  18 import Data.Convertible.Base
  19 import Data.Convertible.Instances.Ascii ()
  20 import Data.Convertible.Utils
  21 import Data.Monoid.Unicode
  22 import Prelude hiding (min)
  23 import Prelude.Unicode
  24
  25 -- |An HTTP version consists of major and minor versions.
  26 data HttpVersion
  27     = HttpVersion !Int !Int
  28       deriving (Eq, Show)
  29
  30 instance Ord HttpVersion where
  31     (HttpVersion majA minA) `compare` (HttpVersion majB minB)
  32         | majA > majB = GT
  33         | majA < majB = LT
  34         | minA > minB = GT
  35         | minA < minB = LT
  36         | otherwise   = EQ
  37
  38 instance ConvertSuccess HttpVersion Ascii where
  39     {-# INLINE convertSuccess #-}
  40     convertSuccess = convertSuccessVia ((⊥) ∷ AsciiBuilder)
  41
  42 instance ConvertSuccess HttpVersion AsciiBuilder where
  43     {-# INLINE convertSuccess #-}
  44     convertSuccess v
  45         = case v of
  46             -- Optimisation for special cases.
  47             HttpVersion 1 0 → cs ("HTTP/1.0" ∷ Ascii)
  48             HttpVersion 1 1 → cs ("HTTP/1.1" ∷ Ascii)
  49             -- General (but almost never occuring) cases.
  50             HttpVersion maj min
  51                 → cs ("HTTP/" ∷ Ascii)     ⊕
  52                   convertUnsafe (show maj) ⊕
  53                   cs ("."     ∷ Ascii)     ⊕
  54                   convertUnsafe (show min)
  55
  56 deriveAttempts [ ([t| HttpVersion |], [t| Ascii        |])
  57                , ([t| HttpVersion |], [t| AsciiBuilder |])
  58                ]
  59
  60 -- |'Parser' for an 'HttpVersion'.
  61 httpVersion ∷ Parser HttpVersion
  62 httpVersion = string "HTTP/"
  63               *>
  64               (HttpVersion <$> decimal ⊛ (char '.' *> decimal))