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
22 import Data.Monoid.Unicode
23 import Network.HTTP.Lucu.Parser.Http
24 import Network.HTTP.Lucu.Utils
25 import Prelude hiding (min)
26 import Prelude.Unicode
28 -- |@'MIMEType' \"major\" \"minor\" [(\"name\", \"value\")]@
29 -- represents \"major\/minor; name=value\".
30 data MIMEType = MIMEType {
33 , mtParams ∷ ![ (CIAscii, Ascii) ]
36 -- |Convert a 'MIMEType' to 'Ascii'.
37 printMIMEType ∷ MIMEType → Ascii
38 printMIMEType (MIMEType maj min params)
39 = A.fromAsciiBuilder $
40 ( A.toAsciiBuilder (A.fromCIAscii maj) ⊕
41 A.toAsciiBuilder "/" ⊕
42 A.toAsciiBuilder (A.fromCIAscii min) ⊕
46 A.toAsciiBuilder "; " ⊕
47 joinWith "; " (map printPair params)
50 printPair ∷ (CIAscii, Ascii) → A.AsciiBuilder
51 printPair (name, value)
52 = A.toAsciiBuilder (A.fromCIAscii name) ⊕
53 A.toAsciiBuilder "=" ⊕
54 if C8.any ((¬) ∘ isToken) (A.toByteString value) then
57 A.toAsciiBuilder value
59 -- |Parse 'MIMEType' from an 'Ascii'. This function throws an
60 -- exception for parse error.
61 parseMIMEType ∷ Ascii → MIMEType
63 = let p = do t ← mimeTypeP
66 bs = A.toByteString str
68 case parseOnly p bs of
70 Left err → error ("unparsable MIME Type: " ⧺ C8.unpack bs ⧺ ": " ⧺ err)
72 mimeTypeP ∷ Parser MIMEType
74 do maj ← A.toCIAscii <$> token
76 min ← A.toCIAscii <$> token
77 params ← P.many paramP
78 return $ MIMEType maj min params
80 paramP ∷ Parser (CIAscii, Ascii)
85 name ← A.toCIAscii <$> token
87 value ← token <|> quotedStr
90 mimeTypeListP ∷ Parser [MIMEType]
91 mimeTypeListP = listOf mimeTypeP