Add typeConstructorName function to template-haskellwip/lift-type-typeable

This helper function converts a Typeable type representation to a
Template Haskell type. This can be used to construct type-driven
Template Haskell programs.

For example ...

```
data User = User ...

makeLenses @User

deriveJSON @User
```

rather than accepting a Name which may not be from the type namespace.

Closes #20613

Co-authored-by: parsonsmatt <parsonsmatt@gmail.com>

4 files changed, 40 insertions, 1 deletions

diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index c219467337..c36568acf4 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -29,6 +29,7 @@ module Language.Haskell.TH.Syntax
     ) where
 
 import Data.Data hiding (Fixity(..))
+import Data.Typeable
 import Data.IORef
 import System.IO.Unsafe ( unsafePerformIO )
 import GHC.IO.Unsafe    ( unsafeDupableInterleaveIO )
@@ -60,6 +61,7 @@ import Prelude
 import Foreign.ForeignPtr
 import Foreign.C.String
 import Foreign.C.Types
+import Data.List (foldl')
 
 #if __GLASGOW_HASKELL__ >= 901
 import GHC.Types ( Levity(..) )
@@ -1406,6 +1408,24 @@ dataToPatQ = dataToQa id litP conP
                 _ -> error $ "Can't construct a pattern from name "
                           ++ showName n
 
+-- | Retrieve a @TemplateHaskell@ 'Name' for the constructor of a 'Typeable' type. Used to drive derivation:
+--
+-- @
+
+-- $(
+-- let
+--   prxy = Proxy :: Proxy Int
+-- in
+--   mobileGen (moatOptionsP prxy) (typeConstructorName prxy)
+--  )
+-- @
+typeConstructorName :: Typeable a => Proxy a -> Name
+typeConstructorName prxy =
+  let tyRep =
+        typeRep prxy
+      tyCon =
+        typeRepTyCon tyRep
+   in mkNameG TcClsName (tyConPackage tyCon) (tyConModule tyCon) (tyConName tyCon)
 -----------------------------------------------------
 --              Names and uniques
 -----------------------------------------------------
diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md
index f30c9df660..360126447c 100644
--- a/libraries/template-haskell/changelog.md
+++ b/libraries/template-haskell/changelog.md
@@ -3,9 +3,11 @@
 ## 2.19.0.0
 
   * Add `DefaultD` constructor to support Haskell `default` declarations.
-  * Add support for Overloaded Record Dot. 
+  * Add support for Overloaded Record Dot.
     Introduces `getFieldE :: Quote m => m Exp -> String -> m Exp` and
     `projectionE :: Quote m => [String] -> m Exp`.
+  * Add 'typeConstructorName' helper function which the TemplateHaskell 'Name' from
+    a Typeable type representation.
 
 ## 2.18.0.0
   * The types of `ConP` and `conP` have been changed to allow for an additional list
diff --git a/libraries/template-haskell/tests/all.T b/libraries/template-haskell/tests/all.T
index 48f05c64fa..918a6f8c1c 100644
--- a/libraries/template-haskell/tests/all.T
+++ b/libraries/template-haskell/tests/all.T
@@ -1,3 +1,4 @@
 # difficult to test TH with profiling, because we have to build twice
 test('dataToExpQUnit', [omit_ways(prof_ways), req_interp], compile, ['-v0'])
+test('typeToName', [omit_ways(prof_ways), req_interp], compile, ['-v0'])
 test('pragCompletePpr', [omit_ways(prof_ways), req_interp], compile_and_run, [''])
diff --git a/libraries/template-haskell/tests/typeToName.hs b/libraries/template-haskell/tests/typeToName.hs
new file mode 100644
index 0000000000..551de15978
--- /dev/null
+++ b/libraries/template-haskell/tests/typeToName.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+module TypeToName where
+
+import Language.Haskell.TH.Syntax
+import Data.Proxy
+
+main :: IO $(return $ ConT $ typeConstructorName (Proxy @()) )
+main = return ()
+
+foo :: IO $(return $ ConT $ typeConstructorName (Proxy @Int) )
+foo = return 0
+
+qux :: IO ($(return $ ConT $ typeConstructorName (Proxy @(Int, Int) )) Int Int)
+qux = return (3, 4)
+