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 qualified Data.Ascii as A
  13 import Language.Haskell.TH.Syntax
  14 import Language.Haskell.TH.Quote
  15 import Network.HTTP.Lucu.MIMEType hiding (mimeType)
  16 import Network.HTTP.Lucu.Utils
  17 import Prelude.Unicode
  18
  19 -- |'QuasiQuoter' for 'MIMEType' literals.
  20 --
  21 -- @
  22 --   textPlain :: 'MIMEType'
  23 --   textPlain = ['mimeType'| text/plain; charset=\"UTF-8\" |]
  24 -- @
  25 mimeType ∷ QuasiQuoter
  26 mimeType = QuasiQuoter {
  27              quoteExp  = (lift ∘ parseMIMEType =≪) ∘ toAscii
  28            , quotePat  = const unsupported
  29            , quoteType = const unsupported
  30            , quoteDec  = const unsupported
  31            }
  32     where
  33       toAscii ∷ Monad m ⇒ String → m Ascii
  34       toAscii (A.fromChars ∘ trim → Just a) = return a
  35       toAscii str = fail $ "Malformed MIME Type: " ⧺ str
  36
  37       unsupported ∷ Monad m ⇒ m α
  38       unsupported = fail "Unsupported usage of mimeType quasi-quoter."