1-- | Pretty printing class, simlar to 'Show' but nicer looking.
2-- Note that the precedence level is a 'Rational' so there is an unlimited number of levels.
3-- Based on "Text.PrettyPrint.HughesPJ", which is re-exported.
4module Text.PrettyPrint.HughesPJClass(
5    Pretty(..),
6    PrettyLevel(..), prettyNormal,
7    prettyShow, prettyParen,
8    module Text.PrettyPrint.HughesPJ
9    ) where
10import Text.PrettyPrint.HughesPJ
11import Data.Ratio
12
13-- | Level of detail in the pretty printed output.
14-- Level 0 is the least detail.
15newtype PrettyLevel = PrettyLevel Int
16    deriving (Eq, Ord, Show)
17
18prettyNormal :: PrettyLevel
19prettyNormal = PrettyLevel 0
20
21-- | Pretty printing class.  The precedence level is used in a similar way as in the 'Show' class.
22-- Minimal complete definition is either 'pPrintPrec' or 'pPrint'.
23class Pretty a where
24    pPrintPrec :: PrettyLevel -> Rational -> a -> Doc
25    pPrint :: a -> Doc
26    pPrintList :: PrettyLevel -> [a] -> Doc
27
28    pPrintPrec _ _ = pPrint
29    pPrint = pPrintPrec prettyNormal 0
30    pPrintList l = brackets . fsep . punctuate comma . map (pPrintPrec l 0)
31
32-- | Pretty print a value with the 'prettyNormal' level.
33prettyShow :: (Pretty a) => a -> String
34prettyShow = render . pPrint
35
36pPrint0 :: (Pretty a) => PrettyLevel -> a -> Doc
37pPrint0 l = pPrintPrec l 0
38
39appPrec :: Rational
40appPrec = 10
41
42-- | Parenthesize an value if the boolean is true.
43prettyParen :: Bool -> Doc -> Doc
44prettyParen False = id
45prettyParen True = parens
46
47-- XXX Doesn't treat signs like Show.
48instance Pretty Int where pPrint = int
49instance Pretty Integer where pPrint = integer
50instance Pretty Float where pPrint = float
51instance Pretty Double where pPrint = double
52instance Pretty () where pPrint _ = text "()"
53instance Pretty Bool where pPrint = text . show
54instance Pretty Ordering where pPrint = text . show
55instance Pretty Char where
56    pPrint = char
57    pPrintList _ = text . show
58instance (Pretty a) => Pretty (Maybe a) where
59    pPrintPrec l p Nothing = text "Nothing"
60    pPrintPrec l p (Just x) = prettyParen (p > appPrec) $ text "Just" <+> pPrintPrec l (appPrec+1) x
61instance (Pretty a, Pretty b) => Pretty (Either a b) where
62    pPrintPrec l p (Left x) = prettyParen (p > appPrec) $ text "Left" <+> pPrintPrec l (appPrec+1) x
63    pPrintPrec l p (Right x) = prettyParen (p > appPrec) $ text "Right" <+> pPrintPrec l (appPrec+1) x
64
65instance (Pretty a) => Pretty [a] where
66    pPrintPrec l _ xs = pPrintList l xs
67
68instance (Pretty a, Pretty b) => Pretty (a, b) where
69    pPrintPrec l _ (a, b) =
70        parens $ fsep $ punctuate comma [pPrint0 l a, pPrint0 l b]
71
72instance (Pretty a, Pretty b, Pretty c) => Pretty (a, b, c) where
73    pPrintPrec l _ (a, b, c) =
74        parens $ fsep $ punctuate comma [pPrint0 l a, pPrint0 l b, pPrint0 l c]
75
76instance (Pretty a, Pretty b, Pretty c, Pretty d) => Pretty (a, b, c, d) where
77    pPrintPrec l _ (a, b, c, d) =
78        parens $ fsep $ punctuate comma [pPrint0 l a, pPrint0 l b, pPrint0 l c, pPrint0 l d]
79
80instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e) => Pretty (a, b, c, d, e) where
81    pPrintPrec l _ (a, b, c, d, e) =
82        parens $ fsep $ punctuate comma [pPrint0 l a, pPrint0 l b, pPrint0 l c, pPrint0 l d, pPrint0 l e]
83
84instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f) => Pretty (a, b, c, d, e, f) where
85    pPrintPrec l _ (a, b, c, d, e, f) =
86        parens $ fsep $ punctuate comma [pPrint0 l a, pPrint0 l b, pPrint0 l c, pPrint0 l d, pPrint0 l e, pPrint0 l f]
87
88instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f, Pretty g) =>
89         Pretty (a, b, c, d, e, f, g) where
90    pPrintPrec l _ (a, b, c, d, e, f, g) =
91        parens $ fsep $ punctuate comma [pPrint0 l a, pPrint0 l b, pPrint0 l c, pPrint0 l d, pPrint0 l e, pPrint0 l f, pPrint0 l g]
92
93instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f, Pretty g, Pretty h) =>
94         Pretty (a, b, c, d, e, f, g, h) where
95    pPrintPrec l _ (a, b, c, d, e, f, g, h) =
96        parens $ fsep $ punctuate comma [pPrint0 l a, pPrint0 l b, pPrint0 l c, pPrint0 l d, pPrint0 l e, pPrint0 l f, pPrint0 l g, pPrint0 l h]
97
98