3
> {-# LANGUAGE TemplateHaskell #-}
> import Language.Haskell.TH
> import Control.Monad

Let's say I have a class like Default

> class Default a where
>  def :: a

There's a straightforward way to define instances for types that also have a Monoid instance, like

instance Monoid a => Default a where
  def = mempty

but because of the overlapping problem and to make this more controllable one might provide a TH macro instead.

(Yes, I know we could use -XDerivingVia, I'm not interested in such a solution here.)

> makeMonoidDefault :: Q Type -> DecsQ
> makeMonoidDefault instT = sequence
>   [ InstanceD Nothing [] <$> [t| Default $instT |] <*> [d|
>         $(varP $ mkName "def") = mempty |] ]

This can than be invoked easily with a quoted type, like

makeMonoidDefault [t| Maybe () |]

to allow

*Main> def :: Maybe ()
Nothing

But this does not allow something like the parameterised instance

instance Semigroup a => Default (Maybe a) where
  def = mempty

That could be done with another macro:

> makeMonoidDefault' :: Q (Cxt,Type) -> DecsQ
> makeMonoidDefault' cxtInstT = do
>  (cxt, instT) <- cxtInstT
>  sequence
>   [ InstanceD Nothing cxt <*> [t| Default $(pure instT) |] <*> [d|
>         $(varP $ mkName "def") = mempty |] ]

But this is now much more awkward to actually use:

makeMonoidDefault' $ do
   tParam <- pure . VarT <$> newName "a"
   sgcxt <- [t| Semigroup $tParam |]
   maybet <- [t| Maybe $tParam |]
   return ([sgcxt], maybet)

or

makeMonoidDefault' $ do
   tParam <- pure . VarT <$> newName "a"
   ((,) . (:[])) <$> [t| Semigroup $tParam |]
                 <*> [t| Maybe $tParam |]
  • Is there a way to write this without explicitly using VarT and applicative combinators, preferrably in a single quotation?
  • Should the argument of makeMonoidDefault' be something other than Q (Cxt, Type)?
leftaroundabout
  • 117,950
  • 5
  • 174
  • 319
  • BTW, another thing I find dubious is `$(varP $ mkName "def")` for the method declaration in the macro. Just writing `def = mempty` there does not work. – leftaroundabout May 25 '21 at 13:55
  • Why not `makeMonoidDefault' :: Q Type -> Q Type -> DecsQ`? You can then pattern-match on the type to make it a `Cxt`. – Li-yao Xia May 25 '21 at 14:01
  • @Li-yaoXia both context and type need to be in the same monadic context, invoking the same `newName "a"`. And I don't really understand what you want to pattern-match. – leftaroundabout May 25 '21 at 14:05
  • I meant if the context needed to be more than one element long, then you could pattern-match a tuple to unpack it. Though maybe that's unnecessary because maybe the tuple is already fine as a constraint. – Li-yao Xia May 25 '21 at 15:40

3 Answers3

3

A hacky solution I came up with is this:

-- Quote.hs
{-# LANGUAGE TemplateHaskell #-}
module Quote where

import Language.Haskell.TH

class Default a where
  def :: a

makeMonoidDefault' :: Q Type -> DecsQ
makeMonoidDefault' q = do
  t <- q
  case t of
    ForallT _ cxt instT -> sequence
      [ InstanceD Nothing cxt <$> [t| Default $(pure instT) |] <*> [d|
            $(varP 'def) = mempty |] ]
    _ -> fail "<some nice error message>"

Then you can use it like this:

-- Main.hs
{-# LANGUAGE TemplateHaskell, ExplicitForAll #-}
import Quote

makeMonoidDefault' [t|forall a. Semigroup a => Maybe a|]

main = pure ()
Noughtmare
  • 9,410
  • 1
  • 12
  • 38
  • I like how this looks a lot! But is there anything that could go badly wrong with this approach? – leftaroundabout May 25 '21 at 15:09
  • @leftaroundabout I just changed `mkName "def"` to `'def` that should avoid accidentally capturing the wrong `def`. I can't think of anything else obvious that could go wrong. – Noughtmare May 25 '21 at 15:17
2

Building off of @Noughtmare's solution, you can do more in the quotation bracket:

{-# LANGUAGE ConstraintKinds #-}

makeMonoidDefault :: Q Type -> DecsQ
makeMonoidDefault q = do
  t <- q
  let (ctx, instT) = case t of
        ForallT _ ctx instT -> (ctx, instT)
        _ -> ([], t)
  [d|
    instance $(pure $ foldCtx ctx) => Default $(pure instT) where
      def = mempty
    |]
  where
    foldCtx l = foldl AppT (TupleT $ length l) l

It can be used in any of these ways:

makeMonoidDefault [t|forall a. Semigroup a => Maybe a|]
makeMonoidDefault [t|forall a b. (Monoid a, Monoid b) => (a,b)|]
makeMonoidDefault [t|Maybe ()|]

and it no longer has the weird bit about def. (By the way, the ConstraintKinds pragma is required for the case where this is no context, and the generated context is ().)

DDub
  • 3,884
  • 1
  • 5
  • 12
  • 1
    Neat! Still, folding the `Cxt` list just to generate a tuple à la ConstraintKinds in the instance quotation is a bit convoluted. – All these use cases would also work with `InstanceD Nothing cxt ...`, right? – leftaroundabout May 25 '21 at 20:51
  • 1
    Yes! The instances generated here should be the same as those generated by @Noughtmare's. The only way I could figure out to make `def` work without wrapping it with `varP` is to put the whole `instance` in the same quotation block. But, to do that, I needed to insert the context in its own splice, which required the constraint tuple. I suppose it's just moving the "convolutedness" from one spot to another. – DDub May 25 '21 at 20:56
0

One option would be to change up the design a bit. For instance:

makeMonoidDefault [d| instance Semigroup a => Default (Maybe a) |]

This is a bit redundant in that it mentions Default twice. (And you really should check that it actually does declare the class you expect it to.) But on the plus side, it gives you a lot of the structure you need as part of the argument.

Carl
  • 26,500
  • 4
  • 65
  • 86