OverloadedStrings
, UnicodeSyntax
#-}
-{-# OPTIONS_HADDOCK prune #-}
--- |Manipulation of MIME Types.
+-- |MIME Types
module Network.HTTP.Lucu.MIMEType
( MIMEType(..)
+ , mkMIMEType
+
, parseMIMEType
, printMIMEType
)
where
import Control.Applicative
-import Data.Ascii (Ascii, CIAscii)
+import Data.Ascii (Ascii, AsciiBuilder, CIAscii)
import qualified Data.Ascii as A
import Data.Attoparsec.Char8 as P
-import qualified Data.ByteString.Char8 as C8
import Data.Map (Map)
import Data.Monoid.Unicode
import Data.Text (Text)
import Network.HTTP.Lucu.Parser.Http
-import Network.HTTP.Lucu.Utils
+import Network.HTTP.Lucu.RFC2231
import Prelude hiding (min)
import Prelude.Unicode
--- |@'MIMEType' \"major\" \"minor\" [(\"name\", \"value\")]@
--- represents \"major\/minor; name=value\".
+-- |@'MIMEType' \"major\" \"minor\" [(\"name\", \"value\"), ...]@
+-- represents \"major\/minor; name=value; ...\".
data MIMEType = MIMEType {
mtMajor ∷ !CIAscii
, mtMinor ∷ !CIAscii
, mtParams ∷ !(Map CIAscii Text)
- } deriving (Eq, Show)
+ } deriving (Eq)
+
+instance Show MIMEType where
+ show = A.toString ∘ A.fromAsciiBuilder ∘ printMIMEType
+
+-- |@'mkMIMEType' major minor@ returns a 'MIMEType' with the given
+-- @major@ and @minor@ types but without any parameters.
+mkMIMEType ∷ CIAscii → CIAscii → MIMEType
+{-# INLINE mkMIMEType #-}
+mkMIMEType maj min
+ = MIMEType maj min (∅)
--- |Convert a 'MIMEType' to 'Ascii'.
-printMIMEType ∷ MIMEType → Ascii
+-- |Convert a 'MIMEType' to an 'AsciiBuilder'.
+printMIMEType ∷ MIMEType → AsciiBuilder
+{-# INLINEABLE printMIMEType #-}
printMIMEType (MIMEType maj min params)
- = A.fromAsciiBuilder $
- ( A.toAsciiBuilder (A.fromCIAscii maj) ⊕
- A.toAsciiBuilder "/" ⊕
- A.toAsciiBuilder (A.fromCIAscii 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 C8.any ((¬) ∘ isToken) (A.toByteString value) then
- quoteStr value
- else
- A.toAsciiBuilder value
+ = A.toAsciiBuilder (A.fromCIAscii maj) ⊕
+ A.toAsciiBuilder "/" ⊕
+ A.toAsciiBuilder (A.fromCIAscii min) ⊕
+ printParams 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: " ⧺ C8.unpack bs ⧺ ": " ⧺ 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
+-- |'Parser' for an 'MIMEType'.
mimeTypeP ∷ Parser MIMEType
-mimeTypeP = try $
- do maj ← A.toCIAscii <$> token
+{-# INLINEABLE mimeTypeP #-}
+mimeTypeP = do maj ← A.toCIAscii <$> token
_ ← char '/'
min ← A.toCIAscii <$> token
- params ← P.many paramP
+ params ← paramsP
return $ MIMEType maj min params
- where
- paramP ∷ Parser (CIAscii, Ascii)
- paramP = try $
- do skipMany lws
- _ ← char ';'
- skipMany lws
- name ← A.toCIAscii <$> token
- _ ← char '='
- value ← token <|> quotedStr
- return (name, value)
+-- |'Parser' for a list of 'MIMEType's.
mimeTypeListP ∷ Parser [MIMEType]
+{-# INLINE mimeTypeListP #-}
mimeTypeListP = listOf mimeTypeP