Network/HTTP/Lucu/HttpVersion.hs

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