Как создать импорт и стандартные списки, используя 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

Я новичок в Template Haskell, и я был бы признателен за любую помощь / предложения о том, гдеНачнем с этих вопросов:

1. Как вывести список модулей в проекте, которые соответствуют шаблону /Y\d\dD\d\d.*/?
2. Как создать импорт для p.1?
3. Как получить типы solve1 и solve2 fns из данного модуля?
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)

Для вопроса (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