{- |
    Module      :  $Header$
    Description :  Pretty printing
    Copyright   :  (c) 2013 - 2014 Björn Peemöller
                       2016        Finn Teegen
    License     :  BSD-3-clause

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  stable
    Portability :  portable

    This module re-exports the well known pretty printing combinators
    from Hughes and Peyton-Jones. In addition, it re-exports the type class
    'Pretty' for pretty printing arbitrary types.
-}
{-# LANGUAGE CPP #-}
module Curry.Base.Pretty
  ( module Curry.Base.Pretty
  , module Text.PrettyPrint
  ) where

import Prelude hiding ((<>))

import Text.PrettyPrint

-- | 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
  -- | Pretty-print something in isolation.
  pPrint :: a -> Doc
  pPrint = Int -> a -> Doc
forall a. Pretty a => Int -> a -> Doc
pPrintPrec 0

  -- | Pretty-print something in a precedence context.
  pPrintPrec :: Int -> a -> Doc
  pPrintPrec _ = a -> Doc
forall a. Pretty a => a -> Doc
pPrint

  -- |Pretty-print a list.
  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

-- | Pretty print a value to a 'String'.
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

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

-- | Pretty print a value if the boolean is true
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

-- | Pretty print a 'Maybe' value for the 'Just' constructor only
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

-- | A blank line.
blankLine :: Doc
blankLine :: Doc
blankLine = String -> Doc
text ""

-- |Above with a blank line in between. If one of the documents is empty,
-- then the other document is returned.
($++$) :: 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

-- |Above with overlapping, but with a space in between. If one of the
-- documents is empty, then the other document is returned.
($-$) :: 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

-- | Seperate a list of 'Doc's by a 'blankLine'.
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

-- |A '.' character.
dot :: Doc
dot :: Doc
dot = Char -> Doc
char '.'

-- |Precedence of function application
appPrec :: Int
appPrec :: Int
appPrec = 10

-- |A left arrow @<-@.
larrow :: Doc
larrow :: Doc
larrow = String -> Doc
text "<-"

-- |A right arrow @->@.
rarrow :: Doc
rarrow :: Doc
rarrow = String -> Doc
text "->"

-- |A double arrow @=>@.
darrow :: Doc
darrow :: Doc
darrow = String -> Doc
text "=>"

-- |A back quote @`@.
backQuote :: Doc
backQuote :: Doc
backQuote = Char -> Doc
char '`'

-- |A backslash @\@.
backsl :: Doc
backsl :: Doc
backsl = Char -> Doc
char '\\'

-- |A vertical bar @|@.
vbar :: Doc
vbar :: Doc
vbar = Char -> Doc
char '|'

-- |Set a document in backquotes.
bquotes :: Doc -> Doc
bquotes :: Doc -> Doc
bquotes doc :: Doc
doc = Doc
backQuote Doc -> Doc -> Doc
<> Doc
doc Doc -> Doc -> Doc
<> Doc
backQuote

-- |Set a document in backquotes if the condition is @True@.
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

-- |Seperate a list of documents by commas
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 for 'Int'
instance Pretty Int      where pPrint :: Int -> Doc
pPrint = Int -> Doc
int

-- | Instance for 'Integer'
instance Pretty Integer  where pPrint :: Integer -> Doc
pPrint = Integer -> Doc
integer

-- | Instance for 'Float'
instance Pretty Float    where pPrint :: Float -> Doc
pPrint = Float -> Doc
float

-- | Instance for 'Double'
instance Pretty Double   where pPrint :: Double -> Doc
pPrint = Double -> Doc
double

-- | Instance for '()'
instance Pretty ()       where pPrint :: () -> Doc
pPrint _ = String -> Doc
text "()"

-- | Instance for 'Bool'
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 for 'Ordering'
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 for 'Char'
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 for 'Maybe'
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 for 'Either'
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 for '[]'
instance (Pretty a) => Pretty [a] where
  pPrintPrec :: Int -> [a] -> Doc
pPrintPrec _ = [a] -> Doc
forall a. Pretty a => [a] -> Doc
pPrintList

-- | Instance for '(,)'
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 for '(,,)'
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 for '(,,,)'
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 for '(,,,,)'
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 for '(,,,,,)'
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 for '(,,,,,,)'
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 for '(,,,,,,,)'
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]