{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

-- | Support for displaying a full help message as a Box (https://hackage.haskell.org/package/boxes)
--
--   The main display function uses a registry to register various
--   @Display "name" Data Box@ values which depend on each other
--
--   Display "name" Data Box is responsible for the display of "Data" in the section "name" as a Box,
--   which can then be rendered as Text with 'renderBox'.
--
--   For example there is a @Display "command-options" Help Box@ to display the options of a given command
--   (represented as a 'Help' value) in 2 columns: option flags / option help text.
--
--   This 'Display' value depends on 2 other 'Display' values:
--
--     - @Display "option-flag" OptionDescription Box@ to display the flag of an option
--     - @Display "option-help" OptionDescription Box@ to display the help of an option
--
--   It is possible to modify the display of the overall help of a command by adding a different display on top of
--   the registry of displays. For example
--   @
--   myDisplayBoxRegistry =
--     fun myDisplayOptionFlagBox <: displayBoxRegistry
--
--   myDisplayOptionFlagBox :: Display "option-flag" OptionDescription Box
--   myDisplayOptionFlagBox = Display $ fromMaybe "" . _name -- just use the option long name
--
--   myDisplayHelp :: Help -> Box
--   myDisplayHelp = renderBox . display (make @(Display "any" Help Box) myDisplayBoxRegistry)
--   @
module Data.Registry.Options.DisplayHelpBox where

import Data.Coerce (coerce)
import Data.Registry hiding ((<+>))
import Data.Registry.Options.Display
import Data.Registry.Options.Help
import Data.Registry.Options.OptionDescription hiding (help)
import Data.Text qualified as T
import Protolude hiding (Any, list)
import Text.PrettyPrint.Boxes hiding ((<>))

-- | Default display for a Help Text
displayHelp :: Help -> Text
displayHelp :: Help -> Text
displayHelp = Box -> Text
renderBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. Help -> Box
displayHelpBox

-- | Default display for a Help Box
displayHelpBox :: Help -> Box
displayHelpBox :: Help -> Box
displayHelpBox = forall (a :: Symbol) b c. Display a b c -> b -> c
display (forall a (ins :: [*]) (out :: [*]).
Typeable a =>
Registry ins out -> a
make @(Display "any" Help Box) Registry
  '[Display "title" Help Box, Display "usage" Help Box,
    Display "options" Help Box, Display "commands" Help Box,
    Display "command-title" Help Box,
    Display "option-usage" OptionDescription Box,
    Display "command-options" [OptionDescription] Box, TableParameters,
    Display "command-summary" Help [Box],
    Display "command-detail" Help Box, TableParameters,
    Display "command-title" Help Box, Display "command-usage" Help Box,
    Display "option" OptionDescription [Box], ParagraphWidth,
    Display "option-usage" OptionDescription Box, TableParameters,
    Display "option" OptionDescription [Box], TableParameters,
    Display "option" OptionDescription [Box],
    Display "option-flag" OptionDescription Box,
    Display "option-help" OptionDescription Box,
    Display "metavar-usage" OptionDescription Box,
    Display "metavar" OptionDescription Box, ParagraphWidth]
  '[Display "any" Help Box, Display "title" Help Box,
    Display "usage" Help Box, Display "options" Help Box,
    Display "commands" Help Box, Display "command-summary" Help [Box],
    Display "command-detail" Help Box,
    Display "command-title" Help Box, Display "command-usage" Help Box,
    Display "command-options" [OptionDescription] Box,
    Display "option" OptionDescription Box,
    Display "option" OptionDescription [Box],
    Display "option-usage" OptionDescription Box,
    Display "option-flag" OptionDescription Box,
    Display "option-help" OptionDescription Box,
    Display "metavar-usage" OptionDescription Box,
    Display "metavar" OptionDescription Box, TableParameters,
    ParagraphWidth]
displayBoxRegistry)

-- | This registry provides overridable functions for displaying various parts of
--   a help text.
--
--   It can be overridden to display the help differently
displayBoxRegistry :: Registry _ _
displayBoxRegistry :: Registry
  '[Display "title" Help Box, Display "usage" Help Box,
    Display "options" Help Box, Display "commands" Help Box,
    Display "command-title" Help Box,
    Display "option-usage" OptionDescription Box,
    Display "command-options" [OptionDescription] Box, TableParameters,
    Display "command-summary" Help [Box],
    Display "command-detail" Help Box, TableParameters,
    Display "command-title" Help Box, Display "command-usage" Help Box,
    Display "option" OptionDescription [Box], ParagraphWidth,
    Display "option-usage" OptionDescription Box, TableParameters,
    Display "option" OptionDescription [Box], TableParameters,
    Display "option" OptionDescription [Box],
    Display "option-flag" OptionDescription Box,
    Display "option-help" OptionDescription Box,
    Display "metavar-usage" OptionDescription Box,
    Display "metavar" OptionDescription Box, ParagraphWidth]
  '[Display "any" Help Box, Display "title" Help Box,
    Display "usage" Help Box, Display "options" Help Box,
    Display "commands" Help Box, Display "command-summary" Help [Box],
    Display "command-detail" Help Box,
    Display "command-title" Help Box, Display "command-usage" Help Box,
    Display "command-options" [OptionDescription] Box,
    Display "option" OptionDescription Box,
    Display "option" OptionDescription [Box],
    Display "option-usage" OptionDescription Box,
    Display "option-flag" OptionDescription Box,
    Display "option-help" OptionDescription Box,
    Display "metavar-usage" OptionDescription Box,
    Display "metavar" OptionDescription Box, TableParameters,
    ParagraphWidth]
displayBoxRegistry =
  forall a. Typeable a => a -> Typed a
fun Display "title" Help Box
-> Display "usage" Help Box
-> Display "options" Help Box
-> Display "commands" Help Box
-> Display "any" Help Box
displayAllBox
    forall a b c. AddRegistryLike a b c => a -> b -> c
<: forall a. Typeable a => a -> Typed a
fun Display "command-title" Help Box -> Display "title" Help Box
displayHelpTitleBox
    forall a b c. AddRegistryLike a b c => a -> b -> c
<: forall a. Typeable a => a -> Typed a
fun Display "option-usage" OptionDescription Box
-> Display "usage" Help Box
displayUsageBox
    forall a b c. AddRegistryLike a b c => a -> b -> c
<: forall a. Typeable a => a -> Typed a
fun Display "command-options" [OptionDescription] Box
-> Display "options" Help Box
displayOptionsBox
    forall a b c. AddRegistryLike a b c => a -> b -> c
<: forall a. Typeable a => a -> Typed a
fun TableParameters
-> Display "command-summary" Help [Box]
-> Display "command-detail" Help Box
-> Display "commands" Help Box
displayCommandsBox
    forall a b c. AddRegistryLike a b c => a -> b -> c
<: forall a. Typeable a => a -> Typed a
fun Display "command-summary" Help [Box]
displayCommandSummaryBox
    forall a b c. AddRegistryLike a b c => a -> b -> c
<: forall a. Typeable a => a -> Typed a
fun TableParameters
-> Display "command-title" Help Box
-> Display "command-usage" Help Box
-> Display "option" OptionDescription [Box]
-> Display "command-detail" Help Box
displayCommandDetailBox
    forall a b c. AddRegistryLike a b c => a -> b -> c
<: forall a. Typeable a => a -> Typed a
fun ParagraphWidth -> Display "command-title" Help Box
displayCommandTitleBox
    forall a b c. AddRegistryLike a b c => a -> b -> c
<: forall a. Typeable a => a -> Typed a
fun Display "option-usage" OptionDescription Box
-> Display "command-usage" Help Box
displayCommandUsageBox
    forall a b c. AddRegistryLike a b c => a -> b -> c
<: forall a. Typeable a => a -> Typed a
fun TableParameters
-> Display "option" OptionDescription [Box]
-> Display "command-options" [OptionDescription] Box
displayCommandOptionsBox
    forall a b c. AddRegistryLike a b c => a -> b -> c
<: forall a. Typeable a => a -> Typed a
fun TableParameters
-> Display "option" OptionDescription [Box]
-> Display "option" OptionDescription Box
displayOptionBox
    forall a b c. AddRegistryLike a b c => a -> b -> c
<: forall a. Typeable a => a -> Typed a
fun Display "option-flag" OptionDescription Box
-> Display "option-help" OptionDescription Box
-> Display "option" OptionDescription [Box]
displayOptionBoxes
    forall a b c. AddRegistryLike a b c => a -> b -> c
<: forall a. Typeable a => a -> Typed a
fun Display "metavar-usage" OptionDescription Box
-> Display "option-usage" OptionDescription Box
displayOptionUsageBox
    forall a b c. AddRegistryLike a b c => a -> b -> c
<: forall a. Typeable a => a -> Typed a
fun Display "metavar" OptionDescription Box
-> Display "option-flag" OptionDescription Box
displayOptionFlagBox
    forall a b c. AddRegistryLike a b c => a -> b -> c
<: forall a. Typeable a => a -> Typed a
fun ParagraphWidth -> Display "option-help" OptionDescription Box
displayOptionHelpBox
    forall a b c. AddRegistryLike a b c => a -> b -> c
<: forall a. Typeable a => a -> Typed a
fun Display "metavar-usage" OptionDescription Box
displayMetavarUsageBox
    forall a b c. AddRegistryLike a b c => a -> b -> c
<: forall a. Typeable a => a -> Typed a
fun Display "metavar" OptionDescription Box
displayMetavarBox
    forall a b c. AddRegistryLike a b c => a -> b -> c
<: forall a. (Typeable a, Show a) => a -> Typed a
val (Alignment -> Alignment -> Int -> TableParameters
TableParameters Alignment
left Alignment
top Int
10)
    forall a b c. AddRegistryLike a b c => a -> b -> c
<: forall a. (Typeable a, Show a) => a -> Typed a
val (Int -> ParagraphWidth
ParagraphWidth Int
50)

-- | *Template*
--
--   Display "title" Help Box
--
--   Display "usage" Help Box
--
--   Display "commands" Help Box
--
--   *Example*
--
--   fs - a utility to copy and move files",
--
--   USAGE
--
--   fs [-h|--help] [-v|--version] [copy] [move]
--
--   OPTIONS
--
--     -h,--help BOOL             Display this help message
--     -v,--version BOOL          Display the version
--
--   COMMANDS
--
--     copy [OPTIONS]          copy a file from SOURCE to TARGET
--     move [OPTIONS]          move a file from SOURCE to TARGET
--
--   fs copy - copy a file from SOURCE to TARGET
--
--     fs copy [-h|--help] [-f|--force] [-r|--retries INT] [SOURCE] [TARGET]
--
--     -h,--help BOOL            Display this help message
--     -f,--force BOOL           Force the action even if a file already exists with the same name
--     -r,--retries INT          number of retries in case of an error
--     SOURCE                    Source path
--     TARGET                    Target path
--
--   fs move - move a file from SOURCE to TARGET
--
--    fs move [-h|--help] [-f|--force] [SOURCE] [TARGET]
--
--       -h,--help BOOL           Display this help message
--       -f,--force BOOL          Force the action even if a file already exists with the same name
--       SOURCE                   Source path
--       TARGET                   Target path
displayAllBox :: Display "title" Help Box -> Display "usage" Help Box -> Display "options" Help Box -> Display "commands" Help Box -> Display "any" Help Box
displayAllBox :: Display "title" Help Box
-> Display "usage" Help Box
-> Display "options" Help Box
-> Display "commands" Help Box
-> Display "any" Help Box
displayAllBox Display "title" Help Box
dt Display "usage" Help Box
du Display "options" Help Box
dos Display "commands" Help Box
dcs = forall (a :: Symbol) b c. (b -> c) -> Display a b c
Display forall a b. (a -> b) -> a -> b
$ \Help
help ->
  [Box] -> Box
vsepNonEmpty
    [ forall (a :: Symbol) b c. Display a b c -> b -> c
display Display "title" Help Box
dt Help
help,
      forall (a :: Symbol) b c. Display a b c -> b -> c
display Display "usage" Help Box
du Help
help,
      forall (a :: Symbol) b c. Display a b c -> b -> c
display Display "options" Help Box
dos Help
help,
      forall (a :: Symbol) b c. Display a b c -> b -> c
display Display "commands" Help Box
dcs Help
help
    ]

-- | Example
--
--   fs - a utility to copy and move files
--
--   We reused the display for a command title, which should work for either a top-level or a sub command
displayHelpTitleBox :: Display "command-title" Help Box -> Display "title" Help Box
displayHelpTitleBox :: Display "command-title" Help Box -> Display "title" Help Box
displayHelpTitleBox = coerce :: forall a b. Coercible a b => a -> b
coerce

-- | Example
--
--   USAGE
--
--   fs [-h|--help] [-v|--version] [copy] [move]
displayUsageBox :: Display "option-usage" OptionDescription Box -> Display "usage" Help Box
displayUsageBox :: Display "option-usage" OptionDescription Box
-> Display "usage" Help Box
displayUsageBox Display "option-usage" OptionDescription Box
dou = forall (a :: Symbol) b c. (b -> c) -> Display a b c
Display forall a b. (a -> b) -> a -> b
$ \(Help Maybe Text
n Maybe Text
_ Maybe Text
_ Maybe Text
_ [OptionDescription]
os [Help]
cs Bool
_) -> do
  let options :: [Box]
options = forall (a :: Symbol) b c. Display a b c -> b -> c
display Display "option-usage" OptionDescription Box
dou forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OptionDescription]
os
  let commands :: [Box]
commands = Maybe Text -> Box
mText forall b c a. (b -> c) -> (a -> b) -> a -> c
. Help -> Maybe Text
helpCommandName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Help]
cs
  forall (f :: * -> *).
Foldable f =>
Int -> Alignment -> f Box -> Box
vsep
    Int
1
    Alignment
top
    [ Box
"USAGE",
      Int -> Box -> Box
moveRight Int
2 forall a b. (a -> b) -> a -> b
$ [Box] -> Box
hsepNonEmpty (Maybe Text -> Box
mText Maybe Text
n forall a. a -> [a] -> [a]
: ([Box]
options forall a. Semigroup a => a -> a -> a
<> (Box -> Box
brackets forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Box]
commands)))
    ]

-- | Example
--
--   OPTIONS
--
--   -h,--help BOOL             Display this help message
--   -v,--version BOOL          Display the version
displayOptionsBox :: Display "command-options" [OptionDescription] Box -> Display "options" Help Box
displayOptionsBox :: Display "command-options" [OptionDescription] Box
-> Display "options" Help Box
displayOptionsBox Display "command-options" [OptionDescription] Box
dos = forall (a :: Symbol) b c. (b -> c) -> Display a b c
Display forall a b. (a -> b) -> a -> b
$ \Help
help -> do
  let os :: [OptionDescription]
os = Help -> [OptionDescription]
helpCommandFields Help
help
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OptionDescription]
os
    then Box
nullBox
    else
      [Box] -> Box
vsepNonEmpty
        [ Box
"OPTIONS",
          Box
nullBox,
          Int -> Box -> Box
moveRight Int
2 (forall (a :: Symbol) b c. Display a b c -> b -> c
display Display "command-options" [OptionDescription] Box
dos [OptionDescription]
os)
        ]

-- | Example
--
--   COMMANDS
--
--   copy [OPTIONS]          copy a file from SOURCE to TARGET
--   move [OPTIONS]          move a file from SOURCE to TARGET
--
--   fs copy - copy a file from SOURCE to TARGET
--
--     fs copy [-h|--help] [-f|--force] [-r|--retries INT] [SOURCE] [TARGET]
--
--     -h,--help BOOL            Display this help message
--     -f,--force BOOL           Force the action even if a file already exists with the same name
--     -r,--retries INT          number of retries in case of an error
--     SOURCE                    Source path
--     TARGET                    Target path
--
--   fs move - move a file from SOURCE to TARGET
--
--     fs move [-h|--help] [-f|--force] [SOURCE] [TARGET]
--
--     -h,--help BOOL           Display this help message
--     -f,--force BOOL          Force the action even if a file already exists with the same name
--     SOURCE                   Source path
--     TARGET                   Target path
displayCommandsBox :: TableParameters -> Display "command-summary" Help [Box] -> Display "command-detail" Help Box -> Display "commands" Help Box
displayCommandsBox :: TableParameters
-> Display "command-summary" Help [Box]
-> Display "command-detail" Help Box
-> Display "commands" Help Box
displayCommandsBox TableParameters
tps Display "command-summary" Help [Box]
commandsSummary Display "command-detail" Help Box
commandDetail = forall (a :: Symbol) b c. (b -> c) -> Display a b c
Display forall a b. (a -> b) -> a -> b
$ \Help
help -> do
  let cs :: [Help]
cs = Help -> [Help]
helpCommands Help
help
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Help]
cs
    then Box
nullBox
    else
      [Box] -> Box
vsepNonEmpty
        [ Box
"COMMANDS",
          Int -> Box -> Box
moveRight Int
2 forall a b. (a -> b) -> a -> b
$ TableParameters -> [[Box]] -> Box
table TableParameters
tps forall a b. (a -> b) -> a -> b
$ forall (a :: Symbol) b c. Display a b c -> b -> c
display Display "command-summary" Help [Box]
commandsSummary forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Help]
cs,
          [Box] -> Box
vsepNonEmpty forall a b. (a -> b) -> a -> b
$ forall (a :: Symbol) b c. Display a b c -> b -> c
display Display "command-detail" Help Box
commandDetail forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Help]
cs
        ]

-- | Example
--
--   copy [OPTIONS]          copy a file from SOURCE to TARGET"
displayCommandSummaryBox :: Display "command-summary" Help [Box]
displayCommandSummaryBox :: Display "command-summary" Help [Box]
displayCommandSummaryBox = forall (a :: Symbol) b c. (b -> c) -> Display a b c
Display forall a b. (a -> b) -> a -> b
$ \(Help Maybe Text
n Maybe Text
_ Maybe Text
s Maybe Text
_ [OptionDescription]
os [Help]
_ Bool
isDefault) -> do
  let withOptions :: Box
withOptions = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OptionDescription]
os then Box
nullBox else Box
"[OPTIONS]"
  let withDefault :: Box
withDefault = Text -> Box
tText forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
s forall a. Semigroup a => a -> a -> a
<> if Bool
isDefault then Text
" (default)" else Text
""
  [Maybe Text -> Box
mText Maybe Text
n Box -> Box -> Box
<+> Box
withOptions, Box
withDefault]

-- | Example
--
--   fs move - move a file from SOURCE to TARGET
--
--   fs move [-h|--help] [-f|--force] [SOURCE] [TARGET]
--
--     -h,--help BOOL           Display this help message
--     -f,--force BOOL          Force the action even if a file already exists with the same name
--     SOURCE                   Source path
--     TARGET                   Target path
displayCommandDetailBox :: TableParameters -> Display "command-title" Help Box -> Display "command-usage" Help Box -> Display "option" OptionDescription [Box] -> Display "command-detail" Help Box
displayCommandDetailBox :: TableParameters
-> Display "command-title" Help Box
-> Display "command-usage" Help Box
-> Display "option" OptionDescription [Box]
-> Display "command-detail" Help Box
displayCommandDetailBox TableParameters
tp Display "command-title" Help Box
dct Display "command-usage" Help Box
dcu Display "option" OptionDescription [Box]
dco = forall (a :: Symbol) b c. (b -> c) -> Display a b c
Display forall a b. (a -> b) -> a -> b
$ \Help
h ->
  [Box] -> Box
vsepNonEmpty forall a b. (a -> b) -> a -> b
$
    [ forall (a :: Symbol) b c. Display a b c -> b -> c
display Display "command-title" Help Box
dct Help
h,
      Int -> Box -> Box
moveRight Int
2 forall a b. (a -> b) -> a -> b
$ forall (a :: Symbol) b c. Display a b c -> b -> c
display Display "command-usage" Help Box
dcu Help
h
    ]
      forall a. Semigroup a => a -> a -> a
<> [Int -> Box -> Box
moveRight Int
2 forall a b. (a -> b) -> a -> b
$ TableParameters -> [[Box]] -> Box
table TableParameters
tp forall a b. (a -> b) -> a -> b
$ forall (a :: Symbol) b c. Display a b c -> b -> c
display Display "option" OptionDescription [Box]
dco forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Help -> [OptionDescription]
helpCommandFields Help
h]

-- | Example
--
--   fs move - move a file from SOURCE to TARGET
--
--    - the parent command name is appended to the command name if the parent is defined
--    - if the command is a default subcommand the name is parenthesized
displayCommandTitleBox :: ParagraphWidth -> Display "command-title" Help Box
displayCommandTitleBox :: ParagraphWidth -> Display "command-title" Help Box
displayCommandTitleBox ParagraphWidth
w = forall (a :: Symbol) b c. (b -> c) -> Display a b c
Display forall a b. (a -> b) -> a -> b
$ \(Help Maybe Text
n Maybe Text
p Maybe Text
s Maybe Text
l [OptionDescription]
_ [Help]
_ Bool
isDefault) -> do
  [Box] -> Box
vsepNonEmpty
    [ [Box] -> Box
hsepNonEmpty forall a b. (a -> b) -> a -> b
$
        forall a. [Maybe a] -> [a]
catMaybes
          [ Text -> Box
tText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
p,
            (if Bool
isDefault then Box -> Box
parens else forall a. a -> a
identity) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Box
tText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
n,
            Text -> Box
tText forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"- " <>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
s
          ],
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe Box
nullBox (Int -> Box -> Box
moveRight Int
2) forall a b. (a -> b) -> a -> b
$ ParagraphWidth -> Text -> Box
paragraph ParagraphWidth
w forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
l
    ]

-- | Example
--
--   fs move [-h|--help] [-f|--force] [SOURCE] [TARGET]
displayCommandUsageBox :: Display "option-usage" OptionDescription Box -> Display "command-usage" Help Box
displayCommandUsageBox :: Display "option-usage" OptionDescription Box
-> Display "command-usage" Help Box
displayCommandUsageBox Display "option-usage" OptionDescription Box
dou = forall (a :: Symbol) b c. (b -> c) -> Display a b c
Display forall a b. (a -> b) -> a -> b
$ \(Help Maybe Text
n Maybe Text
p Maybe Text
_ Maybe Text
_ [OptionDescription]
os [Help]
_ Bool
isDefault) ->
  [Box] -> Box
hsepNonEmpty forall a b. (a -> b) -> a -> b
$
    forall a. [Maybe a] -> [a]
catMaybes
      [ Text -> Box
tText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
p,
        (if Bool
isDefault then Box -> Box
parens else forall a. a -> a
identity) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Box
tText forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
n
      ]
      forall a. Semigroup a => a -> a -> a
<> (forall (a :: Symbol) b c. Display a b c -> b -> c
display Display "option-usage" OptionDescription Box
dou forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OptionDescription]
os)

-- | Example
--
--   -h,--help BOOL           Display this help message
--   -f,--force BOOL          Force the action even if a file already exists with the same name
displayCommandOptionsBox :: TableParameters -> Display "option" OptionDescription [Box] -> Display "command-options" [OptionDescription] Box
displayCommandOptionsBox :: TableParameters
-> Display "option" OptionDescription [Box]
-> Display "command-options" [OptionDescription] Box
displayCommandOptionsBox TableParameters
t Display "option" OptionDescription [Box]
d = forall (a :: Symbol) b c. (b -> c) -> Display a b c
Display forall a b. (a -> b) -> a -> b
$ \[OptionDescription]
os -> TableParameters -> [[Box]] -> Box
table TableParameters
t (forall (a :: Symbol) b c. Display a b c -> b -> c
display Display "option" OptionDescription [Box]
d forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OptionDescription]
os)

-- | Example
--
--   -h,--help BOOL           Display this help message
displayOptionBox :: TableParameters -> Display "option" OptionDescription [Box] -> Display "option" OptionDescription Box
displayOptionBox :: TableParameters
-> Display "option" OptionDescription [Box]
-> Display "option" OptionDescription Box
displayOptionBox TableParameters
t Display "option" OptionDescription [Box]
dos = forall (a :: Symbol) b c. (b -> c) -> Display a b c
Display forall a b. (a -> b) -> a -> b
$ \OptionDescription
o -> TableParameters -> [[Box]] -> Box
table TableParameters
t [forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Box -> Bool
isEmpty) (forall (a :: Symbol) b c. Display a b c -> b -> c
display Display "option" OptionDescription [Box]
dos OptionDescription
o)]

-- | Example
--
--   -h,--help BOOL           Display this help message
displayOptionBoxes :: Display "option-flag" OptionDescription Box -> Display "option-help" OptionDescription Box -> Display "option" OptionDescription [Box]
displayOptionBoxes :: Display "option-flag" OptionDescription Box
-> Display "option-help" OptionDescription Box
-> Display "option" OptionDescription [Box]
displayOptionBoxes Display "option-flag" OptionDescription Box
df Display "option-help" OptionDescription Box
dh = forall (a :: Symbol) b c. (b -> c) -> Display a b c
Display forall a b. (a -> b) -> a -> b
$ \OptionDescription
o -> [forall (a :: Symbol) b c. Display a b c -> b -> c
display Display "option-flag" OptionDescription Box
df OptionDescription
o, forall (a :: Symbol) b c. Display a b c -> b -> c
display Display "option-help" OptionDescription Box
dh OptionDescription
o]

-- | Example
--
--   [-h|--help]
--   [-f|--file FILE]
displayOptionUsageBox :: Display "metavar-usage" OptionDescription Box -> Display "option-usage" OptionDescription Box
displayOptionUsageBox :: Display "metavar-usage" OptionDescription Box
-> Display "option-usage" OptionDescription Box
displayOptionUsageBox Display "metavar-usage" OptionDescription Box
dmu = forall (a :: Symbol) b c. (b -> c) -> Display a b c
Display forall a b. (a -> b) -> a -> b
$ \case
  o :: OptionDescription
o@(OptionDescription (Just Text
n) [Text]
_ (Just Char
s) Maybe Text
_ Maybe Text
_) ->
    Box -> Box
brackets forall a b. (a -> b) -> a -> b
$ [Box] -> Box
hsepNonEmpty [[Box] -> Box
piped [Text -> Box
tText forall a b. (a -> b) -> a -> b
$ Text
"-" forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
s, Text -> Box
tText forall a b. (a -> b) -> a -> b
$ Text
"--" forall a. Semigroup a => a -> a -> a
<> Text
n], forall (a :: Symbol) b c. Display a b c -> b -> c
display Display "metavar-usage" OptionDescription Box
dmu OptionDescription
o]
  o :: OptionDescription
o@(OptionDescription Maybe Text
_ [Text]
_ (Just Char
s) Maybe Text
_ Maybe Text
_) ->
    Box -> Box
brackets forall a b. (a -> b) -> a -> b
$ [Box] -> Box
hsepNonEmpty [Text -> Box
tText forall a b. (a -> b) -> a -> b
$ Text
"-" forall a. Semigroup a => a -> a -> a
<> Char -> Text
T.singleton Char
s, forall (a :: Symbol) b c. Display a b c -> b -> c
display Display "metavar-usage" OptionDescription Box
dmu OptionDescription
o]
  o :: OptionDescription
o@(OptionDescription (Just Text
n) [Text]
_ Maybe Char
_ Maybe Text
_ Maybe Text
_) ->
    Box -> Box
brackets forall a b. (a -> b) -> a -> b
$ [Box] -> Box
hsepNonEmpty [Text -> Box
tText forall a b. (a -> b) -> a -> b
$ Text
"--" forall a. Semigroup a => a -> a -> a
<> Text
n, forall (a :: Symbol) b c. Display a b c -> b -> c
display Display "metavar-usage" OptionDescription Box
dmu OptionDescription
o]
  o :: OptionDescription
o@(OptionDescription Maybe Text
_ [Text]
_ Maybe Char
_ (Just Text
_) Maybe Text
_) ->
    Box -> Box
brackets forall a b. (a -> b) -> a -> b
$ forall (a :: Symbol) b c. Display a b c -> b -> c
display Display "metavar-usage" OptionDescription Box
dmu OptionDescription
o
  OptionDescription
_ -> Box
nullBox

-- | Example
--
--   -h,--help BOOL
displayOptionFlagBox :: Display "metavar" OptionDescription Box -> Display "option-flag" OptionDescription Box
displayOptionFlagBox :: Display "metavar" OptionDescription Box
-> Display "option-flag" OptionDescription Box
displayOptionFlagBox Display "metavar" OptionDescription Box
dm = forall (a :: Symbol) b c. (b -> c) -> Display a b c
Display forall a b. (a -> b) -> a -> b
$ \o :: OptionDescription
o@(OptionDescription Maybe Text
n [Text]
as Maybe Char
s Maybe Text
_ Maybe Text
_) ->
  [Box] -> Box
hsepNonEmpty
    [ [Box] -> Box
commaed
        ( [ -- short flag
            Maybe Text -> Box
mText forall a b. (a -> b) -> a -> b
$ (Text
"-" <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Char
s,
            -- long flag
            Maybe Text -> Box
mText forall a b. (a -> b) -> a -> b
$ (Text
"--" <>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
n
          ]
            -- aliases
            forall a. Semigroup a => a -> a -> a
<> (String -> Box
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"--" <>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertText a b => a -> b
toS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
as)
        ),
      forall (a :: Symbol) b c. Display a b c -> b -> c
display Display "metavar" OptionDescription Box
dm OptionDescription
o
    ]

-- | Example
--
--   Display this help message
displayOptionHelpBox :: ParagraphWidth -> Display "option-help" OptionDescription Box
displayOptionHelpBox :: ParagraphWidth -> Display "option-help" OptionDescription Box
displayOptionHelpBox ParagraphWidth
w = forall (a :: Symbol) b c. (b -> c) -> Display a b c
Display (ParagraphWidth -> Maybe Text -> Box
mParagraph ParagraphWidth
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptionDescription -> Maybe Text
_help)

-- | Display a metavar, except for a switch because it is obvious that it is a boolean
--   or for a String flag
--
--   Example
--
--   FILE
displayMetavarUsageBox :: Display "metavar-usage" OptionDescription Box
displayMetavarUsageBox :: Display "metavar-usage" OptionDescription Box
displayMetavarUsageBox = forall (a :: Symbol) b c. (b -> c) -> Display a b c
Display forall a b. (a -> b) -> a -> b
$ \(OptionDescription Maybe Text
_ [Text]
_ Maybe Char
_ Maybe Text
m Maybe Text
_) ->
  case Maybe Text
m of
    Maybe Text
Nothing -> Box
""
    (Just Text
"BOOL") -> Box
""
    (Just Text
"[CHAR]") -> Box
""
    Just Text
s -> Text -> Box
tText forall a b. (a -> b) -> a -> b
$ Text
s

-- | Display a metavar in a full help text
--
--   [Char] is transformed to String
displayMetavarBox :: Display "metavar" OptionDescription Box
displayMetavarBox :: Display "metavar" OptionDescription Box
displayMetavarBox = forall (a :: Symbol) b c. (b -> c) -> Display a b c
Display forall a b. (a -> b) -> a -> b
$ \(OptionDescription Maybe Text
_ [Text]
_ Maybe Char
_ Maybe Text
m Maybe Text
_) ->
  case Maybe Text
m of
    Maybe Text
Nothing -> Box
""
    Just Text
"[CHAR]" -> Box
"STRING"
    Just Text
s -> Text -> Box
tText forall a b. (a -> b) -> a -> b
$ Text
s

-- | Return True if a Box is Empty
--   The best we can do is to render the box and compare it to the empty text
isEmpty :: Box -> Bool
isEmpty :: Box -> Bool
isEmpty Box
b = Box -> Text
renderBox Box
b forall a. Eq a => a -> a -> Bool
== Text
""

-- | Separate a list of Boxes with a separator
separate :: Box -> [Box] -> Box
separate :: Box -> [Box] -> Box
separate Box
_ [] = Box
nullBox
separate Box
s [Box]
ds = forall (f :: * -> *).
Foldable f =>
Alignment -> Box -> f Box -> Box
punctuateH Alignment
left Box
s (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Box -> Bool
isEmpty) [Box]
ds)

-- | Separate a list of boxes with a pipe
piped :: [Box] -> Box
piped :: [Box] -> Box
piped = Box -> [Box] -> Box
separate forall a b. (a -> b) -> a -> b
$ Char -> Box
char Char
'|'

-- | Separate a list of boxes with a comma
commaed :: [Box] -> Box
commaed :: [Box] -> Box
commaed = Box -> [Box] -> Box
separate forall a b. (a -> b) -> a -> b
$ Char -> Box
char Char
','

-- | Add brackets to a Box
brackets :: Box -> Box
brackets :: Box -> Box
brackets Box
b = Char -> Box
char Char
'[' Box -> Box -> Box
<:> Box
b Box -> Box -> Box
<:> Char -> Box
char Char
']'

-- | Add parens to a Box
parens :: Box -> Box
parens :: Box -> Box
parens Box
b = Char -> Box
char Char
'(' Box -> Box -> Box
<:> Box
b Box -> Box -> Box
<:> Char -> Box
char Char
')'

-- | Remove empty docs and use hsep
hsepNonEmpty :: [Box] -> Box
hsepNonEmpty :: [Box] -> Box
hsepNonEmpty = forall (f :: * -> *).
Foldable f =>
Int -> Alignment -> f Box -> Box
hsep Int
1 Alignment
left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Box -> Bool
isEmpty)

-- | Remove empty docs and use hcat
hcatNonEmpty :: [Box] -> Box
hcatNonEmpty :: [Box] -> Box
hcatNonEmpty = forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
hcat Alignment
left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Box -> Bool
isEmpty)

-- | Remove empty docs and use vsep
vsepNonEmpty :: [Box] -> Box
vsepNonEmpty :: [Box] -> Box
vsepNonEmpty = forall (f :: * -> *).
Foldable f =>
Int -> Alignment -> f Box -> Box
vsep Int
1 Alignment
top forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Box -> Bool
isEmpty)

-- | Remove empty docs and use vcat
vcatNonEmpty :: [Box] -> Box
vcatNonEmpty :: [Box] -> Box
vcatNonEmpty = forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
vcat Alignment
top forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Box -> Bool
isEmpty)

-- | Create a box for non empty text
mText :: Maybe Text -> Box
mText :: Maybe Text -> Box
mText Maybe Text
Nothing = Box
nullBox
mText (Just Text
t) = String -> Box
text (forall a b. ConvertText a b => a -> b
toS Text
t)

-- | Create a box for a Text value instead of a String
tText :: Text -> Box
tText :: Text -> Box
tText = String -> Box
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertText a b => a -> b
toS

-- | Non-clashing append operator for boxes
(<:>) :: Box -> Box -> Box
Box
l <:> :: Box -> Box -> Box
<:> Box
r = forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
hcat Alignment
left [Box
l, Box
r]

-- | Render a Box as Text
--   The render function for boxes adds one last newline which we want to avoid
renderBox :: Box -> Text
renderBox :: Box -> Text
renderBox = Text -> [Text] -> Text
T.intercalate Text
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertText a b => a -> b
toS forall b c a. (b -> c) -> (a -> b) -> a -> c
. Box -> String
render

-- | Display a table given a list of rows containing boxes
table :: TableParameters -> [[Box]] -> Box
table :: TableParameters -> [[Box]] -> Box
table TableParameters
_ [] = Box
nullBox
table (TableParameters Alignment
h Alignment
v Int
i) [[Box]]
rs = do
  -- compute the max height of a row
  let maxCellRows :: t Box -> Int
maxCellRows t Box
cells = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Box -> Int
rows forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t Box
cells)

  -- adjust all the rows so that they have the same height
  let rs' :: [[Box]]
rs' = (\[Box]
row -> let m :: Int
m = forall {t :: * -> *}. (Foldable t, Functor t) => t Box -> Int
maxCellRows [Box]
row in Alignment -> Int -> Box -> Box
alignVert Alignment
v Int
m forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Box]
row) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Box]]
rs

  -- transpose the rows to get the columns
  -- display them vertically then concatenate the columns horizontally
  forall (f :: * -> *).
Foldable f =>
Int -> Alignment -> f Box -> Box
hsep Int
i Alignment
h forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
vcat Alignment
v forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [[a]] -> [[a]]
transpose [[Box]]
rs'

-- | Create a paragraph for some Text, wrapping the text at paragraph width
paragraph :: ParagraphWidth -> Text -> Box
paragraph :: ParagraphWidth -> Text -> Box
paragraph (ParagraphWidth Int
w) = Alignment -> Int -> String -> Box
para Alignment
left Int
w forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertText a b => a -> b
toS

-- | Create a paragraph for an option piece of text
mParagraph :: ParagraphWidth -> Maybe Text -> Box
mParagraph :: ParagraphWidth -> Maybe Text -> Box
mParagraph ParagraphWidth
_ Maybe Text
Nothing = Box
nullBox
mParagraph ParagraphWidth
w (Just Text
t) = ParagraphWidth -> Text -> Box
paragraph ParagraphWidth
w Text
t

-- | Width of paragraph, used in conjunction with the 'paragraph' function
newtype ParagraphWidth = ParagraphWidth Int deriving (ParagraphWidth -> ParagraphWidth -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParagraphWidth -> ParagraphWidth -> Bool
$c/= :: ParagraphWidth -> ParagraphWidth -> Bool
== :: ParagraphWidth -> ParagraphWidth -> Bool
$c== :: ParagraphWidth -> ParagraphWidth -> Bool
Eq, Int -> ParagraphWidth -> String -> String
[ParagraphWidth] -> String -> String
ParagraphWidth -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ParagraphWidth] -> String -> String
$cshowList :: [ParagraphWidth] -> String -> String
show :: ParagraphWidth -> String
$cshow :: ParagraphWidth -> String
showsPrec :: Int -> ParagraphWidth -> String -> String
$cshowsPrec :: Int -> ParagraphWidth -> String -> String
Show, Integer -> ParagraphWidth
ParagraphWidth -> ParagraphWidth
ParagraphWidth -> ParagraphWidth -> ParagraphWidth
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ParagraphWidth
$cfromInteger :: Integer -> ParagraphWidth
signum :: ParagraphWidth -> ParagraphWidth
$csignum :: ParagraphWidth -> ParagraphWidth
abs :: ParagraphWidth -> ParagraphWidth
$cabs :: ParagraphWidth -> ParagraphWidth
negate :: ParagraphWidth -> ParagraphWidth
$cnegate :: ParagraphWidth -> ParagraphWidth
* :: ParagraphWidth -> ParagraphWidth -> ParagraphWidth
$c* :: ParagraphWidth -> ParagraphWidth -> ParagraphWidth
- :: ParagraphWidth -> ParagraphWidth -> ParagraphWidth
$c- :: ParagraphWidth -> ParagraphWidth -> ParagraphWidth
+ :: ParagraphWidth -> ParagraphWidth -> ParagraphWidth
$c+ :: ParagraphWidth -> ParagraphWidth -> ParagraphWidth
Num)

-- | Those parameters are used when creating a table with the
--   'table' function
data TableParameters = TableParameters
  { TableParameters -> Alignment
horizontalAlignment :: Alignment,
    TableParameters -> Alignment
verticalAlignment :: Alignment,
    TableParameters -> Int
intercolumn :: Int
  }
  deriving (TableParameters -> TableParameters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableParameters -> TableParameters -> Bool
$c/= :: TableParameters -> TableParameters -> Bool
== :: TableParameters -> TableParameters -> Bool
$c== :: TableParameters -> TableParameters -> Bool
Eq, Int -> TableParameters -> String -> String
[TableParameters] -> String -> String
TableParameters -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TableParameters] -> String -> String
$cshowList :: [TableParameters] -> String -> String
show :: TableParameters -> String
$cshow :: TableParameters -> String
showsPrec :: Int -> TableParameters -> String -> String
$cshowsPrec :: Int -> TableParameters -> String -> String
Show)