module Type.Show where
import Prelude
import Data.Typeable
import Data.Monoid
import GHC.TypeLits
import Text.Show.Pretty (ppValue, parseValue)
import Text.PrettyPrint (Doc, text)
import GHC.Exts (Constraint)
class TypeShow a where showType :: Proxy (a :: k) -> String
printType :: TypeShow a => Proxy a -> IO ()
printType = putStrLn . showType
ppPrintType :: TypeShow a => Proxy a -> IO ()
ppPrintType = putStrLn . ppShowType
ppShowType :: TypeShow a => Proxy a -> String
ppShowType = show . ppTypeDoc
ppTypeDoc :: TypeShow a => Proxy a -> Doc
ppTypeDoc a = case parseValue txt of
Just v -> ppValue v
Nothing -> text txt
where txt = showType a
instance KnownNat n => TypeShow (n :: Nat) where showType _ = show $ natVal (Proxy :: Proxy n)
instance ListElemsShow a => TypeShow (a :: [k]) where showType _ = "[" <> showListElems (Proxy :: Proxy a) <> "]"
instance (TypeShow a, TypeShow b) => TypeShow '(a,b) where showType _ = "(" <> showType (Proxy :: Proxy a) <> ", " <> showType (Proxy :: Proxy b) <> ")"
class ListElemsShow a where showListElems :: Proxy a -> String
instance ListElemsShow '[] where showListElems _ = ""
instance TypeShow a => ListElemsShow '[a] where showListElems _ = showType (Proxy :: Proxy a)
instance (TypeShow a, ListElemsShow as) => ListElemsShow (a ': as) where showListElems _ = showType (Proxy :: Proxy a) <> ", " <> showListElems (Proxy :: Proxy as)