7 module Network.HTTP.Lucu.MIMEType
18 import Control.Applicative
19 import Data.Ascii (Ascii, AsciiBuilder, CIAscii)
20 import qualified Data.Ascii as A
21 import Data.Attoparsec.Char8 as P
23 import Data.Monoid.Unicode
24 import Data.Text (Text)
25 import Network.HTTP.Lucu.Parser
26 import Network.HTTP.Lucu.Parser.Http
27 import Network.HTTP.Lucu.RFC2231
28 import Prelude hiding (min)
29 import Prelude.Unicode
31 -- |@'MIMEType' \"major\" \"minor\" [(\"name\", \"value\"), ...]@
32 -- represents \"major\/minor; name=value; ...\".
33 data MIMEType = MIMEType {
36 , mtParams ∷ !(Map CIAscii Text)
39 instance Show MIMEType where
40 show = A.toString ∘ A.fromAsciiBuilder ∘ printMIMEType
42 -- |@'mkMIMEType' major minor@ returns a 'MIMEType' with the given
43 -- @major@ and @minor@ types but without any parameters.
44 mkMIMEType ∷ CIAscii → CIAscii → MIMEType
45 {-# INLINE mkMIMEType #-}
47 = MIMEType maj min (∅)
49 -- |Convert a 'MIMEType' to an 'AsciiBuilder'.
50 printMIMEType ∷ MIMEType → AsciiBuilder
51 {-# INLINEABLE printMIMEType #-}
52 printMIMEType (MIMEType maj min params)
53 = A.toAsciiBuilder (A.fromCIAscii maj) ⊕
54 A.toAsciiBuilder "/" ⊕
55 A.toAsciiBuilder (A.fromCIAscii min) ⊕
56 printMIMEParams params
58 -- |Parse 'MIMEType' from an 'Ascii'. This function throws an
59 -- exception for parse error.
60 parseMIMEType ∷ Ascii → MIMEType
61 {-# INLINEABLE parseMIMEType #-}
63 = case parseOnly (finishOff mimeType) $ A.toByteString str of
65 Left err → error ("unparsable MIME Type: " ⧺ A.toString str ⧺ ": " ⧺ err)
67 -- |'Parser' for an 'MIMEType'.
68 mimeType ∷ Parser MIMEType
69 {-# INLINEABLE mimeType #-}
70 mimeType = do maj ← A.toCIAscii <$> token
72 min ← A.toCIAscii <$> token
74 return $ MIMEType maj min params
76 -- |'Parser' for a list of 'MIMEType's.
77 mimeTypeList ∷ Parser [MIMEType]
78 {-# INLINE mimeTypeList #-}
79 mimeTypeList = listOf mimeType