X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMIMEType.hs;h=fdc112c7eea12ac560492795616b66f446c18faa;hp=acd76b67b1bfc7b9796498fd6b2cbfa2adbcdf8e;hb=ac2ff93f647d60d43ca3cc54eb776fe0f701ac9e;hpb=fc4e0252eed3c9cb43c250ea7dd29ef5dffa6dad diff --git a/Network/HTTP/Lucu/MIMEType.hs b/Network/HTTP/Lucu/MIMEType.hs index acd76b6..fdc112c 100644 --- a/Network/HTTP/Lucu/MIMEType.hs +++ b/Network/HTTP/Lucu/MIMEType.hs @@ -6,6 +6,8 @@ -- |Manipulation of MIME Types. module Network.HTTP.Lucu.MIMEType ( MIMEType(..) + , mkMIMEType + , parseMIMEType , printMIMEType @@ -33,8 +35,15 @@ data MIMEType = MIMEType { , mtParams ∷ !(Map CIAscii Text) } deriving (Eq, Show) +-- |Construct a 'MIMEType' without any parameters. +mkMIMEType ∷ CIAscii → CIAscii → MIMEType +{-# INLINE mkMIMEType #-} +mkMIMEType maj min + = MIMEType maj min (∅) + -- |Convert a 'MIMEType' to 'AsciiBuilder'. printMIMEType ∷ MIMEType → AsciiBuilder +{-# INLINEABLE printMIMEType #-} printMIMEType (MIMEType maj min params) = A.toAsciiBuilder (A.fromCIAscii maj) ⊕ A.toAsciiBuilder "/" ⊕ @@ -44,17 +53,20 @@ printMIMEType (MIMEType maj min params) -- |Parse 'MIMEType' from an 'Ascii'. This function throws an -- exception for parse error. parseMIMEType ∷ Ascii → MIMEType +{-# INLINEABLE parseMIMEType #-} parseMIMEType str - = let p = do t ← mimeTypeP - endOfInput - return t - bs = A.toByteString str - in - case parseOnly p bs of - Right t → t - Left err → error ("unparsable MIME Type: " ⧺ A.toString str ⧺ ": " ⧺ err) + = case parseOnly p $ A.toByteString str of + Right t → t + Left err → error ("unparsable MIME Type: " ⧺ A.toString str ⧺ ": " ⧺ err) + where + p ∷ Parser MIMEType + {-# INLINE p #-} + p = do t ← mimeTypeP + endOfInput + return t mimeTypeP ∷ Parser MIMEType +{-# INLINEABLE mimeTypeP #-} mimeTypeP = do maj ← A.toCIAscii <$> token _ ← char '/' min ← A.toCIAscii <$> token @@ -62,4 +74,5 @@ mimeTypeP = do maj ← A.toCIAscii <$> token return $ MIMEType maj min params mimeTypeListP ∷ Parser [MIMEType] +{-# INLINE mimeTypeListP #-} mimeTypeListP = listOf mimeTypeP