ClassSynonym.hs

1
2
3
4
5
6
7
8
9
10
11
12
13
14
{-# LANGUAGE TemplateHaskell #-}
module Lib.ClassSynonyms where

import Language.Haskell.TH

classSynonym :: Name -> Q [Dec]
classSynonym x = do
    ClassI d <- reify x
    return $ case d of
        ClassD ctx name vs _ decl -> [InstanceD ctx (foldl AppT (ConT name) $ map tV2varT vs) decl]
        _ -> []
    where
        tV2varT (PlainTV name) = VarT name
        tV2varT (KindedTV name _) = VarT name