{-# LANGUAGE CPP #-}
module Options.Applicative.Help.Pretty
  ( module Prettyprinter
  , module Prettyprinter.Render.Terminal
  , Doc
  , SimpleDoc

  , (.$.)
  , (</>)

  , groupOrNestLine
  , altSep
  , hangAtIfOver

  , prettyString
  ) where

#if !MIN_VERSION_base(4,11,0)
import           Data.Semigroup ((<>), mempty)
#endif
import qualified Data.Text.Lazy as Lazy

import           Prettyprinter hiding (Doc)
import qualified Prettyprinter as PP
import           Prettyprinter.Render.Terminal

import           Prelude

type Doc = PP.Doc AnsiStyle
type SimpleDoc = SimpleDocStream AnsiStyle

linebreak :: Doc
linebreak :: Doc
linebreak = forall ann. Doc ann -> Doc ann -> Doc ann
flatAlt forall ann. Doc ann
line forall a. Monoid a => a
mempty

(.$.) :: Doc -> Doc -> Doc
Doc
x .$. :: Doc -> Doc -> Doc
.$. Doc
y = Doc
x forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line forall a. Semigroup a => a -> a -> a
<> Doc
y
(</>) :: Doc -> Doc -> Doc
Doc
x </> :: Doc -> Doc -> Doc
</> Doc
y = Doc
x forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
softline forall a. Semigroup a => a -> a -> a
<> Doc
y

-- | 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 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 =
  forall a b c. (a -> b -> c) -> b -> a -> c
flip (Doc -> Doc) -> (Doc -> Doc) -> Doc -> Doc
ifElseAtRoot 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 =
  forall ann. (Int -> Doc ann) -> Doc ann
nesting forall a b. (a -> b) -> a -> b
$ \Int
i ->
    forall ann. (Int -> Doc ann) -> Doc ann
column forall a b. (a -> b) -> a -> b
$ \Int
j ->
      if Int
i 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 =
  forall ann. Doc ann -> Doc ann
group forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc) -> Doc -> Doc
ifNotAtRoot (Doc
linebreak forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. Int -> Doc ann -> Doc ann
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 =
  forall ann. Doc ann -> Doc ann
group (Doc
x forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Char
'|' forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line) forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann -> Doc ann
group Doc
linebreak forall a. Semigroup a => a -> a -> a
<>  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 =
  forall ann. (Int -> Doc ann) -> Doc ann
column forall a b. (a -> b) -> a -> b
$ \Int
k ->
    if Int
k forall a. Ord a => a -> a -> Bool
<= Int
j then
      forall ann. Doc ann -> Doc ann
align Doc
d
    else
      Doc
linebreak forall a. Semigroup a => a -> a -> a
<> (Doc -> Doc) -> Doc -> Doc
ifAtRoot (forall ann. Int -> Doc ann -> Doc ann
indent Int
i) Doc
d


renderPretty :: Double -> Int -> Doc -> SimpleDocStream AnsiStyle
renderPretty :: Double -> Int -> Doc -> SimpleDocStream AnsiStyle
renderPretty Double
ribbonFraction Int
lineWidth
  = forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
      { layoutPageWidth :: PageWidth
layoutPageWidth = Int -> Double -> PageWidth
AvailablePerLine Int
lineWidth Double
ribbonFraction }

prettyString :: Double -> Int -> Doc -> String
prettyString :: Double -> Int -> Doc -> String
prettyString Double
ribbonFraction Int
lineWidth
  = SimpleDocStream AnsiStyle -> String
streamToString
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int -> Doc -> SimpleDocStream AnsiStyle
renderPretty Double
ribbonFraction Int
lineWidth

streamToString :: SimpleDocStream AnsiStyle -> String
streamToString :: SimpleDocStream AnsiStyle -> String
streamToString SimpleDocStream AnsiStyle
sdoc =
  let
    rendered :: Text
rendered =
      SimpleDocStream AnsiStyle -> Text
Prettyprinter.Render.Terminal.renderLazy SimpleDocStream AnsiStyle
sdoc
  in
    Text -> String
Lazy.unpack Text
rendered