Network/HTTP/Lucu/MIMEType/TH.hs

   1 {-# LANGUAGE
   2     UnicodeSyntax
   3   , ViewPatterns
   4   #-}
   5 -- |A module to provide 'QuasiQuoter' for 'MIMEType' literals.
   6 module Network.HTTP.Lucu.MIMEType.TH
   7     ( mimeType
   8     )
   9     where
  10 import Control.Monad.Unicode
  11 import Data.Ascii (Ascii)
  12 import Data.Attempt
  13 import Data.Convertible.Base
  14 import Language.Haskell.TH.Syntax
  15 import Language.Haskell.TH.Quote
  16 import Network.HTTP.Lucu.MIMEType hiding (mimeType)
  17 import Network.HTTP.Lucu.Utils
  18 import Prelude.Unicode
  19
  20 -- |'QuasiQuoter' for 'MIMEType' literals.
  21 --
  22 -- @
  23 --   textPlain :: 'MIMEType'
  24 --   textPlain = ['mimeType'| text/plain; charset=\"UTF-8\" |]
  25 -- @
  26 mimeType ∷ QuasiQuoter
  27 mimeType = QuasiQuoter {
  28              quoteExp  = (lift =≪) ∘ (parse =≪) ∘ toAscii
  29            , quotePat  = const unsupported
  30            , quoteType = const unsupported
  31            , quoteDec  = const unsupported
  32            }
  33     where
  34       parse ∷ Monad m ⇒ Ascii → m MIMEType
  35       parse a
  36           = case ca a of
  37               Success t → return t
  38               Failure e → fail (show e)
  39
  40       toAscii ∷ Monad m ⇒ String → m Ascii
  41       toAscii (trim → s)
  42           = case ca s of
  43               Success a → return a
  44               Failure e → fail (show e)
  45
  46       unsupported ∷ Monad m ⇒ m α
  47       unsupported = fail "Unsupported usage of mimeType quasi-quoter."