{-# LANGUAGE GADTs
           , OverloadedStrings #-}

{- | Pretty-printing functions for composing the help document.
 -}

module Data.Console.Options.Help
  ( name
  , option
  , description
  ) where

import           Data.Console.Options
import qualified Data.Text.Short as ST
import           Prettyprinter
import           Prettyprinter.Internal.Type



-- | Option name.
--
--   >>> name (Short 'h')
--   -h
--   >>> name (Long "long-foo")
--   --long-foo
name :: Name -> Doc ann
name :: forall ann. Name -> Doc ann
name (Short Char
c) =  Doc ann
"-" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ann
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
c
name (Long ShortText
ls) = Doc ann
"--" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty (ShortText -> Text
ST.toText ShortText
ls)



-- | Option together with the argument name, if applicable.
--
--   >>> option $ Option [Short 'f', Long "foo"] Plain
--   -f, --foo
--   >>> option $ Option [Long "bar", Long "baz"] (Required "FILE")
--   --bar, --baz=FILE
option :: Option (Doc ann) f arg -> Doc ann
option :: forall ann f arg. Option (Doc ann) f arg -> Doc ann
option (Option [Name]
ns Flavor (Doc ann) f arg
f) =
  case [Name]
ns of
    []    -> Doc ann
forall ann. Doc ann
emptyDoc
    Name
n:[Name]
ns' -> Name -> Doc ann
forall ann. Name -> Doc ann
name Name
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (Name -> Doc ann -> Doc ann) -> Doc ann -> [Name] -> Doc ann
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Name
a Doc ann
b -> Doc ann
forall ann. Doc ann
softline' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
", " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Name -> Doc ann
forall ann. Name -> Doc ann
name Name
a Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
b) (Flavor (Doc ann) f arg -> Doc ann
forall ann f arg. Flavor (Doc ann) f arg -> Doc ann
flavor Flavor (Doc ann) f arg
f) [Name]
ns'
  where
    flavor :: Flavor (Doc ann) f arg -> Doc ann
    flavor :: forall ann f arg. Flavor (Doc ann) f arg -> Doc ann
flavor  Flavor (Doc ann) f arg
Plain         = Doc ann
forall ann. Doc ann
emptyDoc
    flavor (Optional Doc ann
doc) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Doc ann
forall ann. Doc ann
equals Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
doc)
    flavor (Required Doc ann
doc) = Doc ann
forall ann. Doc ann
equals Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
doc



-- | Help description for a given option.
--
--   The help text is laid out at base indentation. Additionally the first line
--   of help text can shift based on the increment, in the case that the list
--   of option names is longer than base indentation.
--
--   >>> let help = reflow "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor..."
--   >>> let opt = Option [Long "foo"] Plain
--   >>> putDocW 80 $ description 32 8 opt help
--       --foo                       Lorem ipsum dolor sit amet, consectetur
--                                   adipiscing elit, sed do eiusmod tempor...
--   >>> let opt = Option [Short 'f', Long "foo", Long "tediously-long-bar", Long "baz"] (Required "FILE")
--   >>> putDocW 80 $ description 32 8 opt help
--   -f, --foo, --tediously-long-bar, --baz=FILE     Lorem ipsum dolor sit amet,
--                                   consectetur adipiscing elit, sed do eiusmod
--                                   tempor...
description
  :: Int                    -- ^ Base help text indentation
  -> Int                    -- ^ Indentation increment
  -> Option (Doc ann) f arg
  -> Doc ann                -- ^ Help text
  -> Doc ann
description :: forall ann f arg.
Int -> Int -> Option (Doc ann) f arg -> Doc ann -> Doc ann
description Int
offset Int
fracs opt :: Option (Doc ann) f arg
opt@(Option [Name]
names Flavor (Doc ann) f arg
_) Doc ann
doc =
  Doc ann -> (Int -> Doc ann) -> Doc ann
forall ann. Doc ann -> (Int -> Doc ann) -> Doc ann
width
    ( let base :: Doc ann
base = Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Option (Doc ann) f arg -> Doc ann
forall ann f arg. Option (Doc ann) f arg -> Doc ann
option Option (Doc ann) f arg
opt)
      in case [Name]
names of
           Long ShortText
_ : [Name]
_ -> Doc ann
"    " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
base
           [Name]
_          ->           Doc ann
base
    )
    ( \Int
i ->
       Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
offset (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
         let spaces :: Int
spaces
               | Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
offset = Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
               | Bool
otherwise      = let r :: Int
r = (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
fracs

                                  in if Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
fracs
                                       then Int
fracs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
fracs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r)
                                       else Int
fracs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r

         in Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Union (Int -> Text -> Doc ann
forall ann. Int -> Text -> Doc ann
Text Int
spaces (Text -> Doc ann) -> (ShortText -> Text) -> ShortText -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Text
ST.toText (ShortText -> Doc ann) -> ShortText -> Doc ann
forall a b. (a -> b) -> a -> b
$ Int -> ShortText -> ShortText
ST.replicate Int
spaces ShortText
" ") Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
doc
    )