Merge branch 'convertible'

[Lucu.git] / Network / HTTP / Lucu / MIMEType / TH.hs

diff --git a/Network/HTTP/Lucu/MIMEType/TH.hs b/Network/HTTP/Lucu/MIMEType/TH.hs
index 7cdf24497637c4ef081749f9ed88466de307ff56..9e16efcb0571a0a76f7e00b8ae190e1af706f7da 100644 (file)
--- a/Network/HTTP/Lucu/MIMEType/TH.hs
+++ b/Network/HTTP/Lucu/MIMEType/TH.hs
@@ -9,7 +9,8 @@ module Network.HTTP.Lucu.MIMEType.TH
     where
 import Control.Monad.Unicode
 import Data.Ascii (Ascii)
-import qualified Data.Ascii as A
+import Data.Attempt
+import Data.Convertible.Base
 import Language.Haskell.TH.Syntax
 import Language.Haskell.TH.Quote
 import Network.HTTP.Lucu.MIMEType hiding (mimeType)
@@ -24,15 +25,23 @@ import Prelude.Unicode
 -- @
 mimeType ∷ QuasiQuoter
 mimeType = QuasiQuoter {
-             quoteExp  = (lift ∘ parseMIMEType =≪) ∘ toAscii
+             quoteExp  = (lift =≪) ∘ (parse =≪) ∘ toAscii
            , quotePat  = const unsupported
            , quoteType = const unsupported
            , quoteDec  = const unsupported
            }
     where
+      parse ∷ Monad m ⇒ Ascii → m MIMEType
+      parse a
+          = case ca a of
+              Success t → return t
+              Failure e → fail (show e)
+
       toAscii ∷ Monad m ⇒ String → m Ascii
-      toAscii (A.fromChars ∘ trim → Just a) = return a
-      toAscii str = fail $ "Malformed MIME Type: " ⧺ str
+      toAscii (trim → s)
+          = case ca s of
+              Success a → return a
+              Failure e → fail (show e)
 
       unsupported ∷ Monad m ⇒ m α
       unsupported = fail "Unsupported usage of mimeType quasi-quoter."