]> gitweb @ CieloNegro.org - Lucu.git/blobdiff - Network/HTTP/Lucu/MIMEType/TH.hs
Code clean-up using convertible-text.
[Lucu.git] / Network / HTTP / Lucu / MIMEType / TH.hs
index 1aae0b4a1accfadcf4e6b24dcd98ff831be541a3..9e16efcb0571a0a76f7e00b8ae190e1af706f7da 100644 (file)
@@ -2,36 +2,46 @@
     UnicodeSyntax
   , ViewPatterns
   #-}
+-- |A module to provide 'QuasiQuoter' for 'MIMEType' literals.
 module Network.HTTP.Lucu.MIMEType.TH
     ( mimeType
     )
     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)
 import Network.HTTP.Lucu.Utils
 import Prelude.Unicode
 
--- |'QuasiQuoter' for 'MIMEType' literals.
+-- |'QuasiQuoter' for 'MIMEType' literals.
 --
 -- @
 --   textPlain :: 'MIMEType'
---   textPlain = ['mimeType'| text/plain; charset="UTF-8" |]
+--   textPlain = ['mimeType'| text/plain; charset=\"UTF-8\" |]
 -- @
 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."