[commit: ghc] master: Add namePackage function to template-haskell (77662e1)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/77662e13a510ddbc89fea00785e99f5f4d3a2b25/ghc

>---------------------------------------------------------------

commit 77662e13a510ddbc89fea00785e99f5f4d3a2b25
Author: RyanGlScott <ryan.gl.scott at gmail.com>
Date:   Thu Sep 17 23:15:26 2015 +0200

    Add namePackage function to template-haskell
    
    Currently there exists a nameBase function (for retrieving a Name's OccName)
    and a nameModule function (for retrieving a Name's ModName), but there is no
    counterpart for PkgNames.
    
    This would be useful for implementing Template Haskell features which need
    to have easy access to a Name's package (e.g., automatically derived Lift
    instances).
    
    Reviewed By: goldfire, austin, thomie
    
    Differential Revision: https://phabricator.haskell.org/D1237


>---------------------------------------------------------------

77662e13a510ddbc89fea00785e99f5f4d3a2b25
 libraries/template-haskell/Language/Haskell/TH.hs  |  1 +
 .../template-haskell/Language/Haskell/TH/Syntax.hs | 36 ++++++++++++++++++++--
 libraries/template-haskell/changelog.md            |  2 ++
 testsuite/tests/th/TH_namePackage.hs               | 23 ++++++++++++++
 testsuite/tests/th/TH_namePackage.stdout           |  9 ++++++
 testsuite/tests/th/all.T                           |  1 +
 6 files changed, 70 insertions(+), 2 deletions(-)

diff --git a/libraries/template-haskell/Language/Haskell/TH.hs b/libraries/template-haskell/Language/Haskell/TH.hs
index 4db92b7..bce8bf5 100644
--- a/libraries/template-haskell/Language/Haskell/TH.hs
+++ b/libraries/template-haskell/Language/Haskell/TH.hs
@@ -50,6 +50,7 @@ module Language.Haskell.TH(
         -- ** Deconstructing names
         nameBase,       -- :: Name -> String
         nameModule,     -- :: Name -> Maybe String
+        namePackage,    -- :: Name -> Maybe String
         -- ** Built-in names
         tupleTypeName, tupleDataName,   -- Int -> Name
         unboxedTupleTypeName, unboxedTupleDataName, -- :: Int -> Name
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index 82e22dd..48f3f96 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -842,16 +842,48 @@ data NameSpace = VarName        -- ^ Variables
 
 type Uniq = Int
 
--- | The name without its module prefix
+-- | The name without its module prefix.
+--
+-- ==== __Examples__
+--
+-- >>> nameBase ''Data.Either.Either
+-- "Either"
+-- >>> nameBase (mkName "foo")
+-- "foo"
+-- >>> nameBase (mkName "Module.foo")
+-- "foo"
 nameBase :: Name -> String
 nameBase (Name occ _) = occString occ
 
--- | Module prefix of a name, if it exists
+-- | Module prefix of a name, if it exists.
+--
+-- ==== __Examples__
+--
+-- >>> nameModule ''Data.Either.Either"
+-- Just "Data.Either"
+-- >>> nameModule (mkName "foo")
+-- Nothing
+-- >>> nameModule (mkName "Module.foo")
+-- Just "Module"
 nameModule :: Name -> Maybe String
 nameModule (Name _ (NameQ m))     = Just (modString m)
 nameModule (Name _ (NameG _ _ m)) = Just (modString m)
 nameModule _                      = Nothing
 
+-- | A name's package, if it exists.
+--
+-- ==== __Examples__
+--
+-- >>> namePackage ''Data.Either.Either"
+-- Just "base"
+-- >>> namePackage (mkName "foo")
+-- Nothing
+-- >>> namePackage (mkName "Module.foo")
+-- Nothing
+namePackage :: Name -> Maybe String
+namePackage (Name _ (NameG _ p _)) = Just (pkgString p)
+namePackage _                      = Nothing
+
 {- |
 Generate a capturable name. Occurrences of such names will be
 resolved according to the Haskell scoping rules at the occurrence
diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md
index 3620d22..fb701ab 100644
--- a/libraries/template-haskell/changelog.md
+++ b/libraries/template-haskell/changelog.md
@@ -10,6 +10,8 @@
     according to the fixities of the operators. The `ParensT` constructor can be
     used to explicitly group expressions.
 
+  * Add `namePackage`
+
   * TODO: document API changes and important bugfixes
 
 
diff --git a/testsuite/tests/th/TH_namePackage.hs b/testsuite/tests/th/TH_namePackage.hs
new file mode 100644
index 0000000..7c4a541
--- /dev/null
+++ b/testsuite/tests/th/TH_namePackage.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Main where
+
+import Language.Haskell.TH
+
+eitherName, fooName, moduleFooName :: Name
+eitherName = ''Either
+fooName = mkName "foo"
+moduleFooName = mkName "Module.foo"
+
+main :: IO ()
+main = do
+  print $ nameBase eitherName
+  print $ nameBase fooName
+  print $ nameBase moduleFooName
+
+  print $ nameModule eitherName
+  print $ nameModule fooName
+  print $ nameModule moduleFooName
+
+  print $ namePackage eitherName
+  print $ namePackage fooName
+  print $ namePackage moduleFooName
diff --git a/testsuite/tests/th/TH_namePackage.stdout b/testsuite/tests/th/TH_namePackage.stdout
new file mode 100644
index 0000000..b6890dd
--- /dev/null
+++ b/testsuite/tests/th/TH_namePackage.stdout
@@ -0,0 +1,9 @@
+"Either"
+"foo"
+"foo"
+Just "Data.Either"
+Nothing
+Just "Module"
+Just "base"
+Nothing
+Nothing
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index dada44a..eea0fa9 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -352,3 +352,4 @@ test('T10704',
      multimod_compile_and_run,
      ['T10704', '-v0'])
 test('T6018th', normal, compile_fail, ['-v0'])
+test('TH_namePackage', normal, compile_and_run, ['-v0'])