X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FETag.hs;h=d87100095a71e78cafeba5435cdf02c397111b26;hb=b1fac0a;hp=0341f5ac382b245638575477b0474ec0b1fafe40;hpb=1000bdc46cfe7b3ae550ff24ccea9f440f11b42a;p=Lucu.git diff --git a/Network/HTTP/Lucu/ETag.hs b/Network/HTTP/Lucu/ETag.hs index 0341f5a..d871000 100644 --- a/Network/HTTP/Lucu/ETag.hs +++ b/Network/HTTP/Lucu/ETag.hs @@ -1,46 +1,85 @@ +{-# LANGUAGE + OverloadedStrings + , UnicodeSyntax + #-} +-- |Entity tags module Network.HTTP.Lucu.ETag - ( ETag - , mkETag -- Bool -> String -> ETag - , eTagP -- Parser ETag - , eTagListP -- Parser [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 +import Network.HTTP.Lucu.Parser.Http hiding (token) +import Network.HTTP.Lucu.Utils +import Prelude.Unicode -import Network.HTTP.Lucu.Parser -import Network.HTTP.Lucu.Parser.Http - - +-- |An entity tag consists of a weakness flag and an opaque string. data ETag = ETag { - etagIsWeak :: Bool - , etagToken :: String - } deriving (Eq) - - -instance Show ETag where - show (ETag isWeak token) = (if isWeak then - "W/" - else - "") - ++ - foldr (++) "" (["\""] ++ map quote token ++ ["\""]) - where - quote :: Char -> String - quote '"' = "\\\"" - quote c = [c] + -- |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) -mkETag :: Bool -> String -> ETag -mkETag = ETag +-- |Parse 'Etag' from an 'Ascii'. This functions throws an exception +-- for parse error. +parseETag ∷ Ascii → ETag +{-# INLINEABLE parseETag #-} +parseETag str + = case parseOnly (finishOff eTag) $ A.toByteString str of + Right et → et + Left err → error ("unparsable ETag: " ⧺ A.toString str ⧺ ": " ⧺ err) +-- |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 -eTagP :: Parser ETag -eTagP = do isWeak <- option False (string "W/" >> return True) - str <- quotedStr - return $ mkETag isWeak str +-- |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 -eTagListP :: Parser [ETag] -eTagListP = allowEOF - $ sepBy1 eTagP (do many sp - char ',' - many sp) +-- |'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