Network/HTTP/Lucu/MIMEType/TH.hs

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