How to generate imports and boilerplate lists using Template Haskell?

Question

I'd like to replace this boilerplate with code generation:

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

I am new to Template Haskell and I would appreciate any help/suggestions on where to start with these questions:

How to list modules in a project that match /Y\d\d.D\d\d.*/ pattern?
How to generate imports for p.1?
How to retrieve types of solve1 and solve2 fns from a given module?
How to generate days list?

Personally, I would just leave it like this. From the code it's clear what you're doing and why, and you have more control over the individual cases if you need it. A TH solution would be more difficult to read and modify, and more prone to bugs (a number of Haskell's guarantees are lacking in TH). Bottom line, TH has a number of downsides, and you're only doing this one time, so it may not be worth it. I see TH as primarily useful in libraries (e.g. Yesod) where its use greatly simplifies the API, or significantly reduces user boilerplate. That's just my opinion though, your mileage may vary. — DarthFennec, May 31 '19 at 17:54
I doubt it's only going to be done this one time - this looks like a yearly endeavor for Advent of Code. So, I guess, 50 lines of code a year? TH still seems like a pretty poor ROI compared to doing it by hand, and indeed would be less clear in the end. — amalloy, May 31 '19 at 20:16
Thank you DarthFennec, amalloy. But I still want to do it and use this example for learning how good or bad TH can be. — oshyshko, May 31 '19 at 23:02

score 7 · Accepted Answer · answered Jun 01 '19 at 00:59

With respect to question (2), Template Haskell cannot generate import statements. You can see a very old feature request for it in the bug tracker on GitLab but no one's been sufficiently inspired to implement it.

With respect to question (3), if modules have been imported and their names are available as strings, you can use TH to retrieve the type of a binding in each module like so. Given:

-- 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 []

Then compiling THTest.hs will generate two warnings:

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

For question (4), here's a simplified example using modules M001 and M002 as defined above. Compile this program with ghc -ddump-splices to see the definition generated for 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

Then running it will output:

M001: 10
M002: 20

How to generate imports and boilerplate lists using Template Haskell?

1 Answers1