gistfile1.hs

{-# language TypeSynonymInstances, FlexibleInstances, DeriveDataTypeable #-}
module Traverse where

import Data.Data
import Data.Generics.Aliases
import Data.Typeable

data Tree a = Node a [Tree a] 
            deriving (Show, Data, Typeable)


example = Node "a" [Node "b" [Node "c" [], Node "d" [Node "e" []], Node "f" []], Node "g" []]

class Pretty a where
  pretty :: a -> String

instance Pretty String where
  pretty s = s

instance (Pretty a) => Pretty (Tree a) where
  pretty t = pretty' 0 t

pretty' :: Pretty a => Int -> Tree a -> String
pretty' i (Node v ts) = replicate i ' ' ++ pretty v ++ "\n" ++ concatMap (pretty' $ i+1) ts  


-- let's steal gshows from Data.Generics.Text

gpretty :: Data a => a -> String
gpretty a = gprettys 0 a "" 

gprettys :: Data a => Int -> a -> ShowS
gprettys n = ( \t ->
	          (showString $ replicate n ' ')
              . (showString . showConstr . toConstr $ t)
              . showChar '\n'
              . (foldr (.) id . gmapQ ((showChar ' ' .) . (gprettys $ n+1)) $ t)
         ) `extQ` ((\s -> (showString $ replicate n ' ') . shows s . showChar '\n') :: String -> ShowS)

test = putStrLn $ gpretty example