diff --git a/Language/Haskell/Exts/QQ.hs b/Language/Haskell/Exts/QQ.hs --- a/Language/Haskell/Exts/QQ.hs +++ b/Language/Haskell/Exts/QQ.hs @@ -18,9 +18,26 @@ -- > 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, ty, hsWithMode, decWithMode, tyWithMode) where +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 @@ -31,7 +48,13 @@ import Data.List (intercalate, isPrefixOf, isSuffixOf) allExtensions :: Hs.ParseMode -allExtensions = Hs.defaultParseMode{Hs.extensions = Hs.knownExtensions} +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. @@ -43,27 +66,48 @@ ty :: QuasiQuoter ty = tyWithMode allExtensions --- | A quasiquoter for top-level declarations. +-- | 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 = Hs.parsePat `project` antiquotePat + , quotePat = parser `project` antiquotePat #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 613 , quoteType = error "Unimplemented." , quoteDec = error "Unimplemented." @@ -75,10 +119,13 @@ Hs.ParseFailed loc err -> fail err -- | The generic functions in 'Language.Haskell.TH.Quote' don't use global --- names for syntax constructors. 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'. +-- 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 = '(:) @@ -86,22 +133,35 @@ | "(,)" <- 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) t + (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)) diff --git a/haskell-src-exts-qq.cabal b/haskell-src-exts-qq.cabal --- a/haskell-src-exts-qq.cabal +++ b/haskell-src-exts-qq.cabal @@ -1,5 +1,5 @@ Name: haskell-src-exts-qq -Version: 0.6.1 +Version: 0.7 Author: Mathieu Boespflug Maintainer: Mathieu Boespflug Synopsis: A quasiquoter for haskell-src-exts. @@ -7,40 +7,42 @@ Allows one to write programs that generate Haskell programs much more concisely and legibly. This package supports: . - * Antiquotations, denoted by stealing the splice syntax of - Template Haskell, for example @[hs| $x ++ $(Hs.strE "bar") |]@. - Splices may not nested. - . - * Antiquoting pattern variables in patterns, using double - parentheses. For instance: - . - > let x = Hs.name "n" in [hs| \ ((x)) -> $(Hs.Var (Hs.UnQual x)) + 1 |] - . - * Antiquoting bound names. Names that are antiquoted appear - surrounded by double underscores. For instance: - . - > let f = "incr" - > fE = Hs.Var $ Hs.UnQual $ Hs.name f - > in [hs| let __f__ x = x + 1 in $fE 10 |] + * term antiquotations, + * antiquoting pattern variables in patterns, + * antiquoting bound names, + * antiquotations in types. . - We need three different syntaxes for antiquotations, because we do - not extend the haskell-src-exts parser in any way and the Template - Haskell splicing syntax is only available in expression contexts. + Some types of splicing use custom syntax due to historical + reasons. This may change in future releases. Category: Language License: BSD3 License-File: LICENSE Cabal-Version: >= 1.10.0 Build-Type: Simple -Tested-With: GHC == 7.0.1 +Tested-With: GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==7.10.2 source-repository head type: git location: git://github.com/mboes/haskell-src-exts-qq library - Build-Depends: base >= 4 && < 5, syb, template-haskell, - haskell-src-exts >= 1.9.0, - haskell-src-meta >= 0.3 + Build-Depends: base >= 4 && < 5, syb, template-haskell, + haskell-src-exts >= 1.9.0, + haskell-src-meta >= 0.3 Default-Language: Haskell2010 Default-Extensions: TemplateHaskell, CPP Exposed-Modules: Language.Haskell.Exts.QQ + +test-suite tests + Type: exitcode-stdio-1.0 + Default-Language: Haskell2010 + Default-Extensions: CPP + QuasiQuotes + TemplateHaskell + Hs-Source-Dirs: tests + Main-Is: test.hs + Ghc-Options: -Wall + Build-Depends: base >= 4, + haskell-src-exts-qq, + haskell-src-exts >= 1.9, + hspec >= 1.11 diff --git a/tests/test.hs b/tests/test.hs new file mode 100644 --- /dev/null +++ b/tests/test.hs @@ -0,0 +1,27 @@ +import Language.Haskell.Exts.QQ + +import qualified Language.Haskell.Exts as Hs +import Test.Hspec + +main :: IO () +main = hspec $ do + describe "Term splices" $ do + it "Substitutes for splices in atomic terms" $ do + (\x -> [hs| $x |]) [hs| 10 |] `shouldBe` [hs| 10 |] + it "Substitutes for splices in composite terms" $ do + (\x -> [hs| $x + $x |]) [hs| 10 |] `shouldBe` [hs| 10 + 10 |] + + describe "Pattern name splices" $ do + it "Substitutes for splices in atomic patterns" $ do + (\x -> [hs| case 10 of ((x)) -> y |]) (Hs.name "y") + `shouldBe` [hs| case 10 of y -> y |] + it "Substitutes for splices in composite patterns" $ do + (\x -> [hs| let (Just ((x)), x) = (Just 10, 10) in y |]) (Hs.name "y") + `shouldBe` [hs| let (Just y, x) = (Just 10, 10) in y |] + + describe "type splices" $ do + it "Substitutes for splices in atomic types" $ do + (\x -> [hs| () :: ((x)) |]) [ty| () |] `shouldBe` [hs| () :: () |] + it "Substitutes for splices in composite types" $ do + (\x -> [hs| ((), ()) :: (((x)), ((x))) |]) [ty| () |] + `shouldBe` [hs| ((), ()) :: ((), ()) |]