X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FETag.hs;h=08c10602174cca93d03da0bc6e6540afb03574da;hb=761b90ab4f413d2e83460f170082f3b15bbaef4f;hp=d4a157fa2eabeb66d133afe1b25c3393a59f2946;hpb=9668dc27a02b59d7bfb1e9e40af3d2619700ad69;p=Lucu.git diff --git a/Network/HTTP/Lucu/ETag.hs b/Network/HTTP/Lucu/ETag.hs index d4a157f..08c1060 100644 --- a/Network/HTTP/Lucu/ETag.hs +++ b/Network/HTTP/Lucu/ETag.hs @@ -1,8 +1,11 @@ {-# LANGUAGE - OverloadedStrings + DeriveDataTypeable + , OverloadedStrings + , RecordWildCards + , TemplateHaskell , UnicodeSyntax #-} --- |Entity tags +-- |An internal module for entity tags. module Network.HTTP.Lucu.ETag ( ETag(..) , parseETag @@ -10,8 +13,8 @@ module Network.HTTP.Lucu.ETag , strongETag , weakETag - , eTagP - , eTagListP + , eTag + , eTagList ) where import Control.Applicative @@ -19,21 +22,33 @@ import Control.Monad import Data.Ascii (Ascii, AsciiBuilder) import qualified Data.Ascii as A import Data.Attoparsec.Char8 +import Data.Data import Data.Monoid.Unicode +import Language.Haskell.TH.Syntax +import Network.HTTP.Lucu.OrphanInstances () +import Network.HTTP.Lucu.Parser 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: + -- |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) + } deriving (Eq, Show, Data, Typeable) + +instance Lift ETag where + lift (ETag {..}) + = [| ETag { + etagIsWeak = $(lift etagIsWeak) + , etagToken = $(lift etagToken ) + } + |] -- |Convert an 'ETag' to an 'AsciiBuilder'. printETag ∷ ETag → AsciiBuilder @@ -52,15 +67,9 @@ printETag et parseETag ∷ Ascii → ETag {-# INLINEABLE parseETag #-} parseETag str - = case parseOnly p $ A.toByteString str of + = case parseOnly (finishOff eTag) $ 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 ← eTagP - endOfInput - return et -- |This is equivalent to @'ETag' 'False'@. If you want to generate an -- ETag from a file, try using @@ -75,16 +84,16 @@ weakETag ∷ Ascii → ETag weakETag = ETag True -- |'Parser' for an 'ETag'. -eTagP ∷ Parser ETag -{-# INLINEABLE eTagP #-} -eTagP = do isWeak ← option False (string "W/" *> return True) - str ← quotedStr - return $ ETag isWeak str +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. -eTagListP ∷ Parser [ETag] -{-# INLINEABLE eTagListP #-} -eTagListP = do xs ← listOf eTagP - when (null xs) $ - fail "empty list of ETags" - return xs +eTagList ∷ Parser [ETag] +{-# INLINEABLE eTagList #-} +eTagList = do xs ← listOf eTag + when (null xs) $ + fail "empty list of ETags" + return xs