如何使用模板 Haskell 生成导入和样板列表？

Question

我想用代码生成替换这个样板文件：

import qualified Y15.D01
import qualified Y15.D02
import qualified Y15.D03
import qualified Y15.D04
import qualified Y15.D05
import qualified Y15.D06HM
import qualified Y15.D06IO
import qualified Y15.D06ST
import qualified Y15.D07
import qualified Y15.D08
import qualified Y15.D09
import qualified Y15.D10
import qualified Y15.D11
import qualified Y15.D12
import qualified Y15.D13

...

days :: [(String, [String -> IO String])]
days =
    [ ("Y15.D01",  i2ios   [Y15.D01.solve1,   Y15.D01.solve2])
    , ("Y15.D02",  i2ios   [Y15.D02.solve1,   Y15.D02.solve2])
    , ("Y15.D03",  i2ios   [Y15.D03.solve1,   Y15.D03.solve2])
    , ("Y15.D04",  i2ios   [Y15.D04.solve1,   Y15.D04.solve2])
    , ("Y15.D05",  i2ios   [Y15.D05.solve1,   Y15.D05.solve2])
    , ("Y15.D06HM",i2ios   [Y15.D06HM.solve1, Y15.D06HM.solve2]) -- Data.Map.Strict
    , ("Y15.D06IO",ioi2ios [Y15.D06IO.solve1, Y15.D06IO.solve2]) -- Data.Array.IO
    , ("Y15.D06ST",i2ios   [Y15.D06ST.solve1, Y15.D06ST.solve2]) -- Data.Array.ST
    , ("Y15.D07",  i2ios   [Y15.D07.solve1,   Y15.D07.solve2])
    , ("Y15.D08",  i2ios   [Y15.D08.solve1,   Y15.D08.solve2])
    , ("Y15.D09",  i2ios   [Y15.D09.solve1,   Y15.D09.solve2])
    , ("Y15.D10",  i2ios   [Y15.D10.solve1,   Y15.D10.solve2])
    , ("Y15.D11",  s2ios   [Y15.D11.solve1,   Y15.D11.solve2])
    , ("Y15.D12",  i2ios   [Y15.D12.solve1,   Y15.D12.solve2])
    , ("Y15.D13",  i2ios   [Y15.D13.solve1,   Y15.D13.solve2])
    ]
  where s2ios :: [a -> b] -> [a -> IO b]
        s2ios   = fmap (return .)
        i2ios :: [a -> Int] -> [a -> IO String]
        i2ios   = fmap ((return . show) .)
        ioi2ios :: [a -> IO Int] -> [a -> IO String]
        ioi2ios = fmap (fmap show .)

https://github.com/oshyshko/adventofcode/blob/master/src/Main.hs

我是模板 Haskell 的新手，非常感谢 help/suggestions 从哪里开始回答这些问题：

如何在项目中列出匹配 /Y\d\d.D\d\d.*/ 模式的模块？
如何为 p.1 生成导入？
如何从给定模块中检索 solve1 和 solve2 fns 的类型？
如何生成days列表？

Answer 1

关于问题(2)，模板Haskell无法生成import语句。您可以在 bug tracker on GitLab 中看到一个非常古老的功能请求，但没有人受到足够的启发来实现它。

关于问题(3)，如果模块已经被导入并且它们的名称以字符串形式提供，您可以像这样使用TH 来检索每个模块中的绑定类型。给定：

-- M001.hs
module M001 where
solve1 :: Int
solve1 = 10

-- M002.hs
module M002 where
solve1 :: IO Int
solve1 = return 20

-- THTest1.hs
{-# LANGUAGE TemplateHaskell #-}

module THTest1 where

import M001
import M002

import Language.Haskell.TH

let
  modules = ["M001", "M002"]

  showType :: String -> Q ()
  showType nm = do
    Just n <- lookupValueName nm
    VarI _ typ _ <- reify n
    reportWarning $ show nm ++ " has type " ++ show typ
    return ()

  in do mapM_ showType (map (++ ".solve1") modules)
        return []

然后编译THTest.hs会产生两个警告：

warning: "M001.solve1" has type ConT GHC.Types.Int
warning: "M002.solve1" has type AppT (ConT GHC.Types.IO)
     (ConT GHC.Types.Int)

对于问题 (4)，这是一个使用上面定义的模块 M001 和 M002 的简化示例。使用 ghc -ddump-splices 编译此程序以查看为 days:

生成的定义

-- THTest2.hs
{-# LANGUAGE TemplateHaskell #-}

import M001
import M002

import Control.Monad
import GHC.Types
import Language.Haskell.TH

let
  -- list of modules to search
  modules = ["M001", "M002"]
  -- assoc list of adapter function by argument type
  funcs = [(ConT ''Int, 'return), (AppT (ConT ''IO) (ConT ''Int), 'id)]

  getDay :: String -> Q Exp
  getDay modname = do
    -- look up name (e.g., M001.solve1)
    Just n <- lookupValueName (modname ++ ".solve1")
    -- get type of binding
    VarI _ typ _ <- reify n
    -- look up appropriate adapter function
    let Just f = lookup typ funcs
    -- ("M001", adapter_f M001.solve1)
    [|($(pure $ LitE (StringL modname)),
       $(pure $ AppE (VarE f) (VarE n)))|]

  makeDays :: Q [Dec]
  makeDays = do
    [d| days :: [(String, IO Int)]
        days = $(ListE <$> mapM getDay modules)
      |]
  in makeDays

main = do
  forM days $ \(modname, action) -> do
    putStr modname
    putStr ": "
    print =<< action

然后运行会输出：

M001: 10
M002: 20

如何使用模板 Haskell 生成导入和样板列表？

How to generate imports and boilerplate lists using Template Haskell?

haskell

code-generation

template-haskell