X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FETag.hs;h=3ebfc1d91b35b3f7e676571d0ed981a813b67dbf;hp=158144cc5254677e59c5080d2636a80c7c6a3b2c;hb=67f9e87;hpb=3d017dd65ddede9a11c5b7a34a91e04340e67bc4 diff --git a/Network/HTTP/Lucu/ETag.hs b/Network/HTTP/Lucu/ETag.hs index 158144c..3ebfc1d 100644 --- a/Network/HTTP/Lucu/ETag.hs +++ b/Network/HTTP/Lucu/ETag.hs @@ -1,58 +1,98 @@ --- #prune - --- |Manipulation of entity tags. +{-# LANGUAGE + DeriveDataTypeable + , FlexibleInstances + , MultiParamTypeClasses + , OverloadedStrings + , RecordWildCards + , TemplateHaskell + , UnicodeSyntax + #-} +-- |An internal module for entity tags. module Network.HTTP.Lucu.ETag ( ETag(..) + , strongETag , weakETag - , eTagP - , eTagListP + , eTag + , eTagList ) where +import Control.Applicative +import Control.Monad +import Data.Ascii (Ascii, AsciiBuilder) +import Data.Attoparsec.Char8 +import Data.Convertible.Base +import Data.Convertible.Instances.Ascii () +import Data.Convertible.Utils +import Data.Data +import Data.Monoid.Unicode +import Language.Haskell.TH.Syntax +import Network.HTTP.Lucu.OrphanInstances () +import Network.HTTP.Lucu.Parser.Http hiding (token) +import Network.HTTP.Lucu.Utils +import Prelude.Unicode -import Control.Monad -import Network.HTTP.Lucu.Parser -import Network.HTTP.Lucu.Parser.Http hiding (token) -import Network.HTTP.Lucu.Utils - --- |An entity tag is made of a weakness flag and a opaque string. +-- |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\". - etagIsWeak :: !Bool + -- |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 :: !String - } deriving (Eq) - -instance Show ETag where - show (ETag isWeak token) = (if isWeak then - "W/" - else - "") - ++ - quoteStr token - --- |This is equivalent to @'ETag' 'Prelude.False'@. If you want to --- generate an ETag from a file, try using + , etagToken ∷ !Ascii + } deriving (Eq, Show, Data, Typeable) + +instance Lift ETag where + lift (ETag {..}) + = [| ETag { + etagIsWeak = $(lift etagIsWeak) + , etagToken = $(lift etagToken ) + } + |] + +instance ConvertSuccess ETag Ascii where + {-# INLINE convertSuccess #-} + convertSuccess = convertSuccessVia ((⊥) ∷ AsciiBuilder) + +instance ConvertSuccess ETag AsciiBuilder where + {-# INLINE convertSuccess #-} + convertSuccess (ETag {..}) + = ( if etagIsWeak then + cs ("W/" ∷ Ascii) + else + (∅) + ) + ⊕ + quoteStr etagToken + +deriveAttempts [ ([t| ETag |], [t| Ascii |]) + , ([t| ETag |], [t| AsciiBuilder |]) + ] + +-- |This is equivalent to @'ETag' 'False'@. If you want to generate an +-- ETag from a file, try using -- 'Network.HTTP.Lucu.StaticFile.generateETagFromFile'. -strongETag :: String -> ETag +strongETag ∷ Ascii → ETag +{-# INLINE strongETag #-} strongETag = ETag False --- |This is equivalent to @'ETag' 'Prelude.True'@. -weakETag :: String -> ETag +-- |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 -eTagP :: Parser ETag -eTagP = do isWeak <- option False (string "W/" >> return True) - str <- quotedStr - return $ ETag isWeak str - - -eTagListP :: Parser [ETag] -eTagListP = allowEOF - $! do xs <- listOf eTagP - when (null xs) - $ fail "" - return xs +-- |'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