Network/HTTP/Lucu/ETag.hs

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