{-# LANGUAGE TemplateHaskell #-}

module Text.Regex.Quote
       ( r
       )
       where

import Language.Haskell.TH
import Language.Haskell.TH.Quote
import Text.Regex.Base

-- | Generate compiled regular expression.
--
-- This QuasiQuote is shorthand of /makeRegex with type annotations/:
--
-- @
-- [r|hogehoge|] == (makeRegex ("hogehoge" :: String) :: Regex)
-- @
--
-- The /Regex/ type signature in the above example, is the type
-- which is named as /Regex/ in this translation unit.
-- Therefore, you can choose Regex type by changing imports.
--
-- For example, the /exp/ variable in the below example has the type of Text.Regex.Posix.Regex:
--
-- @
-- import Text.Regex.Posix (Regex)
-- exp = [r|hoge|]
-- @
--
-- and, the /exp/ variable in below example has the type of Text.Regex.PCRE.Regex:
--
-- @
-- import Text.Regex.PCRE (Regex)
-- exp = [r|hoge|]
-- @
r :: QuasiQuoter
r :: QuasiQuoter
r = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = \String
str -> do
           Exp
mk <- [|makeRegex|]
           Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> Q Exp) -> Exp -> Q Exp
forall a b. (a -> b) -> a -> b
$ Exp
mk Exp -> Exp -> Exp
`AppE` (Lit -> Exp
LitE (String -> Lit
StringL String
str) Exp -> Type -> Exp
`SigE` Name -> Type
ConT ''String) Exp -> Type -> Exp
`SigE` Name -> Type
ConT (String -> Name
mkName String
"Regex")
    , quotePat :: String -> Q Pat
quotePat = String -> String -> Q Pat
forall a. HasCallStack => String -> a
error String
"quotePat is not defined"
    , quoteType :: String -> Q Type
quoteType = String -> String -> Q Type
forall a. HasCallStack => String -> a
error String
"quoteType is not defined"
    , quoteDec :: String -> Q [Dec]
quoteDec = String -> String -> Q [Dec]
forall a. HasCallStack => String -> a
error String
"quoteDec is not defined"
    }