[kowainik#14] Initial work on CommaSeparated

src/Type/Errors/Pretty.hs

@@ -1,8 +1,8 @@
-{-# LANGUAGE TypeFamilies  #-}
-{-# LANGUAGE TypeInType    #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UnicodeSyntax #-}
-
+{-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE TypeInType           #-}
+{-# LANGUAGE TypeOperators        #-}
+{-# LANGUAGE UnicodeSyntax        #-}
+{-# LANGUAGE UndecidableInstances #-}
 {- |
 Copyright:  (c) 2019-2020 Dmitrii Kovanikov
             (c) 2020 Kowainik
@@ -71,10 +71,12 @@ module Type.Errors.Pretty
 
          -- * Helper internal type families
        , ToErrorMessage
+       , CommaSeparated
        ) where
 
-import GHC.TypeLits (ErrorMessage (..), Symbol, TypeError)
-
+import GHC.TypeLits (ErrorMessage (..), Symbol, TypeError, AppendSymbol)
+import Data.Kind
+import GHC.Generics
 
 {- | Append two types automatically converting them to corresponding
 'ErrorMessage' constructors.
@@ -114,3 +116,32 @@ type family ToErrorMessage (t :: k) :: ErrorMessage where
     ToErrorMessage (t :: Symbol) = 'Text t
     ToErrorMessage (t :: ErrorMessage) = t
     ToErrorMessage t = 'ShowType t
+
+-- | Internal type family to go from a `Type` to its `Symbol` representation.
+-- The names for types without Generics instances have to be defined manually,
+-- and we do so for a handful of common types.
+-- TODO(dalpd): There are also things to consider with how the Generics
+-- instances work, e.g. `Maybe a` gets serialized as `Maybe` and `[a]` as `[]`
+type family TypeName (a :: Type) :: Symbol where
+  TypeName Char = "Char"
+  TypeName String = "String"
+  TypeName Int  = "Int"
+  TypeName (D1 ('MetaData name _ _ _) _ _) = name
+  TypeName a = TypeName (Rep a ())
+
+-- | Internal type family to intercalate a list of `Symbol`s with a given
+-- seperator.
+type family IntercalateSymbolList (sep :: Symbol) (symbols :: [Symbol]) :: Symbol where
+  IntercalateSymbolList _ '[] = ""
+  IntercalateSymbolList sep (symbol ': symbols) =
+    AppendSymbol (AppendSymbol sep symbol) (IntercalateSymbolList sep symbols)
+
+-- | Internal type family to map over a list of `Type`s while applying
+-- `TypeName` to each, returning a list of `Symbol`s.
+type family CommaSeparated' (ts :: [Type]) :: [Symbol] where
+  CommaSeparated' '[] = '[]
+  CommaSeparated' (t ': ts) = TypeName t ': CommaSeparated' ts
+
+-- | Type family to display a list of types separated by commas.
+type family CommaSeparated (ts :: [Type]) :: Symbol where
+  CommaSeparated ts = IntercalateSymbolList ", " (CommaSeparated' ts)