1#if __GLASGOW_HASKELL__ >= 701
2{-# LANGUAGE Safe #-}
3#endif
4
5-----------------------------------------------------------------------------
6-- |
7-- Module      :  Text.PrettyPrint.HughesPJClass
8-- Copyright   :  (c) Lennart Augustsson 2014
9-- License     :  BSD-style (see the file LICENSE)
10--
11-- Maintainer  :  David Terei <code@davidterei.com>
12-- Stability   :  stable
13-- Portability :  portable
14--
15-- Pretty printing class, simlar to 'Show' but nicer looking.
16--
17-- Note that the precedence level is a 'Rational' so there is an unlimited
18-- number of levels. This module re-exports 'Text.PrettyPrint.HughesPJ'.
19--
20-----------------------------------------------------------------------------
21
22module Text.PrettyPrint.HughesPJClass (
23    -- * Pretty typeclass
24    Pretty(..),
25
26    PrettyLevel(..), prettyNormal,
27    prettyShow, prettyParen,
28
29    -- re-export HughesPJ
30    module Text.PrettyPrint.HughesPJ
31  ) where
32
33import Text.PrettyPrint.HughesPJ
34
35-- | Level of detail in the pretty printed output. Level 0 is the least
36-- detail.
37newtype PrettyLevel = PrettyLevel Int
38  deriving (Eq, Ord, Show)
39
40-- | The "normal" (Level 0) of detail.
41prettyNormal :: PrettyLevel
42prettyNormal = PrettyLevel 0
43
44-- | Pretty printing class. The precedence level is used in a similar way as in
45-- the 'Show' class. Minimal complete definition is either 'pPrintPrec' or
46-- 'pPrint'.
47class Pretty a where
48  pPrintPrec :: PrettyLevel -> Rational -> a -> Doc
49  pPrintPrec _ _ = pPrint
50
51  pPrint :: a -> Doc
52  pPrint = pPrintPrec prettyNormal 0
53
54  pPrintList :: PrettyLevel -> [a] -> Doc
55  pPrintList l = brackets . fsep . punctuate comma . map (pPrintPrec l 0)
56
57#if __GLASGOW_HASKELL__ >= 708
58  {-# MINIMAL pPrintPrec | pPrint #-}
59#endif
60
61-- | Pretty print a value with the 'prettyNormal' level.
62prettyShow :: (Pretty a) => a -> String
63prettyShow = render . pPrint
64
65pPrint0 :: (Pretty a) => PrettyLevel -> a -> Doc
66pPrint0 l = pPrintPrec l 0
67
68appPrec :: Rational
69appPrec = 10
70
71-- | Parenthesize an value if the boolean is true.
72{-# DEPRECATED prettyParen "Please use 'maybeParens' instead" #-}
73prettyParen :: Bool -> Doc -> Doc
74prettyParen = maybeParens
75
76-- Various Pretty instances
77instance Pretty Int where pPrint = int
78
79instance Pretty Integer where pPrint = integer
80
81instance Pretty Float where pPrint = float
82
83instance Pretty Double where pPrint = double
84
85instance Pretty () where pPrint _ = text "()"
86
87instance Pretty Bool where pPrint = text . show
88
89instance Pretty Ordering where pPrint = text . show
90
91instance Pretty Char where
92  pPrint = char
93  pPrintList _ = text . show
94
95instance (Pretty a) => Pretty (Maybe a) where
96  pPrintPrec _ _ Nothing = text "Nothing"
97  pPrintPrec l p (Just x) =
98    prettyParen (p > appPrec) $ text "Just" <+> pPrintPrec l (appPrec+1) x
99
100instance (Pretty a, Pretty b) => Pretty (Either a b) where
101  pPrintPrec l p (Left x) =
102    prettyParen (p > appPrec) $ text "Left" <+> pPrintPrec l (appPrec+1) x
103  pPrintPrec l p (Right x) =
104    prettyParen (p > appPrec) $ text "Right" <+> pPrintPrec l (appPrec+1) x
105
106instance (Pretty a) => Pretty [a] where
107  pPrintPrec l _ = pPrintList l
108
109instance (Pretty a, Pretty b) => Pretty (a, b) where
110  pPrintPrec l _ (a, b) =
111    parens $ fsep $ punctuate comma [pPrint0 l a, pPrint0 l b]
112
113instance (Pretty a, Pretty b, Pretty c) => Pretty (a, b, c) where
114  pPrintPrec l _ (a, b, c) =
115    parens $ fsep $ punctuate comma [pPrint0 l a, pPrint0 l b, pPrint0 l c]
116
117instance (Pretty a, Pretty b, Pretty c, Pretty d) => Pretty (a, b, c, d) where
118  pPrintPrec l _ (a, b, c, d) =
119    parens $ fsep $ punctuate comma
120      [pPrint0 l a, pPrint0 l b, pPrint0 l c, pPrint0 l d]
121
122instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e) => Pretty (a, b, c, d, e) where
123  pPrintPrec l _ (a, b, c, d, e) =
124    parens $ fsep $ punctuate comma
125      [pPrint0 l a, pPrint0 l b, pPrint0 l c, pPrint0 l d, pPrint0 l e]
126
127instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f) => Pretty (a, b, c, d, e, f) where
128  pPrintPrec l _ (a, b, c, d, e, f) =
129    parens $ fsep $ punctuate comma
130      [pPrint0 l a, pPrint0 l b, pPrint0 l c,
131        pPrint0 l d, pPrint0 l e, pPrint0 l f]
132
133instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f, Pretty g) =>
134         Pretty (a, b, c, d, e, f, g) where
135  pPrintPrec l _ (a, b, c, d, e, f, g) =
136    parens $ fsep $ punctuate comma
137      [pPrint0 l a, pPrint0 l b, pPrint0 l c,
138        pPrint0 l d, pPrint0 l e, pPrint0 l f, pPrint0 l g]
139
140instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f, Pretty g, Pretty h) =>
141         Pretty (a, b, c, d, e, f, g, h) where
142  pPrintPrec l _ (a, b, c, d, e, f, g, h) =
143    parens $ fsep $ punctuate comma
144      [pPrint0 l a, pPrint0 l b, pPrint0 l c,
145        pPrint0 l d, pPrint0 l e, pPrint0 l f, pPrint0 l g, pPrint0 l h]
146
147