--- |Parse 'MIMEType' from an 'Ascii'. This function throws an
--- exception for parse error. For literals consider using
--- 'Network.HTTP.Lucu.MIMEType.TH.mimeType'.
-parseMIMEType ∷ Ascii → MIMEType
-{-# INLINEABLE parseMIMEType #-}
-parseMIMEType str
- = case parseOnly (finishOff mimeType) $ A.toByteString str of
- Right t → t
- Left err → error ("Unparsable MIME Type: " ⧺ A.toString str ⧺ ": " ⧺ err)
+-- |Parse 'MIMEType' from an 'Ascii'. For MIME type literals, consider
+-- using 'mimeType' quasi-quoter.
+instance ConvertAttempt Ascii MIMEType where
+ {-# INLINEABLE convertAttempt #-}
+ convertAttempt str
+ = case parseOnly (finishOff def) (cs str) of
+ Right t → return t
+ Left err → fail ("Unparsable MIME Type: " ⧺ cs str ⧺ ": " ⧺ err)
+
+instance Default (Parser MIMEType) where
+ {-# INLINEABLE def #-}
+ def = do media ← cs <$> token
+ _ ← char '/'
+ sub ← cs <$> token
+ params ← def
+ return $ MIMEType media sub params
+
+instance Default (Parser [MIMEType]) where
+ {-# INLINE def #-}
+ def = listOf def
+
+-- |'QuasiQuoter' for 'MIMEType' literals.
+--
+-- @
+-- textPlain :: 'MIMEType'
+-- textPlain = ['mimeType'| text/plain; charset=\"UTF-8\" |]
+-- @
+mimeType ∷ QuasiQuoter
+mimeType = QuasiQuoter {
+ quoteExp = (lift =≪) ∘ (parseType =≪) ∘ toAscii
+ , quotePat = const unsupported
+ , quoteType = const unsupported
+ , quoteDec = const unsupported
+ }
+ where
+ parseType ∷ Monad m ⇒ Ascii → m MIMEType
+ parseType a
+ = case ca a of
+ Success t → return t
+ Failure e → fail (show e)