{-|
Module      : Options.OptStream.Help
Copyright   : (c) Dan Shved, 2022
License     : BSD-3
Maintainer  : danshved@gmail.com
Stability   : experimental

This module contains lower-level functions for working with 'Help' objects. You
may need to import this if you work with 'Help' objects directly, as opposed to
relying on them being handled automatically by 'Options.OptStream.Parser'.
-}
module Options.OptStream.Help
  ( -- * Help objects
    Help
  , formatHelp
  , makeHeader
  , makeFooter
  , makeFlagHelp
  , makeParamHelp
  , makeMultiParamHelp
  , makeFreeArgHelp

    -- * Modifiers
  , clearHelpHeader
  , clearHelpFooter
  , clearHelpTable
  , sortHelpTable
  )
where

import Data.Foldable
import Data.Function
import Data.List
import Data.Maybe

import Options.OptStream.Internal
import qualified Options.OptStream.Internal as I

-- One row in the --help table.
data OptionHelp
  = FlagHelp
    { OptionHelp -> Maybe Char
ohShort        :: Maybe Char
    , OptionHelp -> Maybe String
ohLong         :: Maybe String
    , OptionHelp -> String
ohDescription  :: String
    }
  | ParamHelp
    { ohShort        :: Maybe Char
    , ohLong         :: Maybe String
    , OptionHelp -> String
ohMetavar      :: String
    , ohDescription  :: String
    }
  | MultiParamHelp
    { ohShort        :: Maybe Char
    , ohLong         :: Maybe String
    , OptionHelp -> String
ohFollowerHelp :: String
    , ohDescription  :: String
    }
  | FreeArgHelp
    { ohMetavar      :: String
    , ohDescription  :: String
    }
  deriving (OptionHelp -> OptionHelp -> Bool
(OptionHelp -> OptionHelp -> Bool)
-> (OptionHelp -> OptionHelp -> Bool) -> Eq OptionHelp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OptionHelp -> OptionHelp -> Bool
$c/= :: OptionHelp -> OptionHelp -> Bool
== :: OptionHelp -> OptionHelp -> Bool
$c== :: OptionHelp -> OptionHelp -> Bool
Eq, Int -> OptionHelp -> ShowS
[OptionHelp] -> ShowS
OptionHelp -> String
(Int -> OptionHelp -> ShowS)
-> (OptionHelp -> String)
-> ([OptionHelp] -> ShowS)
-> Show OptionHelp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OptionHelp] -> ShowS
$cshowList :: [OptionHelp] -> ShowS
show :: OptionHelp -> String
$cshow :: OptionHelp -> String
showsPrec :: Int -> OptionHelp -> ShowS
$cshowsPrec :: Int -> OptionHelp -> ShowS
Show)


-- | Represents help information that could be printed when the user passes
-- @--help@ on the command line.
--
-- A 'Help' object contains three parts, each of which could be empty: a
-- header, an options table, and a footer. 'Help' objects can be composed
-- together using '<>'. That will separately concatenate headers, option
-- tables, and footers.
data Help = Help
  { Help -> List OptionHelp
helpTable :: List OptionHelp
  , Help -> List String
helpHeader  :: List String
  , Help -> List String
helpFooter  :: List String
  }
  deriving (Help -> Help -> Bool
(Help -> Help -> Bool) -> (Help -> Help -> Bool) -> Eq Help
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Help -> Help -> Bool
$c/= :: Help -> Help -> Bool
== :: Help -> Help -> Bool
$c== :: Help -> Help -> Bool
Eq, Int -> Help -> ShowS
[Help] -> ShowS
Help -> String
(Int -> Help -> ShowS)
-> (Help -> String) -> ([Help] -> ShowS) -> Show Help
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Help] -> ShowS
$cshowList :: [Help] -> ShowS
show :: Help -> String
$cshow :: Help -> String
showsPrec :: Int -> Help -> ShowS
$cshowsPrec :: Int -> Help -> ShowS
Show)

instance Semigroup Help where
  Help List OptionHelp
x List String
y List String
z <> :: Help -> Help -> Help
<> Help List OptionHelp
x' List String
y' List String
z' = List OptionHelp -> List String -> List String -> Help
Help (List OptionHelp
x List OptionHelp -> List OptionHelp -> List OptionHelp
forall a. Semigroup a => a -> a -> a
<> List OptionHelp
x') (List String
y List String -> List String -> List String
forall a. Semigroup a => a -> a -> a
<> List String
y') (List String
z List String -> List String -> List String
forall a. Semigroup a => a -> a -> a
<> List String
z')

instance Monoid Help where
  mempty :: Help
mempty = List OptionHelp -> List String -> List String -> Help
Help List OptionHelp
forall a. Monoid a => a
mempty List String
forall a. Monoid a => a
mempty List String
forall a. Monoid a => a
mempty

-- | Makes a 'Help' object that contains one paragraph in the header.
makeHeader :: String -> Help
makeHeader :: String -> Help
makeHeader String
s = List OptionHelp -> List String -> List String -> Help
Help List OptionHelp
forall a. Monoid a => a
mempty (String -> List String
forall a. a -> List a
single String
s) List String
forall a. Monoid a => a
mempty

-- | Makes a 'Help' object that contains one paragraph in the footer.
makeFooter :: String -> Help
makeFooter :: String -> Help
makeFooter String
s = List OptionHelp -> List String -> List String -> Help
Help List OptionHelp
forall a. Monoid a => a
mempty List String
forall a. Monoid a => a
mempty (String -> List String
forall a. a -> List a
single String
s)

getShortAndLong :: [OptionForm] -> (Maybe Char, Maybe String)
getShortAndLong :: [String] -> (Maybe Char, Maybe String)
getShortAndLong [String]
opts = (String -> Maybe Char
forall a. [a] -> Maybe a
listToMaybe String
shorts, [String] -> Maybe String
forall a. [a] -> Maybe a
listToMaybe [String]
longs) where
  (String
shorts, [String]
longs) = (Option -> (String, [String]) -> (String, [String]))
-> (String, [String]) -> [Option] -> (String, [String])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Option -> (String, [String]) -> (String, [String])
update ([], []) ([Option] -> (String, [String])) -> [Option] -> (String, [String])
forall a b. (a -> b) -> a -> b
$ (String -> Option) -> [String] -> [Option]
forall a b. (a -> b) -> [a] -> [b]
map String -> Option
parseOptionForm [String]
opts
  update :: Option -> (String, [String]) -> (String, [String])
update (Short Char
c) (String
cs, [String]
ss) = (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs, [String]
ss)
  update (Long String
s) (String
cs, [String]
ss) = (String
cs, String
sString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
ss)

-- | Makes a 'Help' object that contains one row in the options table. This
-- function is suitable to add 'Help' to a flag, i.e. an option that doesn't
-- take any additional arguments.
--
-- You may pass any number of option forms. However, only the first one of each
-- kind (short and long) will be used.
--
-- >>> formatHelp $ makeFlagHelp ["-f", "--foo"] "Description."
-- "  -f, --foo  Description."
makeFlagHelp :: [OptionForm]
                -- ^ All the flag forms, e.g. @["-f", "--foo"]@.
             -> String
                -- ^ Description.
             -> Help
makeFlagHelp :: [String] -> String -> Help
makeFlagHelp [String]
opts String
desc = List OptionHelp -> List String -> List String -> Help
Help (OptionHelp -> List OptionHelp
forall a. a -> List a
single OptionHelp
oh) List String
forall a. Monoid a => a
mempty List String
forall a. Monoid a => a
mempty where
  oh :: OptionHelp
oh = (Maybe Char -> Maybe String -> String -> OptionHelp)
-> (Maybe Char, Maybe String) -> String -> OptionHelp
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe Char -> Maybe String -> String -> OptionHelp
FlagHelp ([String] -> (Maybe Char, Maybe String)
getShortAndLong [String]
opts) String
desc

-- | Makes a 'Help' object that contains one row in the options table. This
-- function is suitable to add 'Help' to a parameter, i.e. an option that takes
-- one additional argument.
--
-- You may pass any number of option forms. However, only the first one of each
-- kind (short and long) will be used.
--
-- >>> formatHelp $ makeParamHelp ["-i", "--input"] "FILE" "Input file."
-- "  -i, --input=FILE  Input file."
makeParamHelp :: [OptionForm]
                 -- ^ All parameter forms, e.g. @["-i", "--input"]@.
              -> String
                 -- ^ Metavariable describing the additional argument, e.g.
                 -- @\"FILE\"@.
              -> String
                 -- ^ Description.
              -> Help
makeParamHelp :: [String] -> String -> String -> Help
makeParamHelp [String]
opts String
metavar String
desc = List OptionHelp -> List String -> List String -> Help
Help (OptionHelp -> List OptionHelp
forall a. a -> List a
single OptionHelp
oh) List String
forall a. Monoid a => a
mempty List String
forall a. Monoid a => a
mempty where
  oh :: OptionHelp
oh = (Maybe Char -> Maybe String -> String -> String -> OptionHelp)
-> (Maybe Char, Maybe String) -> String -> String -> OptionHelp
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe Char -> Maybe String -> String -> String -> OptionHelp
ParamHelp ([String] -> (Maybe Char, Maybe String)
getShortAndLong [String]
opts) String
metavar String
desc

-- | Makes a 'Help' object that contains one row in the options table. This
-- function is suitable to add 'Help' to a multi-parameter, i.e. an option that
-- takes an arbitrary number of additional arguments.
--
-- In practice this behaves almost the same as 'makeParamHelp', except it
-- advertises a slightly different syntax for passing additional arguments: as
-- proper additional arguments, without @'='@.
--
-- You may pass any number of option forms. However, only the first one of each
-- kind (short and long) will be used.
--
-- >>> formatHelp $ makeMultiParamHelp ["-n", "--full-name"] "FIRST LAST" "First and last name."
-- "  -n, --full-name FIRST LAST  First and last name."
makeMultiParamHelp :: [OptionForm]
                      -- ^ All multiparameter forms, e.g. @["-n",
                      -- "--full-name"]@.
                   -> String
                      -- ^ Free-form description for the additional arguments,
                      -- e.g. @"FIRST LAST"@.
                   -> String
                      -- ^ Description.
                   -> Help
makeMultiParamHelp :: [String] -> String -> String -> Help
makeMultiParamHelp [String]
opts String
fh String
desc = List OptionHelp -> List String -> List String -> Help
Help (OptionHelp -> List OptionHelp
forall a. a -> List a
single OptionHelp
oh) List String
forall a. Monoid a => a
mempty List String
forall a. Monoid a => a
mempty where
  oh :: OptionHelp
oh = (Maybe Char -> Maybe String -> String -> String -> OptionHelp)
-> (Maybe Char, Maybe String) -> String -> String -> OptionHelp
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe Char -> Maybe String -> String -> String -> OptionHelp
MultiParamHelp ([String] -> (Maybe Char, Maybe String)
getShortAndLong [String]
opts) String
fh String
desc

-- | Makes a 'Help' object that contains one row in the options table. This
-- function is suitable to add 'Help' to a free argument.
--
-- >>> formatHelp $ makeFreeArgHelp "FILE" "Input file."
-- "  FILE  Input file."
makeFreeArgHelp :: String
                   -- ^ Metavariable, e.g. @\"FILE\"@.
                -> String
                   -- ^ Description.
                -> Help
makeFreeArgHelp :: String -> String -> Help
makeFreeArgHelp String
metavar String
desc = List OptionHelp -> List String -> List String -> Help
Help (OptionHelp -> List OptionHelp
forall a. a -> List a
single OptionHelp
oh) List String
forall a. Monoid a => a
mempty List String
forall a. Monoid a => a
mempty where
  oh :: OptionHelp
oh = String -> String -> OptionHelp
FreeArgHelp String
metavar String
desc

-- | Clears the header of a 'Help' object. Doesn't affect the options table and
-- the footer.
clearHelpHeader :: Help -> Help
clearHelpHeader :: Help -> Help
clearHelpHeader Help
h = Help
h { helpHeader :: List String
helpHeader = List String
forall a. Monoid a => a
mempty }

-- | Clears the footer of a 'Help' object. Doesn't affect the header and the
-- options table.
clearHelpFooter :: Help -> Help
clearHelpFooter :: Help -> Help
clearHelpFooter Help
h = Help
h { helpFooter :: List String
helpFooter = List String
forall a. Monoid a => a
mempty }

-- | Clears the options table of a 'Help' object. Doesn't affect the header and
-- the footer.
clearHelpTable :: Help -> Help
clearHelpTable :: Help -> Help
clearHelpTable Help
h = Help
h { helpTable :: List OptionHelp
helpTable = List OptionHelp
forall a. Monoid a => a
mempty }


-- * Sorting

-- Favor rows with data when sorting.
compareStr :: String -> String -> Ordering
compareStr :: String -> String -> Ordering
compareStr (Char
_:String
_) [] = Ordering
LT
compareStr [] (Char
_:String
_) = Ordering
GT
compareStr String
x String
y = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
x String
y

instance Ord Row where
  compare :: Row -> Row -> Ordering
compare (FreeArgRow String
_ String
_) (OptionRow String
_ String
_ String
_) = Ordering
LT
  compare (OptionRow String
_ String
_ String
_) (FreeArgRow String
_ String
_) = Ordering
GT
  compare (FreeArgRow String
x String
y) (FreeArgRow String
x' String
y') =
    String -> String -> Ordering
compareStr String
x String
x' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> String -> String -> Ordering
compareStr String
y String
y'
  compare (OptionRow String
x String
y String
z) (OptionRow String
x' String
y' String
z') =
    String -> String -> Ordering
compareStr String
x String
x' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> String -> String -> Ordering
compareStr String
y String
y' Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> String -> String -> Ordering
compareStr String
z String
z'

instance Ord OptionHelp where
  compare :: OptionHelp -> OptionHelp -> Ordering
compare = Row -> Row -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Row -> Row -> Ordering)
-> (OptionHelp -> Row) -> OptionHelp -> OptionHelp -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` OptionHelp -> Row
toRow

-- | Sorts the options table so that:
--
--   * Free argument options go first, proper options go second.
--
--   * Free arguments are sorted lexicographically by metavariable, then by
--   description.
--
--   * Options are sorted lexicographically by short form, then by long form,
--   then by description.
sortHelpTable :: Help -> Help
sortHelpTable :: Help -> Help
sortHelpTable Help
h =
  Help
h {helpTable :: List OptionHelp
helpTable = [OptionHelp] -> List OptionHelp
forall a. [a] -> List a
I.fromList ([OptionHelp] -> List OptionHelp)
-> (List OptionHelp -> [OptionHelp])
-> List OptionHelp
-> List OptionHelp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OptionHelp -> Row) -> [OptionHelp] -> [OptionHelp]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn OptionHelp -> Row
toRow ([OptionHelp] -> [OptionHelp])
-> (List OptionHelp -> [OptionHelp])
-> List OptionHelp
-> [OptionHelp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List OptionHelp -> [OptionHelp]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (List OptionHelp -> List OptionHelp)
-> List OptionHelp -> List OptionHelp
forall a b. (a -> b) -> a -> b
$ Help -> List OptionHelp
helpTable Help
h}


-- * Formatting

pad :: Int -> String -> String
pad :: Int -> ShowS
pad Int
n String
s
  | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) Char
' '
  | Bool
otherwise = String
s
  where l :: Int
l = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s

formatShort :: Maybe Char -> String
formatShort :: Maybe Char -> String
formatShort (Just Char
c) = [Char
'-', Char
c]
formatShort Maybe Char
Nothing = []

formatLong :: Maybe String -> String
formatLong :: Maybe String -> String
formatLong (Just String
s) = String
"--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
formatLong Maybe String
Nothing = String
""

formatShortParam :: Char -> String -> String
formatShortParam :: Char -> ShowS
formatShortParam Char
c String
v = [Char
'-', Char
c, Char
' '] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
v

formatLongParam :: String -> String -> String
formatLongParam :: String -> ShowS
formatLongParam String
s String
v = String
"--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
v

formatShortMulti :: Char -> String -> String
formatShortMulti :: Char -> ShowS
formatShortMulti Char
c String
h = [Char
'-', Char
c, Char
' '] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
h

formatLongMulti :: String -> String -> String
formatLongMulti :: String -> ShowS
formatLongMulti String
s String
h = String
"--" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
h

-- One row in a --help table.
data Row
  = FreeArgRow String String
  | OptionRow String String String
  deriving Row -> Row -> Bool
(Row -> Row -> Bool) -> (Row -> Row -> Bool) -> Eq Row
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Row -> Row -> Bool
$c/= :: Row -> Row -> Bool
== :: Row -> Row -> Bool
$c== :: Row -> Row -> Bool
Eq

toRow :: OptionHelp -> Row
toRow :: OptionHelp -> Row
toRow (FlagHelp Maybe Char
mbShort Maybe String
mbLong String
desc) =
  String -> String -> String -> Row
OptionRow (Maybe Char -> String
formatShort Maybe Char
mbShort) (Maybe String -> String
formatLong Maybe String
mbLong) String
desc

toRow (ParamHelp Maybe Char
mbShort (Just String
s) String
v String
desc) =
  String -> String -> String -> Row
OptionRow (Maybe Char -> String
formatShort Maybe Char
mbShort) (String -> ShowS
formatLongParam String
s String
v) String
desc
toRow (ParamHelp (Just Char
c) Maybe String
Nothing String
v String
desc) =
  String -> String -> String -> Row
OptionRow (Char -> ShowS
formatShortParam Char
c String
v) String
"" String
desc
toRow (ParamHelp Maybe Char
Nothing Maybe String
Nothing String
_ String
desc) =
  String -> String -> String -> Row
OptionRow String
"" String
"" String
desc

toRow (MultiParamHelp Maybe Char
mbShort (Just String
s) String
h String
desc) =
  String -> String -> String -> Row
OptionRow (Maybe Char -> String
formatShort Maybe Char
mbShort) (String -> ShowS
formatLongMulti String
s String
h) String
desc
toRow (MultiParamHelp (Just Char
c) Maybe String
Nothing String
h String
desc) =
  String -> String -> String -> Row
OptionRow (Char -> ShowS
formatShortMulti Char
c String
h) String
"" String
desc
toRow (MultiParamHelp Maybe Char
Nothing Maybe String
Nothing String
_ String
desc) =
  String -> String -> String -> Row
OptionRow String
"" String
"" String
desc

toRow (FreeArgHelp String
v String
desc) =
  String -> String -> Row
FreeArgRow String
v String
desc


formatOptionHelp :: [OptionHelp] -> String
formatOptionHelp :: [OptionHelp] -> String
formatOptionHelp [OptionHelp]
hs = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
outputs where
  rows :: [Row]
rows = (OptionHelp -> Row) -> [OptionHelp] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map OptionHelp -> Row
toRow [OptionHelp]
hs
  shortWidth :: Int
shortWidth = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
2 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 [String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s | OptionRow String
s String
_ String
_ <- [Row]
rows]
  hasShort :: Bool
hasShort = Int
shortWidth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
  longWidth :: Int
longWidth = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 [String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
l | OptionRow String
_ String
l String
_ <- [Row]
rows]
  hasLong :: Bool
hasLong = Int
longWidth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
  commaWidth :: Int
commaWidth = if Bool
hasShort Bool -> Bool -> Bool
&& Bool
hasLong then Int
2 else Int
0

  toPair :: Row -> (String, String)
toPair (FreeArgRow String
s String
d) = (String
s, String
d)
  toPair (OptionRow String
s String
"" String
d) = (String
s, String
d)
  toPair (OptionRow String
s String
l String
d) = (String
shortStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
commaStr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l, String
d) where
    shortStr :: String
shortStr = Int -> ShowS
pad Int
shortWidth String
s
    commaStr :: String
commaStr = Int -> ShowS
pad Int
commaWidth ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s then String
"" else String
","

  pairs :: [(String, String)]
pairs = (Row -> (String, String)) -> [Row] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map Row -> (String, String)
toPair [Row]
rows
  optWidth :: Int
optWidth = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ([Int] -> Int) -> ([Int] -> [Int]) -> [Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
30) ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((String, String) -> Int) -> [(String, String)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int)
-> ((String, String) -> String) -> (String, String) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) [(String, String)]
pairs

  getOutputStrs :: (String, String) -> [String]
getOutputStrs (String
opt, String
desc) =
    (String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> ShowS
pad Int
optWidth String
opt) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"  " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
d)
    String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
optWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Char
' ' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
d' | String
d' <- [String]
ds]
    where
      (String
d, [String]
ds) = case String -> [String]
lines String
desc of
        [] -> (String
"", [])
        (String
l:[String]
ls) -> (String
l, [String]
ls)

  outputs :: [String]
outputs = ((String, String) -> [String]) -> [(String, String)] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, String) -> [String]
getOutputStrs [(String, String)]
pairs

-- | Formats the 'Help' object.
--
-- > h :: Help
-- > h = makeHeader "Usage: program [options] ARG"
-- >  <> makeFreeArgHelp "ARG" "Positional argument."
-- >  <> makeFlagHelp ["-f", "--foo"] "A flag."
-- >  <> makeParamHelp ["-p", "--param"] "VAL" "A parameter."
-- >  <> makeFooter "Example: program --foo bar"
--
-- >>> putStrLn $ formatHelp h
-- Usage: program [options] ARG
-- <BLANKLINE>
--   ARG              Positional argument.
--   -f, --foo        A flag.
--   -p, --param=VAL  A parameter.
-- <BLANKLINE>
-- Example: program --foo bar
formatHelp :: Help -> String
formatHelp :: Help -> String
formatHelp Help
h = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"\n\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ List String -> [String]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (List String -> [String]) -> List String -> [String]
forall a b. (a -> b) -> a -> b
$ Help -> List String
helpHeader Help
h
  , case List OptionHelp -> [OptionHelp]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (List OptionHelp -> [OptionHelp])
-> List OptionHelp -> [OptionHelp]
forall a b. (a -> b) -> a -> b
$ Help -> List OptionHelp
helpTable Help
h of
      [] -> []
      [OptionHelp]
_ -> [[OptionHelp] -> String
formatOptionHelp ([OptionHelp] -> String)
-> (List OptionHelp -> [OptionHelp]) -> List OptionHelp -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List OptionHelp -> [OptionHelp]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (List OptionHelp -> String) -> List OptionHelp -> String
forall a b. (a -> b) -> a -> b
$ Help -> List OptionHelp
helpTable Help
h]
  , List String -> [String]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (List String -> [String]) -> List String -> [String]
forall a b. (a -> b) -> a -> b
$ Help -> List String
helpFooter Help
h
  ]