Allow annotations though addTopDecls (#10486)
authorMichael Smith <michael@diglumi.com>
Wed, 2 Sep 2015 11:56:27 +0000 (13:56 +0200)
committerBen Gamari <ben@smart-cactus.org>
Wed, 2 Sep 2015 11:56:31 +0000 (13:56 +0200)
addTopDecls restricts what declarations it can be used to add. Adding
annotations via this method works fine with no special changes apart
from adding AnnD to the declaration whitelist.

Test Plan: validate

Reviewers: austin, goldfire, bgamari

Reviewed By: bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1201

GHC Trac Issues: #10486

compiler/typecheck/TcSplice.hs
docs/users_guide/7.12.1-notes.xml
testsuite/tests/annotations/should_compile/th/TestModuleTH.hs
testsuite/tests/annotations/should_compile/th/annth_compunits.stdout
testsuite/tests/annotations/should_compile/th/annth_make.stdout

index 7c9882b..a018e4a 100644 (file)
@@ -817,10 +817,12 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where
         = mapM_ bindName (collectHsBindBinders binds)
       checkTopDecl (SigD _)
         = return ()
+      checkTopDecl (AnnD _)
+        = return ()
       checkTopDecl (ForD (ForeignImport (L _ name) _ _ _))
         = bindName name
       checkTopDecl _
-        = addErr $ text "Only function, value, and foreign import declarations may be added with addTopDecl"
+        = addErr $ text "Only function, value, annotation, and foreign import declarations may be added with addTopDecl"
 
       bindName :: RdrName -> TcM ()
       bindName (Exact n)
index 5829666..3916e71 100644 (file)
                      char literals.
                 </para>
             </listitem>
+             <listitem>
+                 <para>
+                     <literal>addTopDecls</literal> now accepts annotation
+                     pragmas.
+                </para>
+            </listitem>
        </itemizedlist>
     </sect3>
 
index f21b137..715cc25 100644 (file)
@@ -3,16 +3,26 @@
 module TestModuleTH where
 
 import Language.Haskell.TH
+import Language.Haskell.TH.Syntax (addTopDecls)
 
 $(do
      modAnn <- pragAnnD ModuleAnnotation
                         (stringE "TH module annotation")
+     modAnn' <- pragAnnD ModuleAnnotation
+                         (stringE "addTopDecls module annotation")
      [typ] <- [d| data TestTypeTH = TestTypeTH |]
      conAnn <- pragAnnD (ValueAnnotation $ mkName "TestTypeTH")
                         (stringE "TH Constructor annotation")
+     conAnn' <- pragAnnD (ValueAnnotation $ mkName "TestTypeTH")
+                         (stringE "addTopDecls Constructor annotation")
      typAnn <- pragAnnD (TypeAnnotation $ mkName "TestTypeTH")
                         (stringE "TH Type annotation")
+     typAnn' <- pragAnnD (TypeAnnotation $ mkName "TestTypeTH")
+                         (stringE "addTopDecls Type annotation")
      valAnn <- pragAnnD (ValueAnnotation $ mkName "testValueTH")
                         (stringE "TH Value annotation")
+     valAnn' <- pragAnnD (ValueAnnotation $ mkName "testValueTH")
+                         (stringE "addTopDecls value annotation")
      [val] <- [d| testValueTH = (42 :: Int) |]
+     addTopDecls [modAnn', conAnn', typAnn', valAnn']
      return [modAnn, conAnn, typAnn, typ, valAnn, val] )
index 96e4642..51fa405 100644 (file)
@@ -1,7 +1,7 @@
-["TH module annotation","Module annotation"]
+["TH module annotation","addTopDecls module annotation","Module annotation"]
 ["Value annotation"]
-["TH Value annotation"]
+["TH Value annotation","addTopDecls value annotation"]
 ["Type annotation"]
-["TH Type annotation"]
+["TH Type annotation","addTopDecls Type annotation"]
 ["Constructor annotation"]
-["TH Constructor annotation"]
+["TH Constructor annotation","addTopDecls Constructor annotation"]
index 96e4642..51fa405 100644 (file)
@@ -1,7 +1,7 @@
-["TH module annotation","Module annotation"]
+["TH module annotation","addTopDecls module annotation","Module annotation"]
 ["Value annotation"]
-["TH Value annotation"]
+["TH Value annotation","addTopDecls value annotation"]
 ["Type annotation"]
-["TH Type annotation"]
+["TH Type annotation","addTopDecls Type annotation"]
 ["Constructor annotation"]
-["TH Constructor annotation"]
+["TH Constructor annotation","addTopDecls Constructor annotation"]