{-# language TypeSynonymInstances #-}

module Autolib.ToDoc.Typeable where

import Data.Typeable
import Autolib.ToDoc.Class
import Autolib.ToDoc.Dutch

-- this should rather be next to the Show instance
-- in Data.Typeable (the ghc library)?

instance ToDoc TypeRep where
    toDocPrec :: Int -> TypeRep -> Doc
toDocPrec Int
p TypeRep
t = 
	let 
            con :: TyCon
con  = TypeRep -> TyCon
typeRepTyCon TypeRep
t
	    args :: [TypeRep]
args = TypeRep -> [TypeRep]
typeRepArgs TypeRep
t
	    str :: [Char]
str  = TyCon -> [Char]
tyConModule TyCon
con [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ TyCon -> [Char]
tyConName TyCon
con
	in case [TypeRep]
args of
	    [] -> [Char] -> Doc
text [Char]
str
	    [TypeRep
x] | [Char]
str [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"[]" -> Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> TypeRep -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
0 TypeRep
x
	    [TypeRep
a, TypeRep
r] | [Char]
str [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"->" -> Bool -> Doc -> Doc
docParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
fcp)
			   (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> TypeRep -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
fcp TypeRep
a
			      Doc -> Doc -> Doc
$$ Integer -> Doc -> Doc
forall {a}. Integral a => a -> Doc -> Doc
nest Integer
4 ( [Char] -> Doc
text [Char]
str Doc -> Doc -> Doc
<+>
				   Int -> TypeRep -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec (Int -> Int
forall a. Enum a => a -> a
pred Int
fcp) TypeRep
r
				  )
	    [TypeRep]
xs | [Char] -> Char
forall a. HasCallStack => [a] -> a
head [Char]
str Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' -> [Doc] -> Doc
dutch_tuple 
		     ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (TypeRep -> Doc) -> [TypeRep] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> TypeRep -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
0) [TypeRep]
args
	       | Bool
otherwise -> Bool -> Doc -> Doc
docParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
fcp)
                     (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
str Doc -> Doc -> Doc
<+> [Doc] -> Doc
sep ((TypeRep -> Doc) -> [TypeRep] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> TypeRep -> Doc
forall a. ToDoc a => Int -> a -> Doc
toDocPrec Int
fcp) [TypeRep]
args)