Support {-# SOURCE #-} imports. (#58)

Also adds a unit test for this feature, and a TODO to add more tests
of `module'` and `import'`.

src/GHC/SourceGen/Module.hs

@@ -17,6 +17,7 @@ module GHC.SourceGen.Module
     , import'
     , exposing
     , hiding
+    , source
       -- * Imported/exported things
     , IE'
     , thingAll
@@ -70,6 +71,10 @@ hiding :: ImportDecl' -> [IE'] -> ImportDecl'
 hiding d ies = d
     { ideclHiding = Just (True, builtLoc $ map builtLoc ies) }
 
+-- | Adds the @{-# SOURCE #-}@ pragma to an import.
+source :: ImportDecl' -> ImportDecl'
+source d = d { ideclSource = True }
+
 -- | Exports all methods and/or constructors.
 --
 -- > A(..)

tests/pprint_test.hs

@@ -35,14 +35,21 @@ testDecls = testCases
 testPats :: DynFlags ->  String -> [TestCase Pat'] -> TestTree
 testPats = testCases
 
+testModule :: DynFlags -> String -> [TestCase HsModule'] -> TestTree
+testModule = testCases
 
 main :: IO ()
 main = runGhc (Just libdir) $ do
     dflags <- getDynFlags
     liftIO $ defaultMain $ testGroup "Tests"
-        [typesTest dflags, exprsTest dflags, declsTest dflags, patsTest dflags]
+        [ typesTest dflags
+        , exprsTest dflags
+        , declsTest dflags
+        , patsTest dflags
+        , modulesTest dflags
+        ]
 
-typesTest, exprsTest, declsTest, patsTest :: DynFlags -> TestTree
+typesTest, exprsTest, declsTest, patsTest, modulesTest :: DynFlags -> TestTree
 typesTest dflags = testGroup "Type"
     [ test "var"
         [ "A" :~ var "A"
@@ -324,3 +331,15 @@ patsTest dflags = testGroup "Pats"
   where
     test = testPats dflags
 
+-- TODO: Add more test cases from pprint_examples.hs.
+modulesTest dflags = testGroup "Modules"
+    [ test "import"
+        [ "import M" :~
+            module' Nothing Nothing [import' "M"] []
+        , "import {-# SOURCE #-} M" :~
+            module' Nothing Nothing
+                [source $ import' "M"] []
+        ]
+    ]
+  where
+    test = testModule dflags