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     )
  12     where
  13 import Control.Applicative
  14 import Control.Applicative.Unicode
  15 import Data.Ascii (Ascii, AsciiBuilder)
  16 import Data.Attoparsec.Char8
  17 import Data.Attoparsec.Parsable
  18 import Data.ByteString (ByteString)
  19 import Data.Convertible.Base
  20 import Data.Convertible.Instances.Ascii ()
  21 import Data.Convertible.Utils
  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 Parsable ByteString HttpVersion where
  62     {-# INLINEABLE parser #-}
  63     parser = string "HTTP/"
  64              *>
  65              (HttpVersion <$> decimal ⊛ (char '.' *> decimal))