Haskell: type constructor name as symbol

Render.hs

-- | Type constructor name
type TyConsName :: (Type -> Type) -> Symbol
type family TyConsName rep where
  TyConsName (D1 (MetaData tyConName _ _ _) _) = tyConName

-- | 'KnownSymbol s' for the 'TyConsName' of 'a'
type Render :: Type -> Constraint
type Render a = KnownSymbol (TyConsName (Rep a))

-- | Given a 'Generic a', returns the name of its type constructor.
render :: forall a. Render a => String
render = symbolVal (Proxy @(TyConsName (Rep a)))

TyConsName.hs

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Werror #-}
{-# OPTIONS_GHC -Wincomplete-patterns #-}

module Scratch where

import Data.Kind (Constraint, Type)
import Data.Proxy
import GHC.Generics
import GHC.TypeLits
import Data.Char (isUpper)

-- | Type constructor name
type TyConsName :: (Type -> Type) -> Symbol
type family TyConsName rep where
  TyConsName (D1 (MetaData tyConName _ _ _) _) = tyConName

-- | 'KnownSymbol s' for the 'TyConsName' of 'a'
type TyConsNameC a = KnownSymbol (TyConsName (Rep a))

-- | Given a 'Generic a', returns the name of its type constructor.
tyConsName :: forall a. TyConsNameC a => String
tyConsName = symbolVal (Proxy @(TyConsName (Rep a)))

-- | Class for rendering types.
type Render :: Type -> Constraint
class Render a where
  render :: String
  default render :: TyConsNameC a => String
  render = tyConsName @a

-- | Rendering options
data RenderOption
  = All
  | CapitalLetters

-- | Deriving via helper
type CustomRender :: RenderOption -> Type -> Type
data CustomRender option a = Custom {unCustom :: a}

instance forall a. TyConsNameC a => Render (CustomRender All a) where
  render = tyConsName @a

instance forall a. TyConsNameC a => Render (CustomRender CapitalLetters a) where
  render = filter isUpper $ tyConsName @a

data Example = Example {runExample :: String}
  deriving stock (Generic)
  deriving anyclass (Render)

data ThisIsAnExample = ThisIsAnExample { thisIsAnExample :: String}
  deriving stock (Generic)
  deriving (Render) via (CustomRender All ThisIsAnExample)

data ThisIsAnotherExample = ThisIsAnotherExample { thisIsAnotherExample :: String}
  deriving stock (Generic)
  deriving (Render) via (CustomRender CapitalLetters ThisIsAnotherExample)

main = do
  print $ render @Example
  print $ render @ThisIsAnExample
  print $ render @ThisIsAnotherExample