{-# LANGUAGE CPP #-}
module Curry.Base.Pretty
( module Curry.Base.Pretty
, module Text.PrettyPrint
) where
import Prelude hiding ((<>))
import Text.PrettyPrint
class Pretty a where
pPrint :: a -> Doc
pPrint = Int -> a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0
pPrintPrec :: Int -> a -> Doc
pPrintPrec _ = a -> Doc
forall a. Pretty a => a -> Doc
pPrint
pPrintList :: [a] -> Doc
pPrintList = 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 (Int -> a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0)
#if __GLASGOW_HASKELL__ >= 707
{-# MINIMAL pPrintPrec | pPrint #-}
#endif
prettyShow :: Pretty a => a -> String
prettyShow :: 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
parenIf :: Bool -> Doc -> Doc
parenIf :: Bool -> Doc -> Doc
parenIf False = Doc -> Doc
forall a. a -> a
id
parenIf True = Doc -> Doc
parens
ppIf :: Bool -> Doc -> Doc
ppIf :: Bool -> Doc -> Doc
ppIf True = Doc -> Doc
forall a. a -> a
id
ppIf False = Doc -> Doc -> Doc
forall a b. a -> b -> a
const Doc
empty
maybePP :: (a -> Doc) -> Maybe a -> Doc
maybePP :: (a -> Doc) -> Maybe a -> Doc
maybePP = Doc -> (a -> Doc) -> Maybe a -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty
blankLine :: Doc
blankLine :: Doc
blankLine = String -> Doc
text ""
($++$) :: Doc -> Doc -> Doc
d1 :: Doc
d1 $++$ :: Doc -> Doc -> Doc
$++$ d2 :: Doc
d2 | Doc -> Bool
isEmpty Doc
d1 = Doc
d2
| Doc -> Bool
isEmpty Doc
d2 = Doc
d1
| Bool
otherwise = Doc
d1 Doc -> Doc -> Doc
$+$ Doc
blankLine Doc -> Doc -> Doc
$+$ Doc
d2
($-$) :: Doc -> Doc -> Doc
d1 :: Doc
d1 $-$ :: Doc -> Doc -> Doc
$-$ d2 :: Doc
d2 | Doc -> Bool
isEmpty Doc
d1 = Doc
d2
| Doc -> Bool
isEmpty Doc
d2 = Doc
d1
| Bool
otherwise = Doc
d1 Doc -> Doc -> Doc
$$ Doc
space Doc -> Doc -> Doc
$$ Doc
d2
sepByBlankLine :: [Doc] -> Doc
sepByBlankLine :: [Doc] -> Doc
sepByBlankLine = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
($++$) Doc
empty
dot :: Doc
dot :: Doc
dot = Char -> Doc
char '.'
appPrec :: Int
appPrec :: Int
appPrec = 10
larrow :: Doc
larrow :: Doc
larrow = String -> Doc
text "<-"
rarrow :: Doc
rarrow :: Doc
rarrow = String -> Doc
text "->"
darrow :: Doc
darrow :: Doc
darrow = String -> Doc
text "=>"
backQuote :: Doc
backQuote :: Doc
backQuote = Char -> Doc
char '`'
backsl :: Doc
backsl :: Doc
backsl = Char -> Doc
char '\\'
vbar :: Doc
vbar :: Doc
vbar = Char -> Doc
char '|'
bquotes :: Doc -> Doc
bquotes :: Doc -> Doc
bquotes doc :: Doc
doc = Doc
backQuote Doc -> Doc -> Doc
<> Doc
doc Doc -> Doc -> Doc
<> Doc
backQuote
bquotesIf :: Bool -> Doc -> Doc
bquotesIf :: Bool -> Doc -> Doc
bquotesIf b :: Bool
b doc :: Doc
doc = if Bool
b then Doc -> Doc
bquotes Doc
doc else Doc
doc
list :: [Doc] -> Doc
list :: [Doc] -> Doc
list = [Doc] -> Doc
fsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Bool) -> [Doc] -> [Doc]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Doc -> Bool) -> Doc -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Bool
isEmpty)
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 "()"
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 :: String -> Doc
pPrintList = String -> Doc
text (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show
instance (Pretty a) => Pretty (Maybe a) where
pPrintPrec :: Int -> Maybe a -> Doc
pPrintPrec _ Nothing = String -> Doc
text "Nothing"
pPrintPrec p :: Int
p (Just x :: a
x) = Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec)
(Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "Just" Doc -> Doc -> Doc
<+> Int -> a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) a
x
instance (Pretty a, Pretty b) => Pretty (Either a b) where
pPrintPrec :: Int -> Either a b -> Doc
pPrintPrec p :: Int
p (Left x :: a
x) = Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec)
(Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "Left" Doc -> Doc -> Doc
<+> Int -> a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) a
x
pPrintPrec p :: Int
p (Right x :: b
x) = Bool -> Doc -> Doc
parenIf (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec)
(Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "Right" Doc -> Doc -> Doc
<+> Int -> b -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec (Int
appPrec Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) b
x
instance (Pretty a) => Pretty [a] where
pPrintPrec :: Int -> [a] -> Doc
pPrintPrec _ = [a] -> Doc
forall a. Pretty a => [a] -> Doc
pPrintList
instance (Pretty a, Pretty b) => Pretty (a, b) where
pPrintPrec :: Int -> (a, b) -> Doc
pPrintPrec _ (a :: a
a, b :: 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 [a -> Doc
forall a. Pretty a => a -> Doc
pPrint a
a, b -> Doc
forall a. Pretty a => a -> Doc
pPrint b
b]
instance (Pretty a, Pretty b, Pretty c) => Pretty (a, b, c) where
pPrintPrec :: Int -> (a, b, c) -> Doc
pPrintPrec _ (a :: a
a, b :: b
b, c :: 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
[a -> Doc
forall a. Pretty a => a -> Doc
pPrint a
a, b -> Doc
forall a. Pretty a => a -> Doc
pPrint b
b, c -> Doc
forall a. Pretty a => a -> Doc
pPrint c
c]
instance (Pretty a, Pretty b, Pretty c, Pretty d) => Pretty (a, b, c, d) where
pPrintPrec :: Int -> (a, b, c, d) -> Doc
pPrintPrec _ (a :: a
a, b :: b
b, c :: c
c, d :: 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
[a -> Doc
forall a. Pretty a => a -> Doc
pPrint a
a, b -> Doc
forall a. Pretty a => a -> Doc
pPrint b
b, c -> Doc
forall a. Pretty a => a -> Doc
pPrint c
c, d -> Doc
forall a. Pretty a => a -> Doc
pPrint d
d]
instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e)
=> Pretty (a, b, c, d, e) where
pPrintPrec :: Int -> (a, b, c, d, e) -> Doc
pPrintPrec _ (a :: a
a, b :: b
b, c :: c
c, d :: d
d, e :: 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
[a -> Doc
forall a. Pretty a => a -> Doc
pPrint a
a, b -> Doc
forall a. Pretty a => a -> Doc
pPrint b
b, c -> Doc
forall a. Pretty a => a -> Doc
pPrint c
c, d -> Doc
forall a. Pretty a => a -> Doc
pPrint d
d, e -> Doc
forall a. Pretty a => a -> Doc
pPrint e
e]
instance (Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f)
=> Pretty (a, b, c, d, e, f) where
pPrintPrec :: Int -> (a, b, c, d, e, f) -> Doc
pPrintPrec _ (a :: a
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: 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
[a -> Doc
forall a. Pretty a => a -> Doc
pPrint a
a, b -> Doc
forall a. Pretty a => a -> Doc
pPrint b
b, c -> Doc
forall a. Pretty a => a -> Doc
pPrint c
c, d -> Doc
forall a. Pretty a => a -> Doc
pPrint d
d, e -> Doc
forall a. Pretty a => a -> Doc
pPrint e
e, f -> Doc
forall a. Pretty a => a -> Doc
pPrint 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 :: Int -> (a, b, c, d, e, f, g) -> Doc
pPrintPrec _ (a :: a
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: 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
[a -> Doc
forall a. Pretty a => a -> Doc
pPrint a
a, b -> Doc
forall a. Pretty a => a -> Doc
pPrint b
b, c -> Doc
forall a. Pretty a => a -> Doc
pPrint c
c, d -> Doc
forall a. Pretty a => a -> Doc
pPrint d
d, e -> Doc
forall a. Pretty a => a -> Doc
pPrint e
e, f -> Doc
forall a. Pretty a => a -> Doc
pPrint f
f, g -> Doc
forall a. Pretty a => a -> Doc
pPrint 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 :: Int -> (a, b, c, d, e, f, g, h) -> Doc
pPrintPrec _ (a :: a
a, b :: b
b, c :: c
c, d :: d
d, e :: e
e, f :: f
f, g :: g
g, h :: 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
[a -> Doc
forall a. Pretty a => a -> Doc
pPrint a
a, b -> Doc
forall a. Pretty a => a -> Doc
pPrint b
b, c -> Doc
forall a. Pretty a => a -> Doc
pPrint c
c, d -> Doc
forall a. Pretty a => a -> Doc
pPrint d
d, e -> Doc
forall a. Pretty a => a -> Doc
pPrint e
e, f -> Doc
forall a. Pretty a => a -> Doc
pPrint f
f, g -> Doc
forall a. Pretty a => a -> Doc
pPrint g
g, h -> Doc
forall a. Pretty a => a -> Doc
pPrint h
h]