module Network.HTTP.Lucu.MIMEType
( MIMEType(..)
, parseMIMEType
, mimeTypeP
, mimeTypeListP
)
where
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)
data MIMEType = MIMEType {
mtMajor :: !String
, mtMinor :: !String
, mtParams :: ![ (String, String) ]
} deriving (Eq)
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, "")]
parseMIMEType :: String -> MIMEType
parseMIMEType str = case parseStr mimeTypeP str of
(# Success t, r #) -> if B.null r
then t
else error ("unparsable MIME Type: " ++ str)
(# _ , _ #) -> error ("unparsable MIME Type: " ++ str)
mimeTypeP :: Parser MIMEType
mimeTypeP = allowEOF $!
do maj <- token
char '/'
min <- token
params <- many paramP
return $ MIMEType maj min params
where
paramP :: Parser (String, String)
paramP = do many lws
char ';'
many lws
name <- token
char '='
value <- token <|> quotedStr
return (name, value)
mimeTypeListP :: Parser [MIMEType]
mimeTypeListP = allowEOF $! listOf mimeTypeP