+{-# LANGUAGE
+ UnicodeSyntax
+ , ViewPatterns
+ #-}
+module Network.HTTP.Lucu.MIMEType.TH
+ ( mimeType
+ )
+ where
+import Control.Monad.Unicode
+import Data.Ascii (Ascii)
+import qualified Data.Ascii as A
+import Language.Haskell.TH.Syntax
+import Language.Haskell.TH.Quote
+import Network.HTTP.Lucu.MIMEType hiding (mimeType)
+import Network.HTTP.Lucu.Utils
+import Prelude.Unicode
+
+-- |A 'QuasiQuoter' for 'MIMEType' literals.
+--
+-- @
+-- textPlain :: 'MIMEType'
+-- textPlain = ['mimeType'| text/plain; charset="UTF-8" |]
+-- @
+mimeType ∷ QuasiQuoter
+mimeType = QuasiQuoter {
+ quoteExp = (lift ∘ parseMIMEType =≪) ∘ toAscii
+ , quotePat = const unsupported
+ , quoteType = const unsupported
+ , quoteDec = const unsupported
+ }
+ where
+ toAscii ∷ Monad m ⇒ String → m Ascii
+ toAscii (A.fromChars ∘ trim → Just a) = return a
+ toAscii str = fail $ "Malformed MIME Type: " ⧺ str
+
+ unsupported ∷ Monad m ⇒ m α
+ unsupported = fail "Unsupported usage of mimeType quasi-quoter."