    -- |
    -- Module: Options.Help
    -- License: MIT
    module Options.Help
    	( addHelpFlags
    	, checkHelpFlag
    	, helpFor
    	, HelpFlag(..)
    	) where

    import           Control.Monad.Writer
    import           Data.Char (isSpace)
    import           Data.List (intercalate, partition)
    import           Data.Maybe (isNothing, listToMaybe)
    import qualified Data.Set as Set
    import qualified Data.Map as Map

    import           Options.Tokenize
    import           Options.Types

    data HelpFlag = HelpSummary | HelpAll | HelpGroup String
    	deriving (HelpFlag -> HelpFlag -> Bool
    (HelpFlag -> HelpFlag -> Bool)
    -> (HelpFlag -> HelpFlag -> Bool) -> Eq HelpFlag
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: HelpFlag -> HelpFlag -> Bool
    == :: HelpFlag -> HelpFlag -> Bool
    $c/= :: HelpFlag -> HelpFlag -> Bool
    /= :: HelpFlag -> HelpFlag -> Bool
    Eq, Int -> HelpFlag -> ShowS
    [HelpFlag] -> ShowS
    HelpFlag -> String
    (Int -> HelpFlag -> ShowS)
    -> (HelpFlag -> String) -> ([HelpFlag] -> ShowS) -> Show HelpFlag
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> HelpFlag -> ShowS
    showsPrec :: Int -> HelpFlag -> ShowS
    $cshow :: HelpFlag -> String
    show :: HelpFlag -> String
    $cshowList :: [HelpFlag] -> ShowS
    showList :: [HelpFlag] -> ShowS
    Show)

    addHelpFlags :: OptionDefinitions -> OptionDefinitions
    addHelpFlags :: OptionDefinitions -> OptionDefinitions
    addHelpFlags (OptionDefinitions [OptionInfo]
    opts [(String, [OptionInfo])]
    subcmds) = [OptionInfo] -> [(String, [OptionInfo])] -> OptionDefinitions
    OptionDefinitions [OptionInfo]
    withHelp [(String, [OptionInfo])]
    subcmdsWithHelp where
    	shortFlags :: Set Char
    shortFlags = String -> Set Char
    forall a. Ord a => [a] -> Set a
    Set.fromList (String -> Set Char) -> String -> Set Char
    forall a b. (a -> b) -> a -> b
    $ do
    		OptionInfo
    opt <- [OptionInfo]
    opts
    		OptionInfo -> String
    optionInfoShortFlags OptionInfo
    opt
    	longFlags :: Set String
    longFlags = [String] -> Set String
    forall a. Ord a => [a] -> Set a
    Set.fromList ([String] -> Set String) -> [String] -> Set String
    forall a b. (a -> b) -> a -> b
    $ do
    		OptionInfo
    opt <- [OptionInfo]
    opts
    		OptionInfo -> [String]
    optionInfoLongFlags OptionInfo
    opt

    	withHelp :: [OptionInfo]
    withHelp = [OptionInfo]
    optHelpSummary [OptionInfo] -> [OptionInfo] -> [OptionInfo]
    forall a. [a] -> [a] -> [a]
    ++ [OptionInfo]
    optsGroupHelp [OptionInfo] -> [OptionInfo] -> [OptionInfo]
    forall a. [a] -> [a] -> [a]
    ++ [OptionInfo]
    opts

    	groupHelp :: Group
    groupHelp = Group
    		{ groupName :: String
    groupName = String
    "all"
    		, groupTitle :: String
    groupTitle = String
    "Help Options"
    		, groupDescription :: String
    groupDescription = String
    "Show all help options."
    		}

    	optSummary :: OptionInfo
    optSummary = OptionInfo
    		{ optionInfoKey :: OptionKey
    optionInfoKey = OptionKey
    OptionKeyHelpSummary
    		, optionInfoShortFlags :: String
    optionInfoShortFlags = []
    		, optionInfoLongFlags :: [String]
    optionInfoLongFlags = []
    		, optionInfoDefault :: String
    optionInfoDefault = String
    ""
    		, optionInfoUnary :: Bool
    optionInfoUnary = Bool
    True
    		, optionInfoUnaryOnly :: Bool
    optionInfoUnaryOnly = Bool
    True
    		, optionInfoDescription :: String
    optionInfoDescription = String
    "Show option summary."
    		, optionInfoGroup :: Maybe Group
    optionInfoGroup = Group -> Maybe Group
    forall a. a -> Maybe a
    Just Group
    groupHelp
    		, optionInfoLocation :: Maybe Location
    optionInfoLocation = Maybe Location
    forall a. Maybe a
    Nothing
    		, optionInfoTypeName :: String
    optionInfoTypeName = String
    ""
    		}

    	optGroupHelp :: Group -> String -> OptionInfo
    optGroupHelp Group
    group String
    flag = OptionInfo
    		{ optionInfoKey :: OptionKey
    optionInfoKey = String -> OptionKey
    OptionKeyHelpGroup (Group -> String
    groupName Group
    group)
    		, optionInfoShortFlags :: String
    optionInfoShortFlags = []
    		, optionInfoLongFlags :: [String]
    optionInfoLongFlags = [String
    flag]
    		, optionInfoDefault :: String
    optionInfoDefault = String
    ""
    		, optionInfoUnary :: Bool
    optionInfoUnary = Bool
    True
    		, optionInfoUnaryOnly :: Bool
    optionInfoUnaryOnly = Bool
    True
    		, optionInfoDescription :: String
    optionInfoDescription = Group -> String
    groupDescription Group
    group
    		, optionInfoGroup :: Maybe Group
    optionInfoGroup = Group -> Maybe Group
    forall a. a -> Maybe a
    Just Group
    groupHelp
    		, optionInfoLocation :: Maybe Location
    optionInfoLocation = Maybe Location
    forall a. Maybe a
    Nothing
    		, optionInfoTypeName :: String
    optionInfoTypeName = String
    ""
    		}

    	optHelpSummary :: [OptionInfo]
    optHelpSummary = if Char -> Set Char -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member Char
    'h' Set Char
    shortFlags
    		then if String -> Set String -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member String
    "help" Set String
    longFlags
    			then []
    			else [OptionInfo
    optSummary
    				{ optionInfoLongFlags :: [String]
    optionInfoLongFlags = [String
    "help"]
    				}]
    		else if String -> Set String -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member String
    "help" Set String
    longFlags
    			then [OptionInfo
    optSummary
    				{ optionInfoShortFlags :: String
    optionInfoShortFlags = [Char
    'h']
    				}]
    			else [OptionInfo
    optSummary
    				{ optionInfoShortFlags :: String
    optionInfoShortFlags = [Char
    'h']
    				, optionInfoLongFlags :: [String]
    optionInfoLongFlags = [String
    "help"]
    				}]

    	optsGroupHelp :: [OptionInfo]
    optsGroupHelp = do
    		let ([(Group, [OptionInfo])]
    groupsAndOpts, [OptionInfo]
    _) = [OptionInfo] -> ([(Group, [OptionInfo])], [OptionInfo])
    uniqueGroups [OptionInfo]
    opts
    		let groups :: [Group]
    groups = [Group
    g | (Group
    g, [OptionInfo]
    _) <- [(Group, [OptionInfo])]
    groupsAndOpts]
    		Group
    group <- (Group
    groupHelp Group -> [Group] -> [Group]
    forall a. a -> [a] -> [a]
    : [Group]
    groups)
    		let flag :: String
    flag = String
    "help-" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Group -> String
    groupName Group
    group
    		if String -> Set String -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member String
    flag Set String
    longFlags
    			then []
    			else [Group -> String -> OptionInfo
    optGroupHelp Group
    group String
    flag]

    	subcmdsWithHelp :: [(String, [OptionInfo])]
    subcmdsWithHelp = do
    		(String
    subcmdName, [OptionInfo]
    subcmdOpts) <- [(String, [OptionInfo])]
    subcmds
    		let subcmdLongFlags :: Set String
    subcmdLongFlags = [String] -> Set String
    forall a. Ord a => [a] -> Set a
    Set.fromList ([String] -> Set String) -> [String] -> Set String
    forall a b. (a -> b) -> a -> b
    $ do
    			OptionInfo
    opt <- [OptionInfo]
    subcmdOpts [OptionInfo] -> [OptionInfo] -> [OptionInfo]
    forall a. [a] -> [a] -> [a]
    ++ [OptionInfo]
    optsGroupHelp
    			OptionInfo -> [String]
    optionInfoLongFlags OptionInfo
    opt

    		let ([(Group, [OptionInfo])]
    groupsAndOpts, [OptionInfo]
    _) = [OptionInfo] -> ([(Group, [OptionInfo])], [OptionInfo])
    uniqueGroups [OptionInfo]
    subcmdOpts
    		let groups :: [Group]
    groups = [Group
    g | (Group
    g, [OptionInfo]
    _) <- [(Group, [OptionInfo])]
    groupsAndOpts]
    		let newOpts :: [OptionInfo]
    newOpts = do
    			Group
    group <- [Group]
    groups
    			let flag :: String
    flag = String
    "help-" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Group -> String
    groupName Group
    group
    			if String -> Set String -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member String
    flag (Set String -> Set String -> Set String
    forall a. Ord a => Set a -> Set a -> Set a
    Set.union Set String
    longFlags Set String
    subcmdLongFlags)
    				then []
    				else [Group -> String -> OptionInfo
    optGroupHelp Group
    group String
    flag]
    		(String, [OptionInfo]) -> [(String, [OptionInfo])]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    subcmdName, [OptionInfo]
    newOpts [OptionInfo] -> [OptionInfo] -> [OptionInfo]
    forall a. [a] -> [a] -> [a]
    ++ [OptionInfo]
    subcmdOpts)

    checkHelpFlag :: Tokens -> Maybe HelpFlag
    checkHelpFlag :: Tokens -> Maybe HelpFlag
    checkHelpFlag Tokens
    tokens = Maybe HelpFlag
    flag where
    	flag :: Maybe HelpFlag
    flag = [HelpFlag] -> Maybe HelpFlag
    forall a. [a] -> Maybe a
    listToMaybe [HelpFlag]
    helpKeys
    	helpKeys :: [HelpFlag]
    helpKeys = do
    		([OptionKey]
    k, Token
    _) <- Tokens -> [([OptionKey], Token)]
    tokensList Tokens
    tokens
    		case [OptionKey]
    k of
    			[OptionKey
    OptionKeyHelpSummary] -> HelpFlag -> [HelpFlag]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return HelpFlag
    HelpSummary
    			[OptionKeyHelpGroup String
    "all"] -> HelpFlag -> [HelpFlag]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return HelpFlag
    HelpAll
    			[OptionKeyHelpGroup String
    name] -> HelpFlag -> [HelpFlag]
    forall a. a -> [a]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> HelpFlag
    HelpGroup String
    name)
    			[OptionKey]
    _ -> []

    helpFor :: HelpFlag -> OptionDefinitions -> Maybe String -> String
    helpFor :: HelpFlag -> OptionDefinitions -> Maybe String -> String
    helpFor HelpFlag
    flag OptionDefinitions
    defs Maybe String
    subcmd = case HelpFlag
    flag of
    	HelpFlag
    HelpSummary -> Writer String () -> String
    forall w a. Writer w a -> w
    execWriter (OptionDefinitions -> Maybe String -> Writer String ()
    showHelpSummary OptionDefinitions
    defs Maybe String
    subcmd)
    	HelpFlag
    HelpAll -> Writer String () -> String
    forall w a. Writer w a -> w
    execWriter (OptionDefinitions -> Maybe String -> Writer String ()
    showHelpAll OptionDefinitions
    defs Maybe String
    subcmd)
    	HelpGroup String
    name -> Writer String () -> String
    forall w a. Writer w a -> w
    execWriter (OptionDefinitions -> String -> Maybe String -> Writer String ()
    showHelpOneGroup OptionDefinitions
    defs String
    name Maybe String
    subcmd)

    showOptionHelp :: OptionInfo -> Writer String ()
    showOptionHelp :: OptionInfo -> Writer String ()
    showOptionHelp OptionInfo
    info = do
    	let safeHead :: [a] -> [a]
    safeHead [a]
    xs = case [a]
    xs of
    		[] -> []
    		(a
    x:[a]
    _) -> [a
    x]
    	let shorts :: String
    shorts = OptionInfo -> String
    optionInfoShortFlags OptionInfo
    info
    	let longs :: [String]
    longs = OptionInfo -> [String]
    optionInfoLongFlags OptionInfo
    info
    	let optStrings :: [String]
    optStrings = (Char -> String) -> String -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Char
    x -> [Char
    '-', Char
    x]) (ShowS
    forall {a}. [a] -> [a]
    safeHead String
    shorts) [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ ShowS -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\String
    x -> String
    "--" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    x) ([String] -> [String]
    forall {a}. [a] -> [a]
    safeHead [String]
    longs)
    	Bool -> Writer String () -> Writer String ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    optStrings) (Writer String () -> Writer String ())
    -> Writer String () -> Writer String ()
    forall a b. (a -> b) -> a -> b
    $ do
    		let optStringCsv :: String
    optStringCsv = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ", " [String]
    optStrings
    		WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    "  "
    		WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    optStringCsv
    		Bool -> Writer String () -> Writer String ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (OptionInfo -> String
    optionInfoTypeName OptionInfo
    info)) (Writer String () -> Writer String ())
    -> Writer String () -> Writer String ()
    forall a b. (a -> b) -> a -> b
    $ do
    			WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    " :: "
    			WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell (OptionInfo -> String
    optionInfoTypeName OptionInfo
    info)
    		WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    "\n"
    		Bool -> Writer String () -> Writer String ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (OptionInfo -> String
    optionInfoDescription OptionInfo
    info)) (Writer String () -> Writer String ())
    -> Writer String () -> Writer String ()
    forall a b. (a -> b) -> a -> b
    $ do
    			[String] -> (String -> Writer String ()) -> Writer String ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ (Int -> String -> [String]
    wrapWords Int
    76 (OptionInfo -> String
    optionInfoDescription OptionInfo
    info)) ((String -> Writer String ()) -> Writer String ())
    -> (String -> Writer String ()) -> Writer String ()
    forall a b. (a -> b) -> a -> b
    $ \String
    line -> do
    				WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    "    "
    				WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    line
    				WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    "\n"
    		Bool -> Writer String () -> Writer String ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (OptionInfo -> String
    optionInfoDefault OptionInfo
    info)) (Writer String () -> Writer String ())
    -> Writer String () -> Writer String ()
    forall a b. (a -> b) -> a -> b
    $ do
    			WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    "    default: "
    			WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell (OptionInfo -> String
    optionInfoDefault OptionInfo
    info)
    			WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    "\n"

    -- A simple greedy word-wrapper for fixed-width terminals, permitting overruns
    -- and ragged edges.
    wrapWords :: Int -> String -> [String]
    wrapWords :: Int -> String -> [String]
    wrapWords Int
    breakWidth = String -> [String]
    wrap where
    	wrap :: String -> [String]
    wrap String
    line = if String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    line Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    breakWidth
    		then [String
    line]
    		else if (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Char -> Bool
    isBreak String
    line
    			then case Int -> String -> (String, String)
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    breakWidth String
    line of
    				(String
    beforeBreak, String
    afterBreak) -> case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    reverseBreak Char -> Bool
    isBreak String
    beforeBreak of
    					(String
    beforeWrap, String
    afterWrap) -> String
    beforeWrap String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : String -> [String]
    wrap (String
    afterWrap String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    afterBreak)
    			else [String
    line]
    	isBreak :: Char -> Bool
    isBreak Char
    c = case Char
    c of
    		Char
    '\xA0' -> Bool
    False -- NO-BREAK SPACE
    		Char
    '\x202F' -> Bool
    False -- NARROW NO-BREAK SPACE
    		Char
    '\x2011' -> Bool
    False -- NON-BREAKING HYPHEN
    		Char
    '-' -> Bool
    True
    		Char
    _ -> Char -> Bool
    isSpace Char
    c
    	reverseBreak :: (a -> Bool) -> [a] -> ([a], [a])
    	reverseBreak :: forall a. (a -> Bool) -> [a] -> ([a], [a])
    reverseBreak a -> Bool
    f [a]
    xs = case (a -> Bool) -> [a] -> ([a], [a])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break a -> Bool
    f ([a] -> [a]
    forall {a}. [a] -> [a]
    reverse [a]
    xs) of
    		([a]
    after, [a]
    before) -> ([a] -> [a]
    forall {a}. [a] -> [a]
    reverse [a]
    before, [a] -> [a]
    forall {a}. [a] -> [a]
    reverse [a]
    after)

    showHelpSummary :: OptionDefinitions -> Maybe String -> Writer String ()
    showHelpSummary :: OptionDefinitions -> Maybe String -> Writer String ()
    showHelpSummary (OptionDefinitions [OptionInfo]
    mainOpts [(String, [OptionInfo])]
    subcmds) Maybe String
    subcmd = do
    	let subcmdOptions :: Maybe (String, [OptionInfo])
    subcmdOptions = do
    		String
    subcmdName <- Maybe String
    subcmd
    		[OptionInfo]
    opts <- String -> [(String, [OptionInfo])] -> Maybe [OptionInfo]
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    subcmdName [(String, [OptionInfo])]
    subcmds
    		(String, [OptionInfo]) -> Maybe (String, [OptionInfo])
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    subcmdName, [OptionInfo]
    opts)

    	let ([(Group, [OptionInfo])]
    groupInfos, [OptionInfo]
    ungroupedMainOptions) = [OptionInfo] -> ([(Group, [OptionInfo])], [OptionInfo])
    uniqueGroups [OptionInfo]
    mainOpts

    	-- Always print --help group
    	let hasHelp :: [(Group, [OptionInfo])]
    hasHelp = ((Group, [OptionInfo]) -> Bool)
    -> [(Group, [OptionInfo])] -> [(Group, [OptionInfo])]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(Group
    g,[OptionInfo]
    _) -> Group -> String
    groupName Group
    g String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "all") [(Group, [OptionInfo])]
    groupInfos
    	[(Group, [OptionInfo])]
    -> ((Group, [OptionInfo]) -> Writer String ()) -> Writer String ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [(Group, [OptionInfo])]
    hasHelp (Group, [OptionInfo]) -> Writer String ()
    showHelpGroup

    	Bool -> Writer String () -> Writer String ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([OptionInfo] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [OptionInfo]
    ungroupedMainOptions) (Writer String () -> Writer String ())
    -> Writer String () -> Writer String ()
    forall a b. (a -> b) -> a -> b
    $ do
    		WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    "Application Options:\n"
    		[OptionInfo]
    -> (OptionInfo -> Writer String ()) -> Writer String ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [OptionInfo]
    ungroupedMainOptions OptionInfo -> Writer String ()
    showOptionHelp
    		Bool -> Writer String () -> Writer String ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([(String, [OptionInfo])] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(String, [OptionInfo])]
    subcmds) (WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    "\n")

    	case Maybe (String, [OptionInfo])
    subcmdOptions of
    		Maybe (String, [OptionInfo])
    Nothing -> Bool -> Writer String () -> Writer String ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([(String, [OptionInfo])] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(String, [OptionInfo])]
    subcmds) (Writer String () -> Writer String ())
    -> Writer String () -> Writer String ()
    forall a b. (a -> b) -> a -> b
    $ do
    			WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    "Subcommands:\n"
    			[(String, [OptionInfo])]
    -> ((String, [OptionInfo]) -> Writer String ()) -> Writer String ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [(String, [OptionInfo])]
    subcmds (((String, [OptionInfo]) -> Writer String ()) -> Writer String ())
    -> ((String, [OptionInfo]) -> Writer String ()) -> Writer String ()
    forall a b. (a -> b) -> a -> b
    $ \(String
    subcmdName, [OptionInfo]
    _) -> do
    				WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    "  "
    				WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    subcmdName
    				-- TODO: subcommand help description
    				WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    "\n"
    			WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    "\n"
    		Just (String
    n, [OptionInfo]
    subOpts) -> do
    			-- TODO: subcommand description
    			-- TODO: handle grouped options in subcommands?
    			WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell (String
    "Options for subcommand " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> String
    show String
    n String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ":\n")
    			[OptionInfo]
    -> (OptionInfo -> Writer String ()) -> Writer String ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [OptionInfo]
    subOpts OptionInfo -> Writer String ()
    showOptionHelp
    			WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    "\n"

    showHelpAll :: OptionDefinitions -> Maybe String -> Writer String ()
    showHelpAll :: OptionDefinitions -> Maybe String -> Writer String ()
    showHelpAll (OptionDefinitions [OptionInfo]
    mainOpts [(String, [OptionInfo])]
    subcmds) Maybe String
    subcmd = do
    	let subcmdOptions :: Maybe (String, [OptionInfo])
    subcmdOptions = do
    		String
    subcmdName <- Maybe String
    subcmd
    		[OptionInfo]
    opts <- String -> [(String, [OptionInfo])] -> Maybe [OptionInfo]
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    subcmdName [(String, [OptionInfo])]
    subcmds
    		(String, [OptionInfo]) -> Maybe (String, [OptionInfo])
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    subcmdName, [OptionInfo]
    opts)

    	let ([(Group, [OptionInfo])]
    groupInfos, [OptionInfo]
    ungroupedMainOptions) = [OptionInfo] -> ([(Group, [OptionInfo])], [OptionInfo])
    uniqueGroups [OptionInfo]
    mainOpts

    	-- Always print --help group first, if present
    	let ([(Group, [OptionInfo])]
    hasHelp, [(Group, [OptionInfo])]
    noHelp) = ((Group, [OptionInfo]) -> Bool)
    -> [(Group, [OptionInfo])]
    -> ([(Group, [OptionInfo])], [(Group, [OptionInfo])])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (\(Group
    g,[OptionInfo]
    _) -> Group -> String
    groupName Group
    g String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "all") [(Group, [OptionInfo])]
    groupInfos
    	[(Group, [OptionInfo])]
    -> ((Group, [OptionInfo]) -> Writer String ()) -> Writer String ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [(Group, [OptionInfo])]
    hasHelp (Group, [OptionInfo]) -> Writer String ()
    showHelpGroup
    	[(Group, [OptionInfo])]
    -> ((Group, [OptionInfo]) -> Writer String ()) -> Writer String ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [(Group, [OptionInfo])]
    noHelp (Group, [OptionInfo]) -> Writer String ()
    showHelpGroup

    	WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    "Application Options:\n"
    	[OptionInfo]
    -> (OptionInfo -> Writer String ()) -> Writer String ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [OptionInfo]
    ungroupedMainOptions OptionInfo -> Writer String ()
    showOptionHelp
    	Bool -> Writer String () -> Writer String ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([(String, [OptionInfo])] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(String, [OptionInfo])]
    subcmds) (WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    "\n")

    	case Maybe (String, [OptionInfo])
    subcmdOptions of
    		Maybe (String, [OptionInfo])
    Nothing -> [(String, [OptionInfo])]
    -> ((String, [OptionInfo]) -> Writer String ()) -> Writer String ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [(String, [OptionInfo])]
    subcmds (((String, [OptionInfo]) -> Writer String ()) -> Writer String ())
    -> ((String, [OptionInfo]) -> Writer String ()) -> Writer String ()
    forall a b. (a -> b) -> a -> b
    $ \(String
    subcmdName, [OptionInfo]
    subcmdOpts) -> do
    			-- no subcommand description
    			WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell (String
    "Options for subcommand " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> String
    show String
    subcmdName String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ":\n")
    			[OptionInfo]
    -> (OptionInfo -> Writer String ()) -> Writer String ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [OptionInfo]
    subcmdOpts OptionInfo -> Writer String ()
    showOptionHelp
    			WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    "\n"
    		Just (String
    n, [OptionInfo]
    subOpts) -> do
    			-- TODO: subcommand description
    			-- TODO: handle grouped options in subcommands?
    			WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell (String
    "Options for subcommand " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ShowS
    forall a. Show a => a -> String
    show String
    n String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ":\n")
    			[OptionInfo]
    -> (OptionInfo -> Writer String ()) -> Writer String ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [OptionInfo]
    subOpts OptionInfo -> Writer String ()
    showOptionHelp
    			WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    "\n"

    showHelpGroup :: (Group, [OptionInfo]) -> Writer String ()
    showHelpGroup :: (Group, [OptionInfo]) -> Writer String ()
    showHelpGroup (Group
    groupInfo, [OptionInfo]
    opts) = do
    	WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell (Group -> String
    groupTitle Group
    groupInfo String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ":\n")
    	[OptionInfo]
    -> (OptionInfo -> Writer String ()) -> Writer String ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [OptionInfo]
    opts OptionInfo -> Writer String ()
    showOptionHelp
    	WriterType (WriterT String Identity) -> Writer String ()
    forall (m :: * -> *). MonadWriter m => WriterType m -> m ()
    tell String
    WriterType (WriterT String Identity)
    "\n"

    showHelpOneGroup :: OptionDefinitions -> String -> Maybe String -> Writer String ()
    showHelpOneGroup :: OptionDefinitions -> String -> Maybe String -> Writer String ()
    showHelpOneGroup (OptionDefinitions [OptionInfo]
    mainOpts [(String, [OptionInfo])]
    subcmds) String
    name Maybe String
    subcmd = do
    	let opts :: [OptionInfo]
    opts = case Maybe String
    subcmd of
    		Maybe String
    Nothing -> [OptionInfo]
    mainOpts
    		Just String
    n -> case String -> [(String, [OptionInfo])] -> Maybe [OptionInfo]
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    n [(String, [OptionInfo])]
    subcmds of
    			Just [OptionInfo]
    infos -> [OptionInfo]
    mainOpts [OptionInfo] -> [OptionInfo] -> [OptionInfo]
    forall a. [a] -> [a] -> [a]
    ++ [OptionInfo]
    infos -- both
    			Maybe [OptionInfo]
    Nothing -> [OptionInfo]
    mainOpts
    	let ([(Group, [OptionInfo])]
    groupInfos, [OptionInfo]
    _) = [OptionInfo] -> ([(Group, [OptionInfo])], [OptionInfo])
    uniqueGroups [OptionInfo]
    opts

    	-- Always print --help group
    	let group :: [(Group, [OptionInfo])]
    group = ((Group, [OptionInfo]) -> Bool)
    -> [(Group, [OptionInfo])] -> [(Group, [OptionInfo])]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(Group
    g,[OptionInfo]
    _) -> Group -> String
    groupName Group
    g String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    name) [(Group, [OptionInfo])]
    groupInfos
    	[(Group, [OptionInfo])]
    -> ((Group, [OptionInfo]) -> Writer String ()) -> Writer String ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [(Group, [OptionInfo])]
    group (Group, [OptionInfo]) -> Writer String ()
    showHelpGroup

    uniqueGroups :: [OptionInfo] -> ([(Group, [OptionInfo])], [OptionInfo])
    uniqueGroups :: [OptionInfo] -> ([(Group, [OptionInfo])], [OptionInfo])
    uniqueGroups [OptionInfo]
    allOptions = (Map String (Group, [OptionInfo]) -> [(Group, [OptionInfo])]
    forall k a. Map k a -> [a]
    Map.elems Map String (Group, [OptionInfo])
    infoMap, [OptionInfo]
    ungroupedOptions) where
    	infoMap :: Map String (Group, [OptionInfo])
    infoMap = ((Group, [OptionInfo])
     -> (Group, [OptionInfo]) -> (Group, [OptionInfo]))
    -> [(String, (Group, [OptionInfo]))]
    -> Map String (Group, [OptionInfo])
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    Map.fromListWith (Group, [OptionInfo])
    -> (Group, [OptionInfo]) -> (Group, [OptionInfo])
    forall {a} {a} {a}. (a, [a]) -> (a, [a]) -> (a, [a])
    merge ([(String, (Group, [OptionInfo]))]
     -> Map String (Group, [OptionInfo]))
    -> [(String, (Group, [OptionInfo]))]
    -> Map String (Group, [OptionInfo])
    forall a b. (a -> b) -> a -> b
    $ do
    		OptionInfo
    opt <- [OptionInfo]
    allOptions
    		case OptionInfo -> Maybe Group
    optionInfoGroup OptionInfo
    opt of
    			Maybe Group
    Nothing -> []
    			Just Group
    g -> [(Group -> String
    groupName Group
    g, (Group
    g, [OptionInfo
    opt]))]
    	merge :: (a, [a]) -> (a, [a]) -> (a, [a])
    merge (a
    g, [a]
    opts1) (a
    _, [a]
    opts2) = (a
    g, [a]
    opts2 [a] -> [a] -> [a]
    forall a. [a] -> [a] -> [a]
    ++ [a]
    opts1)
    	ungroupedOptions :: [OptionInfo]
    ungroupedOptions = [OptionInfo
    o | OptionInfo
    o <- [OptionInfo]
    allOptions, Maybe Group -> Bool
    forall a. Maybe a -> Bool
    isNothing (OptionInfo -> Maybe Group
    optionInfoGroup OptionInfo
    o)]