Add namePackage function to template-haskell
authorRyanGlScott <ryan.gl.scott@gmail.com>
Thu, 17 Sep 2015 21:15:26 +0000 (23:15 +0200)
committerThomas Miedema <thomasmiedema@gmail.com>
Thu, 17 Sep 2015 21:15:42 +0000 (23:15 +0200)
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

libraries/template-haskell/Language/Haskell/TH.hs
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
libraries/template-haskell/changelog.md
testsuite/tests/th/TH_namePackage.hs [new file with mode: 0644]
testsuite/tests/th/TH_namePackage.stdout [new file with mode: 0644]
testsuite/tests/th/all.T

index 4db92b7..bce8bf5 100644 (file)
@@ -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
index 82e22dd..48f3f96 100644 (file)
@@ -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
index 3620d22..fb701ab 100644 (file)
@@ -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 (file)
index 0000000..7c4a541
--- /dev/null
@@ -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 (file)
index 0000000..b6890dd
--- /dev/null
@@ -0,0 +1,9 @@
+"Either"
+"foo"
+"foo"
+Just "Data.Either"
+Nothing
+Just "Module"
+Just "base"
+Nothing
+Nothing
index dada44a..eea0fa9 100644 (file)
@@ -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'])