Network/HTTP/Lucu/HttpVersion.hs

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