{-# LANGUAGE OverloadedStrings #-}

module Prettyprinter.Custom (
  brackets',
  braces',
  parens',
  sexp,
  (<?>),
  vcatHard,
) where

import Prettyprinter

{- | An area bracketed by two delimiters. When on multiple lines the delimiters are not
indented but the content is.
-}
section' :: Doc a -> Doc a -> Doc a -> Doc a
-- The subtlety here is that the nest call surrounds the first delimiter and the content, but not
-- the final one. This is because of how nest behaves, where it doesn't indent until it hits
-- the first line break. So we need to include the first delimiter so that the main content gets
-- indented, but not the final delimiter.
section' :: forall a. Doc a -> Doc a -> Doc a -> Doc a
section' Doc a
c1 Doc a
c2 Doc a
d = Doc a -> Doc a
forall ann. Doc ann -> Doc ann
group (Doc a -> Doc a) -> Doc a -> Doc a
forall a b. (a -> b) -> a -> b
$ Int -> Doc a -> Doc a
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc a
c1 Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
d) Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
c2

{- | An area bracketed by two delimiters. When on one line, there are spaces between the delimiters
and the content, when on multiple lines the delimiters are not indented but the content is.
-}
section :: Doc a -> Doc a -> Doc a -> Doc a
section :: forall a. Doc a -> Doc a -> Doc a -> Doc a
section Doc a
c1 Doc a
c2 = Doc a -> Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a -> Doc a
section' (Doc a
c1 Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
forall ann. Doc ann
line) (Doc a
forall ann. Doc ann
line Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
c2)

{- | This prints a document enclosed by brackets, possibly indenting the output on
a new line if it does not fit.
-}
brackets' :: Doc a -> Doc a
brackets' :: forall ann. Doc ann -> Doc ann
brackets' = Doc a -> Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a -> Doc a
section Doc a
"[" Doc a
"]"

{- | This prints a document enclosed by braces, possibly indenting the output on
a new line if it does not fit.
-}
braces' :: Doc a -> Doc a
braces' :: forall ann. Doc ann -> Doc ann
braces' = Doc a -> Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a -> Doc a
section Doc a
"{" Doc a
"}"

{- | This prints a document enclosed by parentheses, aligning the opening and
closing parentheses.
-}
parens' :: Doc a -> Doc a
parens' :: forall ann. Doc ann -> Doc ann
parens' = Doc a -> Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a -> Doc a
section Doc a
"(" Doc a
")"

-- | Print a "sexp", i.e. something like "(keyword arg1 ... argN)".
sexp :: Doc a -> [Doc a] -> Doc a
sexp :: forall a. Doc a -> [Doc a] -> Doc a
sexp Doc a
a [Doc a]
es =
  -- This is a bit funny, because we want the keyword to "stick" to the opening parenthesis
  -- when it's split over multiple lines. So we include it in the "initial" segment. But then
  -- we also have to have a space after that rather than no space. So we start with "(keyword"
  -- and a line-or-space, but end with a line-or-nothing and ")".
  -- However if @es@ is empty, then we don't want to insert a space right before @)@, so in that
  -- case we use line-or-nothing as well.
  Doc a -> Doc a -> Doc a -> Doc a
forall a. Doc a -> Doc a -> Doc a -> Doc a
section' (Doc a
"(" Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
a Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> if [Doc a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc a]
es then Doc a
forall ann. Doc ann
line' else Doc a
forall ann. Doc ann
line) (Doc a
forall ann. Doc ann
line' Doc a -> Doc a -> Doc a
forall a. Semigroup a => a -> a -> a
<> Doc a
")") ([Doc a] -> Doc a
forall ann. [Doc ann] -> Doc ann
sep [Doc a]
es)

{- | Lay out a sequence of documents vertically with forced lines between documents. Useful
for prettyprinting layout-sensitive things like let-bindings.
-}
vcatHard :: [Doc ann] -> Doc ann
vcatHard :: forall ann. [Doc ann] -> Doc ann
vcatHard = (Doc ann -> Doc ann -> Doc ann) -> [Doc ann] -> Doc ann
forall (t :: * -> *) ann.
Foldable t =>
(Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann
concatWith (\Doc ann
x Doc ann
y -> Doc ann
x Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
y)

{- | Separate two documents `p` and `q` and increase indentation if `q` has to be put on a new
line. Useful to e.g. pretty-print function application like `fun <?> sep arguments`.
-}
(<?>) :: Doc ann -> Doc ann -> Doc ann
Doc ann
p <?> :: forall ann. Doc ann -> Doc ann -> Doc ann
<?> Doc ann
q = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
align (Doc ann -> Doc ann) -> (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep [Doc ann
p, Doc ann
q]

infixr 6 <?>