Getting the name of a type with GHC.Generics

GenericsTypeName.hs

{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module GenericsTypeName
  ( TypeName(..)
  , readBS
  ) where

import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS8
import           Data.Proxy
import           GHC.Generics
import           Text.Read (readMaybe)

-- | A class of types from which we can get the name as a string.
--
-- This class can be automatically derived, e.g. with
-- `deriving instance TypeName MyType`.
class TypeName a where
  typename :: Proxy a -> String

  default typename :: (Generic a, GTypeName (Rep a)) => Proxy a -> String
  typename _proxy = gtypename (from (undefined :: a))

-- | Generic equivalent to `TypeName`.
class GTypeName f where
  gtypename :: f a -> String

instance (Datatype c) => GTypeName (M1 i c f) where
  gtypename m = datatypeName m

-- | Tries to parse a `ByteString` into a constructor of type `a`, failing
-- with a nice error message if that failed.
--
-- Note: This should have a `MonadFail` instad of `Monad` constraint, once that exists in base.
readBS :: forall m a . (Monad m, TypeName a, Read a) => ByteString -> m a
readBS bs = case readMaybe (BS8.unpack bs) of
  Nothing -> fail $ "The string " ++ show bs
                    ++ " could not be turned into a constructor of type "
                    ++ typename (Proxy :: Proxy a)
  Just x -> return x