arsen.hs

{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE LambdaCase #-}

import Control.Lens.Plated
import Control.Lens
import Language.Haskell.TH
import Control.Lens.Extras
import Debug.Trace

data UD = UD
data TSD = TSD


decorateAST t tsd = do
  tinst <- [d| type instance TSD UD = () |]
  der <- [d|deriving instance (Show (TSD d)) => Show ($(conT t) d)|]

  let f :: Type -> Type
      f = transform $ \case
                ConT t | traceShow (t, 'TSD, t == 'TSD) $ t == 'TSD -> ConT tsd
                x -> x
  pure $ tinst ++ der & template %~ f
{-

ghci> decorateAST 'UD 'UD
[TySynInstD (TySynEqn Nothing (AppT (Main.TSD,Main.TSD,False)
(ConT Main.TSD) (Main.UD,Main.TSD,False)
(ConT Main.UD)) (TupleT 0)),StandaloneDerivD Nothing [AppT (GHC.Show.Show,Main.TSD,False)
(ConT GHC.Show.Show) (AppT (Main.TSD,Main.TSD,False)
(ConT Main.TSD) (VarT d_2))] (AppT (GHC.Show.Show,Main.TSD,False)
(ConT GHC.Show.Show) (AppT (Main.UD,Main.TSD,False)
(ConT Main.UD) (VarT d_2)))]
-}