X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMIMEType%2FTH.hs;fp=Network%2FHTTP%2FLucu%2FMIMEType%2FTH.hs;h=1aae0b4a1accfadcf4e6b24dcd98ff831be541a3;hp=0000000000000000000000000000000000000000;hb=5e561403ba8ad9c440cc2bf2bacb61ebc3c7a111;hpb=7eed467cbc7ed48c1b88766f0c7eb6bb77be09ef

diff --git a/Network/HTTP/Lucu/MIMEType/TH.hs b/Network/HTTP/Lucu/MIMEType/TH.hs
new file mode 100644
index 0000000..1aae0b4
--- /dev/null
+++ b/Network/HTTP/Lucu/MIMEType/TH.hs
@@ -0,0 +1,37 @@
+{-# 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."