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     )
  16     where
  17 import Control.Applicative
  18 import Control.Monad
  19 import Data.Ascii (Ascii, AsciiBuilder)
  20 import Data.Attoparsec.Char8
  21 import Data.Attoparsec.Parsable
  22 import Data.ByteString (ByteString)
  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 instance Parsable ByteString ETag where
  85     {-# INLINEABLE parser #-}
  86     parser = do isWeak ← option False (string "W/" *> return True)
  87                 str    ← quotedStr
  88                 return $ ETag isWeak str
  89
  90 instance Parsable ByteString [ETag] where
  91     {-# INLINEABLE parser #-}
  92     parser = do xs ← listOf parser
  93                 when (null xs) $
  94                     fail "empty list of ETags"
  95                 return xs