-- | 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.
-- Based on "Text.PrettyPrint.HughesPJ", which is re-exported.
module Text.PrettyPrint.HughesPJClass(
    Pretty(..),
    PrettyLevel(..), prettyNormal,
    prettyShow, prettyParen,
    module Text.PrettyPrint.HughesPJ
    ) where
import Text.PrettyPrint.HughesPJ
import Data.Ratio

-- | Level of detail in the pretty printed output.
-- Level 0 is the least detail.
newtype PrettyLevel = PrettyLevel Int
    deriving (PrettyLevel -> PrettyLevel -> Bool
(PrettyLevel -> PrettyLevel -> Bool)
-> (PrettyLevel -> PrettyLevel -> Bool) -> Eq PrettyLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrettyLevel -> PrettyLevel -> Bool
== :: PrettyLevel -> PrettyLevel -> Bool
$c/= :: PrettyLevel -> PrettyLevel -> Bool
/= :: PrettyLevel -> PrettyLevel -> Bool
Eq, Eq PrettyLevel
Eq PrettyLevel
-> (PrettyLevel -> PrettyLevel -> Ordering)
-> (PrettyLevel -> PrettyLevel -> Bool)
-> (PrettyLevel -> PrettyLevel -> Bool)
-> (PrettyLevel -> PrettyLevel -> Bool)
-> (PrettyLevel -> PrettyLevel -> Bool)
-> (PrettyLevel -> PrettyLevel -> PrettyLevel)
-> (PrettyLevel -> PrettyLevel -> PrettyLevel)
-> Ord PrettyLevel
PrettyLevel -> PrettyLevel -> Bool
PrettyLevel -> PrettyLevel -> Ordering
PrettyLevel -> PrettyLevel -> PrettyLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PrettyLevel -> PrettyLevel -> Ordering
compare :: PrettyLevel -> PrettyLevel -> Ordering
$c< :: PrettyLevel -> PrettyLevel -> Bool
< :: PrettyLevel -> PrettyLevel -> Bool
$c<= :: PrettyLevel -> PrettyLevel -> Bool
<= :: PrettyLevel -> PrettyLevel -> Bool
$c> :: PrettyLevel -> PrettyLevel -> Bool
> :: PrettyLevel -> PrettyLevel -> Bool
$c>= :: PrettyLevel -> PrettyLevel -> Bool
>= :: PrettyLevel -> PrettyLevel -> Bool
$cmax :: PrettyLevel -> PrettyLevel -> PrettyLevel
max :: PrettyLevel -> PrettyLevel -> PrettyLevel
$cmin :: PrettyLevel -> PrettyLevel -> PrettyLevel
min :: PrettyLevel -> PrettyLevel -> PrettyLevel
Ord, Int -> PrettyLevel -> ShowS
[PrettyLevel] -> ShowS
PrettyLevel -> String
(Int -> PrettyLevel -> ShowS)
-> (PrettyLevel -> String)
-> ([PrettyLevel] -> ShowS)
-> Show PrettyLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrettyLevel -> ShowS
showsPrec :: Int -> PrettyLevel -> ShowS
$cshow :: PrettyLevel -> String
show :: PrettyLevel -> String
$cshowList :: [PrettyLevel] -> ShowS
showList :: [PrettyLevel] -> ShowS
Show)

prettyNormal :: PrettyLevel
prettyNormal :: PrettyLevel
prettyNormal = Int -> PrettyLevel
PrettyLevel Int
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
    pPrint :: a -> Doc
    pPrintList :: PrettyLevel -> [a] -> Doc

    pPrintPrec PrettyLevel
_ Rational
_ = a -> Doc
forall a. Pretty a => a -> Doc
pPrint
    pPrint = PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
prettyNormal Rational
0
    pPrintList PrettyLevel
l = Doc -> Doc
brackets (Doc -> Doc) -> ([a] -> Doc) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
fsep ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([a] -> [Doc]) -> [a] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
0)

-- | Pretty print a value with the 'prettyNormal' level.
prettyShow :: (Pretty a) => a -> String
prettyShow :: forall a. Pretty a => a -> String
prettyShow = Doc -> String
render (Doc -> String) -> (a -> Doc) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Pretty a => a -> Doc
pPrint

pPrint0 :: (Pretty a) => PrettyLevel -> a -> Doc
pPrint0 :: forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l = PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l Rational
0

appPrec :: Rational
appPrec :: Rational
appPrec = Rational
10

-- | Parenthesize an value if the boolean is true.
prettyParen :: Bool -> Doc -> Doc
prettyParen :: Bool -> Doc -> Doc
prettyParen Bool
False = Doc -> Doc
forall a. a -> a
id
prettyParen Bool
True = Doc -> Doc
parens

-- XXX Doesn't treat signs like Show.
instance Pretty Int where pPrint :: Int -> Doc
pPrint = Int -> Doc
int
instance Pretty Integer where pPrint :: Integer -> Doc
pPrint = Integer -> Doc
integer
instance Pretty Float where pPrint :: Float -> Doc
pPrint = Float -> Doc
float
instance Pretty Double where pPrint :: Double -> Doc
pPrint = Double -> Doc
double
instance Pretty () where pPrint :: () -> Doc
pPrint ()
_ = String -> Doc
text String
"()"
instance Pretty Bool where pPrint :: Bool -> Doc
pPrint = String -> Doc
text (String -> Doc) -> (Bool -> String) -> Bool -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> String
forall a. Show a => a -> String
show
instance Pretty Ordering where pPrint :: Ordering -> Doc
pPrint = String -> Doc
text (String -> Doc) -> (Ordering -> String) -> Ordering -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ordering -> String
forall a. Show a => a -> String
show
instance Pretty Char where
    pPrint :: Char -> Doc
pPrint = Char -> Doc
char
    pPrintList :: PrettyLevel -> String -> Doc
pPrintList PrettyLevel
_ = String -> Doc
text (String -> Doc) -> ShowS -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. Show a => a -> String
show
instance (Pretty a) => Pretty (Maybe a) where
    pPrintPrec :: PrettyLevel -> Rational -> Maybe a -> Doc
pPrintPrec PrettyLevel
l Rational
p Maybe a
Nothing = String -> Doc
text String
"Nothing"
    pPrintPrec PrettyLevel
l Rational
p (Just a
x) = Bool -> Doc -> Doc
prettyParen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
appPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"Just" Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l (Rational
appPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
1) a
x
instance (Pretty a, Pretty b) => Pretty (Either a b) where
    pPrintPrec :: PrettyLevel -> Rational -> Either a b -> Doc
pPrintPrec PrettyLevel
l Rational
p (Left a
x) = Bool -> Doc -> Doc
prettyParen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
appPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"Left" Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> a -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l (Rational
appPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
1) a
x
    pPrintPrec PrettyLevel
l Rational
p (Right b
x) = Bool -> Doc -> Doc
prettyParen (Rational
p Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
appPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"Right" Doc -> Doc -> Doc
<+> PrettyLevel -> Rational -> b -> Doc
forall a. Pretty a => PrettyLevel -> Rational -> a -> Doc
pPrintPrec PrettyLevel
l (Rational
appPrecRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
1) b
x

instance (Pretty a) => Pretty [a] where
    pPrintPrec :: PrettyLevel -> Rational -> [a] -> Doc
pPrintPrec PrettyLevel
l Rational
_ [a]
xs = PrettyLevel -> [a] -> Doc
forall a. Pretty a => PrettyLevel -> [a] -> Doc
pPrintList PrettyLevel
l [a]
xs

instance (Pretty a, Pretty b) => Pretty (a, b) where
    pPrintPrec :: PrettyLevel -> Rational -> (a, b) -> Doc
pPrintPrec PrettyLevel
l Rational
_ (a
a, b
b) =
        Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma [PrettyLevel -> a -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l a
a, PrettyLevel -> b -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l b
b]

instance (Pretty a, Pretty b, Pretty c) => Pretty (a, b, c) where
    pPrintPrec :: PrettyLevel -> Rational -> (a, b, c) -> Doc
pPrintPrec PrettyLevel
l Rational
_ (a
a, b
b, c
c) =
        Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma [PrettyLevel -> a -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l a
a, PrettyLevel -> b -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l b
b, PrettyLevel -> c -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l c
c]

instance (Pretty a, Pretty b, Pretty c, Pretty d) => Pretty (a, b, c, d) where
    pPrintPrec :: PrettyLevel -> Rational -> (a, b, c, d) -> Doc
pPrintPrec PrettyLevel
l Rational
_ (a
a, b
b, c
c, d
d) =
        Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma [PrettyLevel -> a -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l a
a, PrettyLevel -> b -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l b
b, PrettyLevel -> c -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l c
c, PrettyLevel -> d -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l d
d]

instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e) => Pretty (a, b, c, d, e) where
    pPrintPrec :: PrettyLevel -> Rational -> (a, b, c, d, e) -> Doc
pPrintPrec PrettyLevel
l Rational
_ (a
a, b
b, c
c, d
d, e
e) =
        Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma [PrettyLevel -> a -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l a
a, PrettyLevel -> b -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l b
b, PrettyLevel -> c -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l c
c, PrettyLevel -> d -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l d
d, PrettyLevel -> e -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l e
e]

instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f) => Pretty (a, b, c, d, e, f) where
    pPrintPrec :: PrettyLevel -> Rational -> (a, b, c, d, e, f) -> Doc
pPrintPrec PrettyLevel
l Rational
_ (a
a, b
b, c
c, d
d, e
e, f
f) =
        Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma [PrettyLevel -> a -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l a
a, PrettyLevel -> b -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l b
b, PrettyLevel -> c -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l c
c, PrettyLevel -> d -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l d
d, PrettyLevel -> e -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l e
e, PrettyLevel -> f -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l f
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 :: PrettyLevel -> Rational -> (a, b, c, d, e, f, g) -> Doc
pPrintPrec PrettyLevel
l Rational
_ (a
a, b
b, c
c, d
d, e
e, f
f, g
g) =
        Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma [PrettyLevel -> a -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l a
a, PrettyLevel -> b -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l b
b, PrettyLevel -> c -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l c
c, PrettyLevel -> d -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l d
d, PrettyLevel -> e -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l e
e, PrettyLevel -> f -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l f
f, PrettyLevel -> g -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l g
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 :: PrettyLevel -> Rational -> (a, b, c, d, e, f, g, h) -> Doc
pPrintPrec PrettyLevel
l Rational
_ (a
a, b
b, c
c, d
d, e
e, f
f, g
g, h
h) =
        Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma [PrettyLevel -> a -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l a
a, PrettyLevel -> b -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l b
b, PrettyLevel -> c -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l c
c, PrettyLevel -> d -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l d
d, PrettyLevel -> e -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l e
e, PrettyLevel -> f -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l f
f, PrettyLevel -> g -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l g
g, PrettyLevel -> h -> Doc
forall a. Pretty a => PrettyLevel -> a -> Doc
pPrint0 PrettyLevel
l h
h]