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