如何使用 Template 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 模板的新手，如果您能提供有关从哪里开始解决这些问题的帮助/建议，我将不胜感激：

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

Answer 1

关于问题（2），Template Haskell 无法生成import语句。您可以在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)

M001对于问题 (4)，这是一个使用模块并如上面定义的简化示例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