X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FETag.hs;h=f7ef8387c7044d02acc1451a7fa0e140c3197c60;hb=ac2ff93;hp=86dd429e265100b8318716679ebfd4d0554120b0;hpb=c6b11025d1f81c668e9995e856b7bb34175230d3;p=Lucu.git diff --git a/Network/HTTP/Lucu/ETag.hs b/Network/HTTP/Lucu/ETag.hs index 86dd429..f7ef838 100644 --- a/Network/HTTP/Lucu/ETag.hs +++ b/Network/HTTP/Lucu/ETag.hs @@ -1,54 +1,87 @@ +{-# LANGUAGE + OverloadedStrings + , UnicodeSyntax + #-} +-- |Manipulation of entity tags. module Network.HTTP.Lucu.ETag - ( ETag - , mkETag -- Bool -> String -> ETag - , strongETag -- String -> ETag - , weakETag -- String -> ETag - , eTagP -- Parser ETag - , eTagListP -- Parser [ETag] + ( ETag(..) + , parseETag + , printETag + + , strongETag + , weakETag + , eTagP + , eTagListP ) 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 -import Control.Monad -import Network.HTTP.Lucu.Parser -import Network.HTTP.Lucu.Parser.Http -import Network.HTTP.Lucu.Utils - - +-- |An entity tag is made of a weakness flag and a opaque string. data ETag = ETag { - etagIsWeak :: Bool - , etagToken :: String - } deriving (Eq) - -instance Show ETag where - show (ETag isWeak token) = (if isWeak then - "W/" - else - "") - ++ - quoteStr token - + -- |The weakness flag. Weak tags looks like W\/\"blahblah\" and + -- strong tags are like \"blahblah\". + etagIsWeak ∷ !Bool + -- |An opaque string. Only characters from 0x20 (sp) to 0x7e (~) + -- are allowed. + , etagToken ∷ !Ascii + } deriving (Eq, Show) -mkETag :: Bool -> String -> ETag -mkETag = ETag +-- |Convert an 'ETag' to '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 ← eTagP + endOfInput + return et -strongETag :: String -> ETag +-- |This is equivalent to @'ETag' 'Prelude.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 - -weakETag :: String -> ETag +-- |This is equivalent to @'ETag' 'Prelude.True'@. +weakETag ∷ Ascii → ETag +{-# INLINE weakETag #-} weakETag = ETag True +eTagP ∷ Parser ETag +{-# INLINEABLE eTagP #-} +eTagP = 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 $ mkETag isWeak str - - -eTagListP :: Parser [ETag] -eTagListP = allowEOF - $ do xs <- listOf eTagP - when (null xs) - $ fail "" - return xs +eTagListP ∷ Parser [ETag] +{-# INLINEABLE eTagListP #-} +eTagListP = do xs ← listOf eTagP + when (null xs) $ + fail "empty list of ETags" + return xs