如何使用Template Haskell生成带辅助构造函数的newtype包装器

首先需要开启TemplateHaskell扩展并导入相关依赖：

{-# LANGUAGE TemplateHaskell #-}
import Language.Haskell.TH
import Data.Char (toLower)

type UID = Integer

wrapUID :: String -> Q [Dec]
wrapUID n = do
  -- 生成原有的newtype类型声明
  newtypeDec <- dataD (cxt []) 
                      typeName
                      []
                      Nothing
                      [normalC typeName 
                        [bangType (bang noSourceUnpackedness noSourceStrictness)
                        [t| UID |]]]
                      []
  -- 生成辅助构造函数的类型签名
  funSig <- sigD funName [t| forall a. Integral a => a -> $(conT typeName) |]
  -- 生成辅助构造函数的实现逻辑
  funImpl <- funD funName
    [ clause []
      (normalB [| $(conE typeName) . fromInteger |])
      []
    ]
  return [newtypeDec, funSig, funImpl]
  where
    typeName = mkName n
    -- 自动将类型名首字母转小写，生成对应的构造函数名
    funName = mkName $ case n of
      (c:cs) -> toLower c : cs
      [] -> error "wrapUID: 传入的类型名称不能为空"

在需要生成ID包装类型的模块直接调用TH函数即可：

-- 调用后会自动生成两组代码：
-- 1. newtype MyRecordID = MyRecordID UID
-- 2. myRecordID :: Integral a => a -> MyRecordID
--    myRecordID = MyRecordID . fromInteger
$(wrapUID "MyRecordID")

• 注意：传入wrapUID的字符串必须为大驼峰格式的类型名，函数会自动转换首字母大小写生成符合命名规范的辅助构造函数。
• 生成的辅助构造函数可直接接收任意Integral类型入参，包括数据库返回的Int32类型，无需额外手动做类型转换。

内容的提问来源于stack exchange，提问作者GTF