[commit: packages/pretty] large_docs, master, moretests: Merge in prettyclass package as useful to have in core (a964141)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/pretty

On branches: large_docs,master,moretests
Link       : http://git.haskell.org/packages/pretty.git/commitdiff/a964141bc0b305e14131cb6c0b2db73cb056c1cb

>---------------------------------------------------------------

commit a964141bc0b305e14131cb6c0b2db73cb056c1cb
Author: David Terei <code at davidterei.com>
Date:   Wed Dec 24 15:30:33 2014 -0800

    Merge in prettyclass package as useful to have in core


>---------------------------------------------------------------

a964141bc0b305e14131cb6c0b2db73cb056c1cb
 pretty.cabal                          |   1 +
 src/Text/PrettyPrint/HughesPJClass.hs | 142 ++++++++++++++++++++++++++++++++++
 2 files changed, 143 insertions(+)

diff --git a/pretty.cabal b/pretty.cabal
index 7a7b2a5..47c1a8f 100644
--- a/pretty.cabal
+++ b/pretty.cabal
@@ -30,6 +30,7 @@ Library
     exposed-modules:
         Text.PrettyPrint
         Text.PrettyPrint.HughesPJ
+        Text.PrettyPrint.HughesPJClass
     build-depends: base >= 3 && < 5,
                    deepseq >= 1.1
     extensions: CPP, BangPatterns
diff --git a/src/Text/PrettyPrint/HughesPJClass.hs b/src/Text/PrettyPrint/HughesPJClass.hs
new file mode 100644
index 0000000..da1b474
--- /dev/null
+++ b/src/Text/PrettyPrint/HughesPJClass.hs
@@ -0,0 +1,142 @@
+#if __GLASGOW_HASKELL__ >= 701
+{-# LANGUAGE Safe #-}
+#endif
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Text.PrettyPrint.HughesPJClass
+-- Copyright   :  (c) Lennart Augustsson 2014
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  David Terei <code at davidterei.com>
+-- Stability   :  stable
+-- Portability :  portable
+--
+-- Pretty printing class, simlar to 'Show' but nicer looking. 
+--
+-- Note that the precedence level is a 'Rational' so there is an unlimited
+-- number of levels. This module re-exports 'Text.PrettyPrint.HughesPJ'.
+--
+-----------------------------------------------------------------------------
+
+module Text.PrettyPrint.HughesPJClass (
+    -- * Pretty typeclass
+    Pretty(..),
+
+    PrettyLevel(..), prettyNormal,
+    prettyShow, prettyParen,
+
+    -- re-export HughesPJ
+    module Text.PrettyPrint.HughesPJ
+  ) where
+
+import Text.PrettyPrint.HughesPJ
+
+-- | Level of detail in the pretty printed output.
+-- Level 0 is the least detail.
+newtype PrettyLevel = PrettyLevel Int
+  deriving (Eq, Ord, Show)
+
+-- | The "normal" (Level 0) of detail.
+prettyNormal :: PrettyLevel
+prettyNormal = PrettyLevel 0
+
+-- | Pretty printing class. The precedence level is used in a similar way as in
+-- the 'Show' class. Minimal complete definition is either 'pPrintPrec' or
+-- 'pPrint'.
+class Pretty a where
+  pPrintPrec :: PrettyLevel -> Rational -> a -> Doc
+  pPrintPrec _ _ = pPrint
+
+  pPrint :: a -> Doc
+  pPrint = pPrintPrec prettyNormal 0
+
+  pPrintList :: PrettyLevel -> [a] -> Doc
+  pPrintList l = brackets . fsep . punctuate comma . map (pPrintPrec l 0)
+
+-- | Pretty print a value with the 'prettyNormal' level.
+prettyShow :: (Pretty a) => a -> String
+prettyShow = render . pPrint
+
+pPrint0 :: (Pretty a) => PrettyLevel -> a -> Doc
+pPrint0 l = pPrintPrec l 0
+
+appPrec :: Rational
+appPrec = 10
+
+-- | Parenthesize an value if the boolean is true.
+prettyParen :: Bool -> Doc -> Doc
+maybeParens False = id
+maybeParens True = parens
+
+-- Various Pretty instances
+instance Pretty Int where pPrint = int
+
+instance Pretty Integer where pPrint = integer
+
+instance Pretty Float where pPrint = float
+
+instance Pretty Double where pPrint = double
+
+instance Pretty () where pPrint _ = text "()"
+
+instance Pretty Bool where pPrint = text . show
+
+instance Pretty Ordering where pPrint = text . show
+
+instance Pretty Char where
+  pPrint = char
+  pPrintList _ = text . show
+
+instance (Pretty a) => Pretty (Maybe a) where
+  pPrintPrec _ _ Nothing = text "Nothing"
+  pPrintPrec l p (Just x) =
+    prettyParen (p > appPrec) $ text "Just" <+> pPrintPrec l (appPrec+1) x
+
+instance (Pretty a, Pretty b) => Pretty (Either a b) where
+  pPrintPrec l p (Left x) =
+    prettyParen (p > appPrec) $ text "Left" <+> pPrintPrec l (appPrec+1) x
+  pPrintPrec l p (Right x) =
+    prettyParen (p > appPrec) $ text "Right" <+> pPrintPrec l (appPrec+1) x
+
+instance (Pretty a) => Pretty [a] where
+  pPrintPrec l _ = pPrintList l
+
+instance (Pretty a, Pretty b) => Pretty (a, b) where
+  pPrintPrec l _ (a, b) =
+    parens $ fsep $ punctuate comma [pPrint0 l a, pPrint0 l b]
+
+instance (Pretty a, Pretty b, Pretty c) => Pretty (a, b, c) where
+  pPrintPrec l _ (a, b, c) =
+    parens $ fsep $ punctuate comma [pPrint0 l a, pPrint0 l b, pPrint0 l c]
+
+instance (Pretty a, Pretty b, Pretty c, Pretty d) => Pretty (a, b, c, d) where
+  pPrintPrec l _ (a, b, c, d) =
+    parens $ fsep $ punctuate comma
+      [pPrint0 l a, pPrint0 l b, pPrint0 l c, pPrint0 l d]
+
+instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e) => Pretty (a, b, c, d, e) where
+  pPrintPrec l _ (a, b, c, d, e) =
+    parens $ fsep $ punctuate comma
+      [pPrint0 l a, pPrint0 l b, pPrint0 l c, pPrint0 l d, pPrint0 l e]
+
+instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f) => Pretty (a, b, c, d, e, f) where
+  pPrintPrec l _ (a, b, c, d, e, f) =
+    parens $ fsep $ punctuate comma
+      [pPrint0 l a, pPrint0 l b, pPrint0 l c,
+        pPrint0 l d, pPrint0 l e, pPrint0 l f]
+
+instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f, Pretty g) =>
+         Pretty (a, b, c, d, e, f, g) where
+  pPrintPrec l _ (a, b, c, d, e, f, g) =
+    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]
+
+instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f, Pretty g, Pretty h) =>
+         Pretty (a, b, c, d, e, f, g, h) where
+  pPrintPrec l _ (a, b, c, d, e, f, g, h) =
+    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]
+