public
Created

  • Download Gist
gistfile1.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
{-# 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

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.