6

I'm just getting started with template haskell.

I've written a function that takes a function a -> [b] and generates an expression for a function b -> a:

{-# OPTIONS_GHC -Wall -Wextra -Werror #-}
module Surjection where
import Language.Haskell.TH
import Data.Traversable

surj :: (Show a, Show b, Bounded a, Enum a) => (a -> [b]) -> Q Exp -- Q (TExp (b -> a))
surj f = fmap (LamCaseE . concat) .                             -- \case 
  forM [minBound .. maxBound] $ \a -> do
    Just aName <- lookupValueName (show a)
    forM (f a) $ \b -> do
      Just bName <- lookupValueName (show b)
      return $ Match (ConP bName []) (NormalB (ConE aName)) [] --     $(bName) -> $(aName)

This works, but it'd be nice if I could promise that it returns a function of that type, that is have it return a Q (TExp (b -> a)) rather than a Q Exp.

Everything I've seen thus far about generating typed expressions uses splices and quasiquotes. Is there a way to generate it from template haskell constructors?

rampion
  • 87,131
  • 49
  • 199
  • 315

1 Answers1

1

Oh hey, there's a TExp :: Exp -> TExp a constructor in Language.Haskell.TH.Syntax, so I can just use that:

surj f = fmap (TExp . LamCaseE . concat) ...

There's the downside that the type specified by TExp only gets checked at splice time (kind of like a C++ template), but that's inherent to TH.

rampion
  • 87,131
  • 49
  • 199
  • 315
  • While this works, it's basically circumventing the exact benefits that using typed Template Haskell is supposed to provide. – Joseph Sible-Reinstate Monica Mar 30 '20 at 03:37
  • @JosephSible-ReinstateMonica : Agreed! I would much rather be able work with primitives like `a -> Q (TPat a)` and `a -> Q (TExp a)` and `TLamCase`, `TMatch`, etc. but those don't seem to exist. – rampion Mar 30 '20 at 23:51
  • The only kind of typed things in Template Haskell are typed expressions, not typed patterns, so there's no `TPat`, and so I think it's impossible to make any such primitives. – Joseph Sible-Reinstate Monica Mar 31 '20 at 00:21