Network/HTTP/Lucu/HttpVersion.hs

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