4 , MultiParamTypeClasses
12 -- |Parsing and printing MIME Media Types
13 -- (<http://tools.ietf.org/html/rfc2046>).
14 module Network.HTTP.Lucu.MIMEType
19 import Control.Applicative
20 import Control.Monad.Unicode
21 import Data.Ascii (Ascii, AsciiBuilder, CIAscii)
23 import Data.Attoparsec.Char8
24 import Data.Convertible.Base
25 import Data.Convertible.Instances.Ascii ()
26 import Data.Convertible.Utils
28 import Data.Monoid.Unicode
30 import Language.Haskell.TH.Syntax
31 import Language.Haskell.TH.Quote
32 import Network.HTTP.Lucu.MIMEParams
33 import Network.HTTP.Lucu.OrphanInstances ()
34 import Network.HTTP.Lucu.Parser
35 import Network.HTTP.Lucu.Parser.Http
36 import Network.HTTP.Lucu.Utils
37 import Prelude.Unicode
39 -- |A media type, subtype, and parameters.
44 , mtParams ∷ !MIMEParams
46 deriving (Eq, Show, Read, Typeable)
48 instance Lift MIMEType where
51 mtMedia = $(lift mtMedia )
52 , mtSub = $(lift mtSub )
53 , mtParams = $(lift mtParams)
57 instance ConvertSuccess MIMEType Ascii where
58 {-# INLINE convertSuccess #-}
59 convertSuccess = convertSuccessVia ((⊥) ∷ AsciiBuilder)
61 instance ConvertSuccess MIMEType AsciiBuilder where
62 {-# INLINEABLE convertSuccess #-}
63 convertSuccess (MIMEType {..})
69 deriveAttempts [ ([t| MIMEType |], [t| Ascii |])
70 , ([t| MIMEType |], [t| AsciiBuilder |])
73 -- |Parse 'MIMEType' from an 'Ascii'. For MIME type literals, consider
74 -- using 'mimeType' quasi-quoter.
75 instance ConvertAttempt Ascii MIMEType where
76 {-# INLINEABLE convertAttempt #-}
78 = case parseOnly (finishOff def) (cs str) of
80 Left err → fail ("Unparsable MIME Type: " ⧺ cs str ⧺ ": " ⧺ err)
82 instance Default (Parser MIMEType) where
83 {-# INLINEABLE def #-}
84 def = do media ← cs <$> token
88 return $ MIMEType media sub params
90 instance Default (Parser [MIMEType]) where
94 -- |'QuasiQuoter' for 'MIMEType' literals.
97 -- textPlain :: 'MIMEType'
98 -- textPlain = ['mimeType'| text/plain; charset=\"UTF-8\" |]
100 mimeType ∷ QuasiQuoter
101 mimeType = QuasiQuoter {
102 quoteExp = (lift =≪) ∘ (parseType =≪) ∘ toAscii
103 , quotePat = const unsupported
104 , quoteType = const unsupported
105 , quoteDec = const unsupported
108 parseType ∷ Monad m ⇒ Ascii → m MIMEType
112 Failure e → fail (show e)
114 toAscii ∷ Monad m ⇒ String → m Ascii
118 Failure e → fail (show e)
120 unsupported ∷ Monad m ⇒ m α
121 unsupported = fail "Unsupported usage of mimeType quasi-quoter."