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.Http
26 import Network.HTTP.Lucu.RFC2231
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 instance Show MIMEType where
39 show = A.toString ∘ A.fromAsciiBuilder ∘ printMIMEType
41 -- |@'mkMIMEType' major minor@ returns a 'MIMEType' with the given
42 -- @major@ and @minor@ types but without any parameters.
43 mkMIMEType ∷ CIAscii → CIAscii → MIMEType
44 {-# INLINE mkMIMEType #-}
46 = MIMEType maj min (∅)
48 -- |Convert a 'MIMEType' to an 'AsciiBuilder'.
49 printMIMEType ∷ MIMEType → AsciiBuilder
50 {-# INLINEABLE printMIMEType #-}
51 printMIMEType (MIMEType maj min params)
52 = A.toAsciiBuilder (A.fromCIAscii maj) ⊕
53 A.toAsciiBuilder "/" ⊕
54 A.toAsciiBuilder (A.fromCIAscii min) ⊕
55 printMIMEParams params
57 -- |Parse 'MIMEType' from an 'Ascii'. This function throws an
58 -- exception for parse error.
59 parseMIMEType ∷ Ascii → MIMEType
60 {-# INLINEABLE parseMIMEType #-}
62 = case parseOnly p $ A.toByteString str of
64 Left err → error ("unparsable MIME Type: " ⧺ A.toString str ⧺ ": " ⧺ err)
72 -- |'Parser' for an 'MIMEType'.
73 mimeType ∷ Parser MIMEType
74 {-# INLINEABLE mimeType #-}
75 mimeType = do maj ← A.toCIAscii <$> token
77 min ← A.toCIAscii <$> token
79 return $ MIMEType maj min params
81 -- |'Parser' for a list of 'MIMEType's.
82 mimeTypeList ∷ Parser [MIMEType]
83 {-# INLINE mimeTypeList #-}
84 mimeTypeList = listOf mimeType