Network/HTTP/Lucu/ETag.hs

   1 {-# LANGUAGE
   2     DeriveDataTypeable
   3   , FlexibleInstances
   4   , MultiParamTypeClasses
   5   , OverloadedStrings
   6   , RecordWildCards
   7   , TemplateHaskell
   8   , UnicodeSyntax
   9   #-}
  10 -- |An internal module for entity tags.
  11 module Network.HTTP.Lucu.ETag
  12     ( ETag(..)
  13
  14     , strongETag
  15     , weakETag
  16     , eTag
  17     , eTagList
  18     )
  19     where
  20 import Control.Applicative
  21 import Control.Monad
  22 import Data.Ascii (Ascii, AsciiBuilder)
  23 import Data.Attoparsec.Char8
  24 import Data.Convertible.Base
  25 import Data.Convertible.Instances.Ascii ()
  26 import Data.Convertible.Utils
  27 import Data.Data
  28 import Data.Monoid.Unicode
  29 import Language.Haskell.TH.Syntax
  30 import Network.HTTP.Lucu.OrphanInstances ()
  31 import Network.HTTP.Lucu.Parser.Http hiding (token)
  32 import Network.HTTP.Lucu.Utils
  33 import Prelude.Unicode
  34
  35 -- |An entity tag consists of a weakness flag and an opaque string.
  36 data ETag = ETag {
  37       -- |The weakness flag. Weak tags looks like @W\/\"blahblah\"@
  38       -- and strong tags are like @\"blahblah\"@. See:
  39       -- <http://www.w3.org/Protocols/rfc2616/rfc2616-sec13.html#sec13.3.3>
  40       etagIsWeak ∷ !Bool
  41       -- |An opaque string. Only characters from 0x20 (sp) to 0x7e (~)
  42       -- are allowed.
  43     , etagToken  ∷ !Ascii
  44     } deriving (Eq, Show, Data, Typeable)
  45
  46 instance Lift ETag where
  47     lift (ETag {..})
  48         = [| ETag {
  49                etagIsWeak = $(lift etagIsWeak)
  50              , etagToken  = $(lift etagToken )
  51              }
  52            |]
  53
  54 instance ConvertSuccess ETag Ascii where
  55     {-# INLINE convertSuccess #-}
  56     convertSuccess = convertSuccessVia ((⊥) ∷ AsciiBuilder)
  57
  58 instance ConvertSuccess ETag AsciiBuilder where
  59     {-# INLINE convertSuccess #-}
  60     convertSuccess (ETag {..})
  61         = ( if etagIsWeak then
  62                 cs ("W/" ∷ Ascii)
  63             else
  64                 (∅)
  65           )
  66           ⊕
  67           quoteStr etagToken
  68
  69 deriveAttempts [ ([t| ETag |], [t| Ascii        |])
  70                , ([t| ETag |], [t| AsciiBuilder |])
  71                ]
  72
  73 -- |This is equivalent to @'ETag' 'False'@. If you want to generate an
  74 -- ETag from a file, try using
  75 -- 'Network.HTTP.Lucu.StaticFile.generateETagFromFile'.
  76 strongETag ∷ Ascii → ETag
  77 {-# INLINE strongETag #-}
  78 strongETag = ETag False
  79
  80 -- |This is equivalent to @'ETag' 'True'@.
  81 weakETag ∷ Ascii → ETag
  82 {-# INLINE weakETag #-}
  83 weakETag = ETag True
  84
  85 -- |'Parser' for an 'ETag'.
  86 eTag ∷ Parser ETag
  87 {-# INLINEABLE eTag #-}
  88 eTag = do isWeak ← option False (string "W/" *> return True)
  89           str    ← quotedStr
  90           return $ ETag isWeak str
  91
  92 -- |'Parser' for a list of 'ETag's.
  93 eTagList ∷ Parser [ETag]
  94 {-# INLINEABLE eTagList #-}
  95 eTagList = do xs ← listOf eTag
  96               when (null xs) $
  97                   fail "empty list of ETags"
  98               return xs