{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RecordWildCards #-}
module QQLiterals (qqLiteral, QuasiQuoter) where
import Language.Haskell.TH (varE, Name)
import Language.Haskell.TH.Quote (QuasiQuoter(..))
qqLiteral :: (String -> Either String a) -> Name -> QuasiQuoter
qqLiteral :: (String -> Either String a) -> Name -> QuasiQuoter
qqLiteral String -> Either String a
parse Name
parseFn = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter {String -> Q [Dec]
String -> Q Exp
String -> Q Pat
String -> Q Type
forall p a. p -> Q a
quoteExp :: String -> Q Exp
quotePat :: String -> Q Pat
quoteDec :: String -> Q [Dec]
quoteType :: String -> Q Type
quoteDec :: forall p a. p -> Q a
quoteType :: forall p a. p -> Q a
quotePat :: forall p a. p -> Q a
quoteExp :: String -> Q Exp
..}
where
quoteExp :: String -> Q Exp
quoteExp String
str =
case String -> Either String a
parse String
str of
Right a
_ -> [| case $(varE parseFn) str of { Right x -> x; Left x -> error ("can't happen: " ++ show x)} |]
Left String
err -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
quotePat :: p -> Q a
quotePat = String -> p -> Q a
forall (m :: * -> *) p a. MonadFail m => String -> p -> m a
unsupported String
"pattern"
quoteType :: p -> Q a
quoteType = String -> p -> Q a
forall (m :: * -> *) p a. MonadFail m => String -> p -> m a
unsupported String
"type"
quoteDec :: p -> Q a
quoteDec = String -> p -> Q a
forall (m :: * -> *) p a. MonadFail m => String -> p -> m a
unsupported String
"declaration"
unsupported :: String -> p -> m a
unsupported String
context p
_ = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$
String
"Unsupported operation: this QuasiQuoter can not be used in a " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
context String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" context."