4 , MultiParamTypeClasses
10 -- |Parsing and printing MIME Media Types
11 -- (<http://tools.ietf.org/html/rfc2046>).
12 module Network.HTTP.Lucu.MIMEType
18 import Control.Applicative
19 import Data.Ascii (Ascii, AsciiBuilder, CIAscii)
20 import Data.Attoparsec.Char8
21 import Data.Convertible.Base
22 import Data.Convertible.Instances.Ascii ()
23 import Data.Convertible.Utils
24 import Data.Monoid.Unicode
26 import Language.Haskell.TH.Syntax
27 import Network.HTTP.Lucu.MIMEParams
28 import Network.HTTP.Lucu.OrphanInstances ()
29 import Network.HTTP.Lucu.Parser
30 import Network.HTTP.Lucu.Parser.Http
31 import Prelude.Unicode
33 -- |A media type, subtype, and parameters.
38 , mtParams ∷ !MIMEParams
40 deriving (Eq, Show, Read, Typeable)
42 instance Lift MIMEType where
45 mtMedia = $(lift mtMedia )
46 , mtSub = $(lift mtSub )
47 , mtParams = $(lift mtParams)
51 instance ConvertSuccess MIMEType Ascii where
52 {-# INLINE convertSuccess #-}
53 convertSuccess = convertSuccessVia ((⊥) ∷ AsciiBuilder)
55 instance ConvertSuccess MIMEType AsciiBuilder where
56 {-# INLINEABLE convertSuccess #-}
57 convertSuccess (MIMEType {..})
63 deriveAttempts [ ([t| MIMEType |], [t| Ascii |])
64 , ([t| MIMEType |], [t| AsciiBuilder |])
67 -- |Parse 'MIMEType' from an 'Ascii'. For MIME type literals, consider
68 -- using 'Network.HTTP.Lucu.MIMEType.TH.mimeType'.
69 instance ConvertAttempt Ascii MIMEType where
70 {-# INLINEABLE convertAttempt #-}
72 = case parseOnly (finishOff mimeType) (cs str) of
74 Left err → fail ("Unparsable MIME Type: " ⧺ cs str ⧺ ": " ⧺ err)
76 -- |'Parser' for an 'MIMEType'.
77 mimeType ∷ Parser MIMEType
78 {-# INLINEABLE mimeType #-}
79 mimeType = do media ← cs <$> token
83 return $ MIMEType media sub params
85 -- |'Parser' for a list of 'MIMEType's.
86 mimeTypeList ∷ Parser [MIMEType]
87 {-# INLINE mimeTypeList #-}
88 mimeTypeList = listOf mimeType