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