{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Extends ''Text.PrettyPrint''.

module BNFC.PrettyPrint
  ( module Text.PrettyPrint
  , module BNFC.PrettyPrint
  ) where

import Text.PrettyPrint

-- | Overloaded function 'pretty'.

class Pretty a where
  pretty     :: a -> Doc
  prettyPrec :: Int -> a -> Doc

  {-# MINIMAL pretty | prettyPrec #-}
  pretty = Int -> a -> Doc
forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
0
  prettyPrec Int
_ = a -> Doc
forall a. Pretty a => a -> Doc
pretty

instance Pretty Int     where pretty :: Int -> Doc
pretty = String -> Doc
text (String -> Doc) -> (Int -> String) -> Int -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show
instance Pretty Integer where pretty :: Integer -> Doc
pretty = String -> Doc
text (String -> Doc) -> (Integer -> String) -> Integer -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show

instance Pretty String  where pretty :: String -> Doc
pretty = String -> Doc
text

-- | Render as 'String'.

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
pretty

-- | Put 'parens' around document if given condition is true.
--
-- >>> parensIf True "foo"
-- (foo)
--
-- >>> parensIf False "bar"
-- bar
--
parensIf :: Bool -> Doc -> Doc
parensIf :: Bool -> Doc -> Doc
parensIf = \case
  Bool
True  -> Doc -> Doc
parens
  Bool
False -> Doc -> Doc
forall a. a -> a
id

-- | Separate vertically by a blank line.
--
-- >>> "foo" $++$ "bar"
-- foo
-- <BLANKLINE>
-- bar
--
-- >>> "foo" $++$ empty
-- foo
--
($++$) :: Doc -> Doc -> Doc
Doc
d $++$ :: Doc -> Doc -> Doc
$++$ Doc
d'
  | Doc -> Bool
isEmpty Doc
d  = Doc
d'
  | Doc -> Bool
isEmpty Doc
d' = Doc
d
  | Bool
otherwise  = Doc
d Doc -> Doc -> Doc
$+$ Doc
"" Doc -> Doc -> Doc
$+$ Doc
d'

-- | List version of '$++$'.
--
-- >>> vsep [ "foo", nest 4 "bar" ]
-- foo
-- <BLANKLINE>
--     bar
--
-- >>> vsep []
-- <BLANKLINE>
--
vsep :: [Doc] -> Doc
vsep :: [Doc] -> Doc
vsep = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Doc -> Doc -> Doc
($++$) Doc
empty

-- | List version of 'PrettyPrint.$+$'.
--
-- >>> vcat' [text "abc", nest 4 (text "def")]
-- abc
--     def
--
vcat' :: [Doc] -> Doc
vcat' :: [Doc] -> Doc
vcat' = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Doc -> Doc -> Doc
($+$) Doc
empty

-- | Pretty print separator with = (for assignments...).
--
-- >>> "a" <=> "123"
-- a = 123
--
(<=>) :: Doc -> Doc -> Doc
Doc
a <=> :: Doc -> Doc -> Doc
<=> Doc
b = Doc
a Doc -> Doc -> Doc
<+> String -> Doc
text String
"=" Doc -> Doc -> Doc
<+> Doc
b

-- | Print a list of 0-1 elements on the same line as some preamble
--   and from 2 elements on the following lines, indented.
--
-- >>> prettyList 2 ("foo" <+> equals) lbrack rbrack comma []
-- foo = []
-- >>> prettyList 2 ("foo" <+> equals) lbrack rbrack comma [ "a" ]
-- foo = [a]
-- >>> prettyList 2 ("foo" <+> equals) lbrack rbrack comma [ "a", "b" ]
-- foo =
--   [ a
--   , b
--   ]
--
-- Used in the Agda backend.
prettyList
  :: Int   -- ^ Indentation.
  -> Doc   -- ^ Preamble.
  -> Doc   -- ^ Left parenthesis.
  -> Doc   -- ^ Right parenthesis.
  -> Doc   -- ^ Separator (usually not including spaces).
  -> [Doc] -- ^ List item.
  -> Doc
prettyList :: Int -> Doc -> Doc -> Doc -> Doc -> [Doc] -> Doc
prettyList Int
n Doc
pre Doc
lpar Doc
rpar Doc
sepa = \case
  []     -> Doc
pre Doc -> Doc -> Doc
<+> [Doc] -> Doc
hcat [ Doc
lpar, Doc
rpar ]
  [Doc
d]    -> Doc
pre Doc -> Doc -> Doc
<+> [Doc] -> Doc
hcat [ Doc
lpar, Doc
d, Doc
rpar ]
  (Doc
d:[Doc]
ds) -> [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([[Doc]] -> [Doc]) -> [[Doc]] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc
pre Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:) ([Doc] -> [Doc]) -> ([[Doc]] -> [Doc]) -> [[Doc]] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
n) ([Doc] -> [Doc]) -> ([[Doc]] -> [Doc]) -> [[Doc]] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Doc]] -> [Doc]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Doc]] -> Doc) -> [[Doc]] -> Doc
forall a b. (a -> b) -> a -> b
$
    [ [ Doc
lpar Doc -> Doc -> Doc
<+> Doc
d ]
    , (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc
sepa Doc -> Doc -> Doc
<+>) [Doc]
ds
    , [ Doc
rpar ]
    ]

-- | Code block. A block of C/Java code, surrounded by {} and indented.
--
-- >>> codeblock 4 ["abc", "def"]
-- {
--     abc
--     def
-- }
--
--   Used in the C backend.
codeblock :: Int -> [Doc] -> Doc
codeblock :: Int -> [Doc] -> Doc
codeblock Int
indent [Doc]
code = Doc
lbrace Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
nest Int
indent ([Doc] -> Doc
vcat [Doc]
code) Doc -> Doc -> Doc
$+$ Doc
rbrace