{-# LANGUAGE OverloadedStrings , UnicodeSyntax #-} -- |Entity tags module Network.HTTP.Lucu.ETag ( ETag(..) , parseETag , printETag , strongETag , weakETag , eTag , eTagList ) where import Control.Applicative import Control.Monad import Data.Ascii (Ascii, AsciiBuilder) import qualified Data.Ascii as A import Data.Attoparsec.Char8 import Data.Monoid.Unicode import Network.HTTP.Lucu.Parser.Http hiding (token) import Network.HTTP.Lucu.Utils import Prelude.Unicode -- |An entity tag consists of a weakness flag and an opaque string. data ETag = ETag { -- |The weakness flag. Weak tags looks like W\/\"blahblah\" and -- strong tags are like \"blahblah\". See: -- etagIsWeak ∷ !Bool -- |An opaque string. Only characters from 0x20 (sp) to 0x7e (~) -- are allowed. , etagToken ∷ !Ascii } deriving (Eq, Show) -- |Convert an 'ETag' to an 'AsciiBuilder'. printETag ∷ ETag → AsciiBuilder {-# INLINEABLE printETag #-} printETag et = ( if etagIsWeak et then A.toAsciiBuilder "W/" else (∅) ) ⊕ quoteStr (etagToken et) -- |Parse 'Etag' from an 'Ascii'. This functions throws an exception -- for parse error. parseETag ∷ Ascii → ETag {-# INLINEABLE parseETag #-} parseETag str = case parseOnly p $ A.toByteString str of Right et → et Left err → error ("unparsable ETag: " ⧺ A.toString str ⧺ ": " ⧺ err) where p ∷ Parser ETag {-# INLINE p #-} p = do et ← eTag endOfInput return et -- |This is equivalent to @'ETag' 'False'@. If you want to generate an -- ETag from a file, try using -- 'Network.HTTP.Lucu.StaticFile.generateETagFromFile'. strongETag ∷ Ascii → ETag {-# INLINE strongETag #-} strongETag = ETag False -- |This is equivalent to @'ETag' 'True'@. weakETag ∷ Ascii → ETag {-# INLINE weakETag #-} weakETag = ETag True -- |'Parser' for an 'ETag'. eTag ∷ Parser ETag {-# INLINEABLE eTag #-} eTag = do isWeak ← option False (string "W/" *> return True) str ← quotedStr return $ ETag isWeak str -- |'Parser' for a list of 'ETag's. eTagList ∷ Parser [ETag] {-# INLINEABLE eTagList #-} eTagList = do xs ← listOf eTag when (null xs) $ fail "empty list of ETags" return xs