module Tip.Pretty where
import Text.PrettyPrint
import Tip.Types
infixl 1 $\
class Pretty a where
pp :: a -> Doc
ppRender :: Pretty a => a -> String
ppRender = render . pp
pprint :: Pretty a => a -> IO ()
pprint = putStrLn . ppRender
instance PrettyVar String where
varStr = id
instance PrettyVar Int where
varStr = show
class PrettyVar a where
varStr :: a -> String
instance (PrettyVar a,PrettyVar b) => PrettyVar (Either a b) where
varStr (Left x) = varStr x
varStr (Right y) = varStr y
instance (Pretty a,Pretty b) => Pretty (a,b) where
pp (x,y) = parens (pp x <+> "," $\ pp y)
instance (Pretty a,Pretty b,Pretty c) => Pretty (a,b,c) where
pp (x,y,z) = parens (pp x <+> "," $\ pp y <+> "," $\ pp z)
instance (Pretty a) => Pretty [a] where
pp xs = brackets (sep (punctuate "," (map pp xs)))
instance Pretty Int where
pp = int
instance Pretty () where
pp _ = "()"
newtype PPVar a = PPVar { unPPVar :: a }
deriving (Eq,Ord,PrettyVar)
instance PrettyVar a => Pretty (PPVar a) where
pp (PPVar x) = ppVar x
instance PrettyVar a => Show (PPVar a) where
show (PPVar x) = varStr x
ppVar :: PrettyVar a => a -> Doc
ppVar = text . varStr
($\) :: Doc -> Doc -> Doc
d1 $\ d2 = hang d1 2 d2
parIf :: Bool -> Doc -> Doc
parIf True = parens
parIf False = id