X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMIMEType.hs;h=88a2eeffde0ad8e7e673af93c425f506c6d5706e;hb=9bb89434103e9a22f100d6ecb7e65a5d461e0454;hp=b7ceb4043fdd656173f9d503cbe9974c2fdf8547;hpb=9ac730212cb361eb10e5fe4ad0eec6758e2b200a;p=Lucu.git diff --git a/Network/HTTP/Lucu/MIMEType.hs b/Network/HTTP/Lucu/MIMEType.hs index b7ceb40..88a2eef 100644 --- a/Network/HTTP/Lucu/MIMEType.hs +++ b/Network/HTTP/Lucu/MIMEType.hs @@ -1,47 +1,56 @@ +{-# LANGUAGE + UnboxedTuples + , UnicodeSyntax + #-} {-# OPTIONS_HADDOCK prune #-} -- |Manipulation of MIME Types. module Network.HTTP.Lucu.MIMEType ( MIMEType(..) , parseMIMEType + , printMIMEType + , mimeTypeP , mimeTypeListP ) where - +import Data.Ascii (Ascii, CIAscii) +import qualified Data.Ascii as A import qualified Data.ByteString.Lazy as B -import Network.HTTP.Lucu.Parser -import Network.HTTP.Lucu.Parser.Http -import Network.HTTP.Lucu.Utils -import Prelude hiding (min) +import Network.HTTP.Lucu.Parser.Http +import Network.HTTP.Lucu.Utils +import Prelude hiding (min) -- |@'MIMEType' \"major\" \"minor\" [(\"name\", \"value\")]@ -- represents \"major\/minor; name=value\". data MIMEType = MIMEType { - mtMajor :: !String - , mtMinor :: !String - , mtParams :: ![ (String, String) ] - } deriving (Eq) - + mtMajor :: !CIAscii + , mtMinor :: !CIAscii + , mtParams :: ![ (CIAscii, Ascii) ] + } deriving (Eq, Show) -instance Show MIMEType where - show (MIMEType maj min params) - = maj ++ "/" ++ min ++ - if null params then - "" - else - "; " ++ joinWith "; " (map showPair params) - where - showPair :: (String, String) -> String - showPair (name, value) - = name ++ "=" ++ if any (not . isToken) value then - quoteStr value - else - value - - -instance Read MIMEType where - readsPrec _ s = [(parseMIMEType s, "")] +-- |Convert a 'MIMEType' to 'Ascii'. +printMIMEType ∷ MIMEType → Ascii +printMIMEType (MIMEType maj min params) + = A.fromAsciiBuilder $ + ( A.toAsciiBuilder maj ⊕ + A.toAsciiBuilder "/" ⊕ + A.toAsciiBuilder min ⊕ + if null params then + (∅) + else + A.toAsciiBuilder "; " ⊕ + joinWith "; " (map printPair params) + ) + where + printPair ∷ (CIAscii, Ascii) → A.AsciiBuilder + printPair (name, value) + = A.toAsciiBuilder (A.fromCIAscii name) ⊕ + A.toAsciiBuilder "=" ⊕ + if any ((¬) ∘ isToken) value then + quoteStr value + else + A.toAsciiBuilder value -- |Parse 'MIMEType' from a 'Prelude.String'. This function throws an -- exception for parse error.