module Language.Haskell.FreeTheorems.PrettyBase where



import Text.PrettyPrint



-- | Prints a list of documents where all documents not fitting on a line are
--   printed in following lines indented by the amount given as the first
--   argument.

isep :: Int -> [Doc] -> Doc
isep :: Int -> [Doc] -> Doc
isep Int
_ [] = Doc
empty
isep Int
n (Doc
d:[Doc]
ds) = Int -> Doc -> Doc
nest Int
n forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
fsep forall a b. (a -> b) -> a -> b
$ (Int -> Doc -> Doc
nest (-Int
n) Doc
d) forall a. a -> [a] -> [a]
: [Doc]
ds



-- | Puts parentheses around a document, if the first argument is 'True'.

parensIf :: Bool -> Doc -> Doc
parensIf :: Bool -> Doc -> Doc
parensIf Bool
putParens = if Bool
putParens then Doc -> Doc
parens else forall a. a -> a
id



-- | A data type to describe around which type expressions parentheses are to be
--   put.

data Parens
  = NoParens        -- ^ Don't put any parentheses.
  | ParensFun       -- ^ The type expression occurs as an argument to a
                    --   function.
  | ParensFunOrCon  -- ^ The type expression occurs as an argument to a
                    --   function, type constructor or type class.
  deriving (Parens -> Parens -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parens -> Parens -> Bool
$c/= :: Parens -> Parens -> Bool
== :: Parens -> Parens -> Bool
$c== :: Parens -> Parens -> Bool
Eq, Eq Parens
Parens -> Parens -> Bool
Parens -> Parens -> Ordering
Parens -> Parens -> Parens
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
min :: Parens -> Parens -> Parens
$cmin :: Parens -> Parens -> Parens
max :: Parens -> Parens -> Parens
$cmax :: Parens -> Parens -> Parens
>= :: Parens -> Parens -> Bool
$c>= :: Parens -> Parens -> Bool
> :: Parens -> Parens -> Bool
$c> :: Parens -> Parens -> Bool
<= :: Parens -> Parens -> Bool
$c<= :: Parens -> Parens -> Bool
< :: Parens -> Parens -> Bool
$c< :: Parens -> Parens -> Bool
compare :: Parens -> Parens -> Ordering
$ccompare :: Parens -> Parens -> Ordering
Ord)



-- | Returns a document when a condition holds. Otherwise, the empty document
--   is returned.

when :: Bool -> Doc -> Doc
when :: Bool -> Doc -> Doc
when Bool
False = forall a b. a -> b -> a
const Doc
empty
when Bool
True  = forall a. a -> a
id



-- | Returns a list of documents when a condition holds. Otherwise, the empty
--   list is returned.

whenL :: Bool -> [Doc] -> [Doc]
whenL :: Bool -> [Doc] -> [Doc]
whenL Bool
False = forall a b. a -> b -> a
const []
whenL Bool
True  = forall a. a -> a
id