{-# LANGUAGE CPP #-}
module Options.Applicative.Help.Pretty
  ( module Text.PrettyPrint.ANSI.Leijen
  , (.$.)
  , groupOrNestLine
  , altSep
  , hangAtIfOver
  ) where

import           Control.Applicative
#if !MIN_VERSION_base(4,11,0)
import           Data.Semigroup ((<>))
#endif

import           Text.PrettyPrint.ANSI.Leijen hiding ((<$>), (<>), columns)
import           Text.PrettyPrint.ANSI.Leijen.Internal (Doc (..), flatten)
import qualified Text.PrettyPrint.ANSI.Leijen as PP

import           Prelude

(.$.) :: Doc -> Doc -> Doc
.$. :: Doc -> Doc -> Doc
(.$.) = Doc -> Doc -> Doc
(PP.<$>)


-- | Apply the function if we're not at the
--   start of our nesting level.
ifNotAtRoot :: (Doc -> Doc) -> Doc -> Doc
ifNotAtRoot :: (Doc -> Doc) -> Doc -> Doc
ifNotAtRoot =
  (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
ifElseAtRoot Doc -> Doc
forall a. a -> a
id

-- | Apply the function if we're not at the
--   start of our nesting level.
ifAtRoot :: (Doc -> Doc) -> Doc -> Doc
ifAtRoot :: (Doc -> Doc) -> Doc -> Doc
ifAtRoot =
  ((Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc)
-> (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
ifElseAtRoot Doc -> Doc
forall a. a -> a
id

-- | Apply the function if we're not at the
--   start of our nesting level.
ifElseAtRoot :: (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
ifElseAtRoot :: (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
ifElseAtRoot Doc -> Doc
f Doc -> Doc
g Doc
doc =
  (Int -> Doc) -> Doc
Nesting ((Int -> Doc) -> Doc) -> (Int -> Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ \Int
i ->
    (Int -> Doc) -> Doc
Column ((Int -> Doc) -> Doc) -> (Int -> Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ \Int
j ->
      if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j
        then Doc -> Doc
f Doc
doc
        else Doc -> Doc
g Doc
doc


-- | Render flattened text on this line, or start
--   a new line before rendering any text.
--
--   This will also nest subsequent lines in the
--   group.
groupOrNestLine :: Doc -> Doc
groupOrNestLine :: Doc -> Doc
groupOrNestLine =
  Doc -> Doc -> Doc
Union
    (Doc -> Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc -> Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Doc -> Doc
flatten
    (Doc -> Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Doc -> Doc) -> Doc -> Doc
ifNotAtRoot (Doc
line Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>) (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc -> Doc
nest Int
2


-- | Separate items in an alternative with a pipe.
--
--   If the first document and the pipe don't fit
--   on the line, then mandatorily flow the next entry
--   onto the following line.
--
--   The (<//>) softbreak ensures that if the document
--   does fit on the line, there is at least a space,
--   but it's possible for y to still appear on the
--   next line.
altSep :: Doc -> Doc -> Doc
altSep :: Doc -> Doc -> Doc
altSep Doc
x Doc
y =
  Doc -> Doc
group (Doc
x Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'|' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
line) Doc -> Doc -> Doc
<//> Doc
y


-- | Printer hacks to get nice indentation for long commands
--   and subcommands.
--
--   If we're starting this section over the desired width
--   (usually 1/3 of the ribbon), then we will make a line
--   break, indent all of the usage, and go.
--
--   The ifAtRoot is an interesting clause. If this whole
--   operation is put under a `group` then the linebreak
--   will disappear; then item d will therefore not be at
--   the starting column, and it won't be indented more.
hangAtIfOver :: Int -> Int -> Doc -> Doc
hangAtIfOver :: Int -> Int -> Doc -> Doc
hangAtIfOver Int
i Int
j Doc
d =
  (Int -> Doc) -> Doc
Column ((Int -> Doc) -> Doc) -> (Int -> Doc) -> Doc
forall a b. (a -> b) -> a -> b
$ \Int
k ->
    if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
j then
      Doc -> Doc
align Doc
d
    else
      Doc
linebreak Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (Doc -> Doc) -> Doc -> Doc
ifAtRoot (Int -> Doc -> Doc
indent Int
i) Doc
d