5 {-# OPTIONS_HADDOCK prune #-}
7 -- |Manipulation of MIME Types.
8 module Network.HTTP.Lucu.MIMEType
17 import Control.Applicative
18 import Data.Ascii (Ascii, CIAscii)
19 import qualified Data.Ascii as A
20 import Data.Attoparsec.Char8 as P
21 import qualified Data.ByteString.Char8 as C8
23 import Data.Monoid.Unicode
24 import Data.Text (Text)
25 import Network.HTTP.Lucu.Parser.Http
26 import Network.HTTP.Lucu.Utils
27 import Prelude hiding (min)
28 import Prelude.Unicode
30 -- |@'MIMEType' \"major\" \"minor\" [(\"name\", \"value\")]@
31 -- represents \"major\/minor; name=value\".
32 data MIMEType = MIMEType {
35 , mtParams ∷ !(Map CIAscii Text)
38 -- |Convert a 'MIMEType' to 'Ascii'.
39 printMIMEType ∷ MIMEType → Ascii
40 printMIMEType (MIMEType maj min params)
41 = A.fromAsciiBuilder $
42 ( A.toAsciiBuilder (A.fromCIAscii maj) ⊕
43 A.toAsciiBuilder "/" ⊕
44 A.toAsciiBuilder (A.fromCIAscii min) ⊕
48 A.toAsciiBuilder "; " ⊕
49 joinWith "; " (map printPair params)
52 printPair ∷ (CIAscii, Ascii) → A.AsciiBuilder
53 printPair (name, value)
54 = A.toAsciiBuilder (A.fromCIAscii name) ⊕
55 A.toAsciiBuilder "=" ⊕
56 if C8.any ((¬) ∘ isToken) (A.toByteString value) then
59 A.toAsciiBuilder value
61 -- |Parse 'MIMEType' from an 'Ascii'. This function throws an
62 -- exception for parse error.
63 parseMIMEType ∷ Ascii → MIMEType
65 = let p = do t ← mimeTypeP
68 bs = A.toByteString str
70 case parseOnly p bs of
72 Left err → error ("unparsable MIME Type: " ⧺ C8.unpack bs ⧺ ": " ⧺ err)
74 mimeTypeP ∷ Parser MIMEType
76 do maj ← A.toCIAscii <$> token
78 min ← A.toCIAscii <$> token
79 params ← P.many paramP
80 return $ MIMEType maj min params
82 paramP ∷ Parser (CIAscii, Ascii)
87 name ← A.toCIAscii <$> token
89 value ← token <|> quotedStr
92 mimeTypeListP ∷ Parser [MIMEType]
93 mimeTypeListP = listOf mimeTypeP