{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NoStarIsType #-}

module Data.SerDoc.TH
( deriveSerializable
, deriveHasInfo
, deriveSerDoc
)
where

import Data.SerDoc.Info
import Data.SerDoc.Class

import Data.List
import Data.Proxy
import Language.Haskell.TH
import Language.Haskell.TH.Datatype
import Data.Char
import Control.Monad

-- * Deriving 'HasInfo' and 'Serializable' with Template Haskell

strippedFieldName :: Name -> Name -> String
strippedFieldName :: Name -> Name -> String
strippedFieldName Name
tyName Name
fieldName =
  let tyStr :: String
tyStr = Name -> String
nameBase Name
tyName
      fieldStr :: String
fieldStr = Name -> String
nameBase Name
fieldName
      lcfirst :: String -> String
lcfirst [] = []
      lcfirst (Char
x:String
xs) = Char -> Char
toLower Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String
xs
      tyStrLC :: String
tyStrLC = String -> String
lcfirst String
tyStr
  in
    if String
tyStrLC String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
fieldStr then
      Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length String
tyStrLC) String
fieldStr
    else
      String
fieldStr

nameToTy :: Name -> Type
nameToTy :: Name -> Type
nameToTy Name
name = case Name -> String
nameBase Name
name of
  String
"" -> String -> Type
forall a. HasCallStack => String -> a
error String
"Empty names are not allowed"
  Char
c:String
_ | Char -> Bool
isLower Char
c -> Name -> Type
VarT Name
name
  Char
c:String
_ | Char -> Bool
isUpper Char
c -> Name -> Type
ConT Name
name
  String
_ -> String -> Type
forall a. HasCallStack => String -> a
error (String -> Type) -> String -> Type
forall a b. (a -> b) -> a -> b
$ String
"Unsupported name: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
name

#if MIN_VERSION_template_haskell(2,17,0)
tyVarBndrName :: TyVarBndr a -> Name
tyVarBndrName :: forall a. TyVarBndr a -> Name
tyVarBndrName (PlainTV Name
name a
_) = Name
name
tyVarBndrName (KindedTV Name
name a
_ Type
_) = Name
name
#else
tyVarBndrName :: TyVarBndr -> Name
tyVarBndrName (PlainTV name ) = name
tyVarBndrName (KindedTV name _) = name
#endif

-- | Derive a 'HasInfo' instance for the given codec and type.
-- Currently only supports record types.
-- A matching 'Serializable' instance must serialize record fields in the order
-- they are declared in the source code, without any additional separators,
-- padding, or envelope around or between them. If your serializer does not meet
-- these requirements, you must write a custom 'HasInfo' instance instead.
deriveHasInfo :: Name -> [Name] -> Name -> DecsQ
deriveHasInfo :: Name -> [Name] -> Name -> DecsQ
deriveHasInfo Name
codecName [Name]
codecArgs Name
typeName = do
  TyConI (DataD Cxt
_ Name
_ [TyVarBndr ()]
codecVars Maybe Type
_ [Con]
_ [DerivClause]
_) <- Name -> Q Info
reify Name
codecName
  let remainingVars :: [TyVarBndr ()]
remainingVars = Int -> [TyVarBndr ()] -> [TyVarBndr ()]
forall a. Int -> [a] -> [a]
drop ([Name] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Name]
codecArgs) [TyVarBndr ()]
codecVars
  let codecTy :: Type
codecTy = (Type -> Type -> Type) -> Type -> Cxt -> Type
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (Name -> Type
ConT Name
codecName) ((Name -> Type) -> [Name] -> Cxt
forall a b. (a -> b) -> [a] -> [b]
map Name -> Type
nameToTy ([Name]
codecArgs [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (TyVarBndr () -> Name) -> [TyVarBndr ()] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndr () -> Name
forall a. TyVarBndr a -> Name
tyVarBndrName [TyVarBndr ()]
remainingVars))
  Name -> Q Info
reify Name
typeName Q Info -> (Info -> DecsQ) -> DecsQ
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    TyConI (DataD [] Name
tyName [TyVarBndr ()]
tyVars Maybe Type
Nothing [RecC Name
_ [VarBangType]
fields] []) -> do
      let constraintFields :: [VarBangType]
constraintFields = (VarBangType -> Bool) -> [VarBangType] -> [VarBangType]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Name
_, Bang
_, Type
fieldTy) -> Bool -> Bool
not (Bool -> Bool) -> (Type -> Bool) -> Type -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null ([Name] -> Bool) -> (Type -> [Name]) -> Type -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables (Type -> Bool) -> Type -> Bool
forall a b. (a -> b) -> a -> b
$ Type
fieldTy) [VarBangType]
fields
      Cxt
constraints <- [VarBangType] -> (VarBangType -> Q Type) -> Q Cxt
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [VarBangType]
constraintFields ((VarBangType -> Q Type) -> Q Cxt)
-> (VarBangType -> Q Type) -> Q Cxt
forall a b. (a -> b) -> a -> b
$
          \(Name
_, Bang
_, Type
fieldTy) ->
              [t| HasInfo $(Type -> Q Type
forall a. a -> Q a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Type
codecTy) $(Type -> Q Type
forall a. a -> Q a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Type
fieldTy) |]
      (Dec -> [Dec]) -> Q Dec -> DecsQ
forall a b. (a -> b) -> Q a -> Q b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Dec -> [Dec] -> [Dec]
forall a. a -> [a] -> [a]
:[]) (Q Dec -> DecsQ) -> Q Dec -> DecsQ
forall a b. (a -> b) -> a -> b
$
        Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: Type -> Type).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD
          (Cxt -> Q Cxt
forall a. a -> Q a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Cxt
constraints) 
          [t| HasInfo
                $(Type -> Q Type
forall a. a -> Q a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Type
codecTy)
                $((Q Type -> Q Type -> Q Type) -> Q Type -> [Q Type] -> Q Type
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Q Type -> Q Type -> Q Type
forall (m :: Type -> Type). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: Type -> Type). Quote m => Name -> m Type
conT Name
tyName) [ Name -> Q Type
forall (m :: Type -> Type). Quote m => Name -> m Type
varT (TyVarBndr () -> Name
forall a. TyVarBndr a -> Name
tyVarName TyVarBndr ()
bndr) | TyVarBndr ()
bndr <- [TyVarBndr ()]
tyVars ])
            |]
          [ Name -> [Q Clause] -> Q Dec
forall (m :: Type -> Type). Quote m => Name -> [m Clause] -> m Dec
funD
              (String -> Name
mkName String
"info")
              [ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: Type -> Type).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
                  [ Name -> Q Pat
forall (m :: Type -> Type). Quote m => Name -> m Pat
varP (String -> Name
mkName String
"codec")
                  , Name -> Q Pat
forall (m :: Type -> Type). Quote m => Name -> m Pat
varP (String -> Name
mkName String
"_")
                  ]
                  (Q Exp -> Q Body
forall (m :: Type -> Type). Quote m => m Exp -> m Body
normalB [|
                        compoundField
                          $(Lit -> Q Exp
forall (m :: Type -> Type). Quote m => Lit -> m Exp
litE (String -> Lit
stringL (Name -> String
nameBase Name
tyName)))
                          $([Q Exp] -> Q Exp
forall (m :: Type -> Type). Quote m => [m Exp] -> m Exp
listE
                              [ [| ( $(Lit -> Q Exp
forall (m :: Type -> Type). Quote m => Lit -> m Exp
litE (String -> Lit
stringL (Name -> Name -> String
strippedFieldName Name
tyName Name
fieldName)))
                                   , info codec (Proxy :: Proxy $(Type -> Q Type
forall a. a -> Q a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Type
fieldTy))
                                   )
                                |]
                              | (Name
fieldName, Bang
_, Type
fieldTy) <- [VarBangType]
fields
                              ]
                            )
                      |]
                  )
                  []
              ]
          ]
    Info
x ->
      String -> DecsQ
forall a. HasCallStack => String -> a
error (String -> DecsQ) -> String -> DecsQ
forall a b. (a -> b) -> a -> b
$ String
"Unsupported data type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Name -> String
forall a. Show a => a -> String
show Name
typeName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Info -> String
forall a. Show a => a -> String
show Info
x

-- | Derive a 'Serializable' instance for the given codec and type.
-- Currently only supports record types.
-- The generated instance will serialize record fields in the order
-- they are declared in the source code, without any additional separators,
-- padding, or envelope around or between them, making it compatible with
-- 'deriveHasInfo'. (See also 'deriveSerDoc'.)
deriveSerializable :: Name -> [Name] -> Name -> DecsQ
deriveSerializable :: Name -> [Name] -> Name -> DecsQ
deriveSerializable Name
codecName [Name]
codecArgs Name
typeName = do
  TyConI (DataD Cxt
_ Name
_ [TyVarBndr ()]
codecVars Maybe Type
_ [Con]
_ [DerivClause]
_) <- Name -> Q Info
reify Name
codecName
  let remainingVars :: [TyVarBndr ()]
remainingVars = Int -> [TyVarBndr ()] -> [TyVarBndr ()]
forall a. Int -> [a] -> [a]
drop ([Name] -> Int
forall a. [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [Name]
codecArgs) [TyVarBndr ()]
codecVars
  let codecTy :: Type
codecTy = (Type -> Type -> Type) -> Type -> Cxt -> Type
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Type -> Type -> Type
AppT (Name -> Type
ConT Name
codecName) ((Name -> Type) -> [Name] -> Cxt
forall a b. (a -> b) -> [a] -> [b]
map Name -> Type
nameToTy ([Name]
codecArgs [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ (TyVarBndr () -> Name) -> [TyVarBndr ()] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndr () -> Name
forall a. TyVarBndr a -> Name
tyVarBndrName [TyVarBndr ()]
remainingVars))
  Name -> Q Info
reify Name
typeName Q Info -> (Info -> DecsQ) -> DecsQ
forall a b. Q a -> (a -> Q b) -> Q b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    TyConI (DataD [] Name
tyName [TyVarBndr ()]
tyVars Maybe Type
Nothing [RecC Name
conName [VarBangType]
fields] []) -> do
      let constraintFields :: [VarBangType]
constraintFields =
            if [TyVarBndr ()] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [TyVarBndr ()]
remainingVars then
              (VarBangType -> Bool) -> [VarBangType] -> [VarBangType]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Name
_, Bang
_, Type
fieldTy) -> Bool -> Bool
not (Bool -> Bool) -> (Type -> Bool) -> Type -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null ([Name] -> Bool) -> (Type -> [Name]) -> Type -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> [Name]
forall a. TypeSubstitution a => a -> [Name]
freeVariables (Type -> Bool) -> Type -> Bool
forall a b. (a -> b) -> a -> b
$ Type
fieldTy) [VarBangType]
fields
            else
              [VarBangType]
fields
      Cxt
constraints1 <-
            if [TyVarBndr ()] -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [TyVarBndr ()]
remainingVars then
              Cxt -> Q Cxt
forall a. a -> Q a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure []
            else
              [Q Type] -> Q Cxt
forall (t :: Type -> Type) (m :: Type -> Type) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: Type -> Type) a. Monad m => [m a] -> m [a]
sequence
                [ [t| Monad (MonadEncode $(Type -> Q Type
forall a. a -> Q a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Type
codecTy)) |]
                , [t| Monad (MonadDecode $(Type -> Q Type
forall a. a -> Q a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Type
codecTy)) |]
                ]
      Cxt
constraints2 <- [VarBangType] -> (VarBangType -> Q Type) -> Q Cxt
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [VarBangType]
constraintFields ((VarBangType -> Q Type) -> Q Cxt)
-> (VarBangType -> Q Type) -> Q Cxt
forall a b. (a -> b) -> a -> b
$
          \(Name
_, Bang
_, Type
fieldTy) ->
              [t| Serializable $(Type -> Q Type
forall a. a -> Q a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Type
codecTy) $(Type -> Q Type
forall a. a -> Q a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Type
fieldTy) |]
      let constraints :: Cxt
constraints = Cxt
constraints1 Cxt -> Cxt -> Cxt
forall a. [a] -> [a] -> [a]
++ Cxt
constraints2
      (Dec -> [Dec]) -> Q Dec -> DecsQ
forall a b. (a -> b) -> Q a -> Q b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Dec -> [Dec] -> [Dec]
forall a. a -> [a] -> [a]
:[]) (Q Dec -> DecsQ) -> Q Dec -> DecsQ
forall a b. (a -> b) -> a -> b
$
        Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: Type -> Type).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD
          (Cxt -> Q Cxt
forall a. a -> Q a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Cxt
constraints) 
          [t| Serializable
                $(Type -> Q Type
forall a. a -> Q a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Type
codecTy)
                $((Q Type -> Q Type -> Q Type) -> Q Type -> [Q Type] -> Q Type
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Q Type -> Q Type -> Q Type
forall (m :: Type -> Type). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: Type -> Type). Quote m => Name -> m Type
conT Name
tyName) [ Name -> Q Type
forall (m :: Type -> Type). Quote m => Name -> m Type
varT (TyVarBndr () -> Name
forall a. TyVarBndr a -> Name
tyVarName TyVarBndr ()
bndr) | TyVarBndr ()
bndr <- [TyVarBndr ()]
tyVars ])
            |]
          [ Name -> [Q Clause] -> Q Dec
forall (m :: Type -> Type). Quote m => Name -> [m Clause] -> m Dec
funD
              (String -> Name
mkName String
"encode")
              [ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: Type -> Type).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
                  [ Name -> Q Pat
forall (m :: Type -> Type). Quote m => Name -> m Pat
varP (String -> Name
mkName String
"p")
                  , Name -> Q Pat
forall (m :: Type -> Type). Quote m => Name -> m Pat
varP (String -> Name
mkName String
"item")
                  ]
                  (Q Exp -> Q Body
forall (m :: Type -> Type). Quote m => m Exp -> m Body
normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
forall a b. (a -> b) -> a -> b
$
                    [| sequence_
                        $([Q Exp] -> Q Exp
forall (m :: Type -> Type). Quote m => [m Exp] -> m Exp
listE
                            [ [| encode p ($(Name -> Q Exp
forall (m :: Type -> Type). Quote m => Name -> m Exp
varE Name
fieldName) item) |]
                            | (Name
fieldName, Bang
_, Type
_) <- [VarBangType]
fields
                            ])
                     |]
                  )
                  []
              ]
          , Name -> [Q Clause] -> Q Dec
forall (m :: Type -> Type). Quote m => Name -> [m Clause] -> m Dec
funD
              (String -> Name
mkName String
"decode")
              [ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: Type -> Type).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
                  [ Name -> Q Pat
forall (m :: Type -> Type). Quote m => Name -> m Pat
varP (String -> Name
mkName String
"p")
                  ]
                  (Q Exp -> Q Body
forall (m :: Type -> Type). Quote m => m Exp -> m Body
normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
forall a b. (a -> b) -> a -> b
$
                      [| $(Q Exp -> [Q Exp] -> Q Exp
foldApplicative
                              (Name -> Q Exp
forall (m :: Type -> Type). Quote m => Name -> m Exp
conE Name
conName)
                              [ [| decode p |] | VarBangType
_ <- [VarBangType]
fields ]
                           )
                       |]
                  )
                  []
              ]
          ]
    Info
x ->
      String -> DecsQ
forall a. HasCallStack => String -> a
error (String -> DecsQ) -> (Info -> String) -> Info -> DecsQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Info -> String
forall a. Show a => a -> String
show (Info -> DecsQ) -> Info -> DecsQ
forall a b. (a -> b) -> a -> b
$ Info
x

-- | Derive both a 'HasInfo' instance and a matching 'Serializable' instance,
-- combining 'deriveHasInfo' and 'deriveSerializable'.
deriveSerDoc :: Name -> [Name] -> Name -> DecsQ
deriveSerDoc :: Name -> [Name] -> Name -> DecsQ
deriveSerDoc Name
codecName [Name]
codecArgs Name
typeName =
  [Dec] -> [Dec] -> [Dec]
forall a. [a] -> [a] -> [a]
(++) ([Dec] -> [Dec] -> [Dec]) -> DecsQ -> Q ([Dec] -> [Dec])
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> [Name] -> Name -> DecsQ
deriveHasInfo Name
codecName [Name]
codecArgs Name
typeName
       Q ([Dec] -> [Dec]) -> DecsQ -> DecsQ
forall a b. Q (a -> b) -> Q a -> Q b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Name -> [Name] -> Name -> DecsQ
deriveSerializable Name
codecName [Name]
codecArgs Name
typeName

-- <$> :: (a -> b) -> f a -> f b
-- <*> :: f (a -> b) -> f a -> f b
foldApplicative :: ExpQ -> [ExpQ] -> ExpQ
foldApplicative :: Q Exp -> [Q Exp] -> Q Exp
foldApplicative Q Exp
initial [] = [| pure $Q Exp
initial |]
foldApplicative Q Exp
initial [Q Exp
x] = [| $Q Exp
initial <$> $Q Exp
x |]
foldApplicative Q Exp
initial (Q Exp
x:[Q Exp]
xs) =
  (Q Exp -> Q Exp -> Q Exp) -> Q Exp -> [Q Exp] -> Q Exp
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Q Exp
a Q Exp
b -> [| $Q Exp
a <*> $Q Exp
b |]) [| $Q Exp
initial <$> $Q Exp
x |] [Q Exp]
xs

#if MIN_VERSION_template_haskell(2,17,0)
tyVarName :: TyVarBndr a -> Name
tyVarName :: forall a. TyVarBndr a -> Name
tyVarName (PlainTV Name
n a
_) = Name
n
tyVarName (KindedTV Name
n a
_ Type
_) = Name
n
#else
tyVarName :: TyVarBndr -> Name
tyVarName (PlainTV n) = n
tyVarName (KindedTV n _) = n
#endif