-- | This module defines quasiquoters for haskell-src-exts expressions and -- declarations. -- -- Antiquotations steal the splice syntax of Template Haskell, so for -- example example 'x' appears antiquoted in @[$hs| $x ++ $(Hs.strE \"bar\") |]@. -- Expressions appearing inside parenthesized splices are limited to concrete -- syntax expressible by Template Haskell's 'Exp' data type. -- -- Names in patterns can also be antiquoted, using double parentheses. For -- instance: -- -- > let x = Hs.name "n" in [hs| \ ((x)) -> $(Hs.Var (Hs.UnQual x)) + 1 |] -- -- Alternatively, one can use the double underscore syntax, useful when -- antiquoting a function name as in the following: -- -- > let f = "incr" -- > fE = Hs.Var $ Hs.UnQual $ Hs.name f -- > in [hs| let __f__ x = x + 1 in $fE 10 |] -- -- The double parentheses syntax is also used for antiquoting types. For -- instance: -- -- > let typ = Hs.TyCon (Hs.UnQual $ Hs.name "Int") -- > in [hs| 1 :: ((typ)) |] -- -- In a pattern context, antiquotations use the same syntax. module Language.Haskell.Exts.QQ ( hs , dec , decs , pat , ty , hsWithMode , decWithMode , decsWithMode , patWithMode , tyWithMode ) where import qualified Language.Haskell.Exts as Hs import qualified Language.Haskell.Meta.Syntax.Translate as Hs import Language.Haskell.TH.Syntax import Language.Haskell.TH.Quote import Language.Haskell.TH.Lib import Data.Generics import Data.List (intercalate, isPrefixOf, isSuffixOf) allExtensions :: Hs.ParseMode allExtensions = Hs.defaultParseMode{Hs.extensions = known} where #if MIN_VERSION_haskell_src_exts(1,14,0) known = [ext | ext@Hs.EnableExtension{} <- Hs.knownExtensions] #else known = Hs.knownExtensions #endif -- | A quasiquoter for expressions. All Haskell extensions known by -- haskell-src-exts are activated by default. hs :: QuasiQuoter hs = hsWithMode allExtensions -- | A quasiquoter for types. All Haskell extensions known by -- haskell-src-exts are activated by default. ty :: QuasiQuoter ty = tyWithMode allExtensions -- | A quasiquoter for a single top-level declaration. dec :: QuasiQuoter dec = decWithMode allExtensions -- | A quasiquoter for multiple top-level declarations. decs :: QuasiQuoter decs = decsWithMode allExtensions -- | A quasiquoter for patterns pat :: QuasiQuoter pat = patWithMode allExtensions -- | Rather than importing the above quasiquoters, one can create custom -- quasiquoters with a customized 'ParseMode' using this function. -- -- > hs = hsWithMode mode -- > dec = decWithMode mode -- > decs = decsWithMode mode hsWithMode :: Hs.ParseMode -> QuasiQuoter hsWithMode = qq . Hs.parseExpWithMode decWithMode :: Hs.ParseMode -> QuasiQuoter decWithMode = qq . Hs.parseDeclWithMode decsWithMode :: Hs.ParseMode -> QuasiQuoter decsWithMode mode = qq $ \src -> fmap strip $ Hs.parseModuleWithMode mode src where -- Implementation note, to parse multiple decls it's (ab)used that a -- listing of decls (possibly with import istatements and other extras) -- is a valid module. strip :: Hs.Module -> [Hs.Decl] strip (Hs.Module _ _ _ _ _ _ decs) = decs tyWithMode :: Hs.ParseMode -> QuasiQuoter tyWithMode = qq . Hs.parseTypeWithMode patWithMode :: Hs.ParseMode -> QuasiQuoter patWithMode = qq . Hs.parsePatWithMode qq :: Data a => (String -> Hs.ParseResult a) -> QuasiQuoter qq parser = QuasiQuoter { quoteExp = parser `project` antiquoteExp , quotePat = parser `project` antiquotePat #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 613 , quoteType = error "Unimplemented." , quoteDec = error "Unimplemented." #endif } project f k s = case f s of Hs.ParseOk x -> k x Hs.ParseFailed loc err -> fail err -- | The generic functions in 'Language.Haskell.TH.Quote' don't use global -- names for syntax constructors previous to GHC 7.4.1. This has the unfortunate -- effect of breaking quotation when the haskell-src-exts syntax module is -- imported qualified. The solution is to set the flavour of all names to -- 'NameG' on older versions of GHC. -- See also . qualify :: Name -> Name #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 704 -- Need special cases for constructors used in string literals. Assume nearly -- all else is a datatype defined in Syntax module of haskell-src-exts. qualify n | ":" <- nameBase n = '(:) | "[]" <- nameBase n = '[] | "(,)" <- nameBase n = '(,) | "Nothing" <- nameBase n = 'Nothing | "Just" <- nameBase n = 'Just | "True" <- nameBase n = 'True | "False" <- nameBase n = 'False | "Left" <- nameBase n = 'Left | "Right" <- nameBase n = 'Right | "LT" <- nameBase n = 'LT | "EQ" <- nameBase n = 'EQ -- GT is also exported by Data.Generics | "GT" <- nameBase n = 'Prelude.GT | "SrcLoc" <- nameBase n = 'Hs.SrcLoc | "Boxed" <- nameBase n = 'Hs.Boxed | otherwise = Name (mkOccName (nameBase n)) flavour where pkg = "haskell-src-exts-" ++ VERSION_haskell_src_exts flavour = NameG VarName (mkPkgName pkg) (mkModName "Language.Haskell.Exts.Syntax") #else qualify n = n #endif antiquoteExp :: Data a => a -> Q Exp antiquoteExp t = dataToQa (conE . qualify) litE (foldl appE) (const Nothing `extQ` antiE `extQ` antiP `extQ` antiN `extQ` antiT) t where antiE (Hs.SpliceExp (Hs.IdSplice v)) = Just $ varE $ mkName v antiE (Hs.SpliceExp (Hs.ParenSplice e)) = Just $ return $ Hs.toExp e antiE _ = Nothing antiP (Hs.PParen (Hs.PParen (Hs.PVar (Hs.Ident n)))) = Just $ appE [| Hs.PVar |] (varE (mkName n)) antiP _ = Nothing antiT (Hs.TyParen (Hs.TyParen (Hs.TyVar (Hs.Ident n)))) = Just . varE $ mkName n antiT _ = Nothing antiN (Hs.Ident n) | "__" `isPrefixOf` n, "__" `isSuffixOf` n = let nn = take (length n - 4) (drop 2 n) in Just $ appE [| Hs.Ident |] (varE (mkName nn)) antiN _ = Nothing antiquotePat :: Data a => a -> Q Pat antiquotePat = dataToQa qualify litP conP (const Nothing `extQ` antiP) where antiP (Hs.PParen (Hs.PParen (Hs.PVar (Hs.Ident n)))) = Just $ conP 'Hs.PVar [varP (mkName n)] antiP _ = Nothing