X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FMIMEType%2FTH.hs;h=9e16efcb0571a0a76f7e00b8ae190e1af706f7da;hp=7cdf24497637c4ef081749f9ed88466de307ff56;hb=0678be8;hpb=97295ba748af07f3b0b609f32aabdd52167d9799 diff --git a/Network/HTTP/Lucu/MIMEType/TH.hs b/Network/HTTP/Lucu/MIMEType/TH.hs index 7cdf244..9e16efc 100644 --- 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."