-- | Support for storing help messages associated to options
--   and for displaying a full help message
module Data.Registry.Options.Help where

import Data.Registry.Options.OptionDescription hiding (help)
import Protolude hiding (Any)

-- | This data type contains optional fields describing
--   either a full command or just a single option
--   A command refers to a list of command fields but can also contain subcommands
data Help = Help
  { -- | name of a command
    Help -> Maybe Text
helpCommandName :: Maybe Text,
    -- | name of the parent command
    Help -> Maybe Text
helpParentCommandName :: Maybe Text,
    -- | short description of a command
    Help -> Maybe Text
helpCommandShortDescription :: Maybe Text,
    -- | long description of a command
    Help -> Maybe Text
helpCommandLongDescription :: Maybe Text,
    -- | list of fields for a given command. Each option description contains some help text
    Help -> [OptionDescription]
helpCommandFields :: [OptionDescription],
    -- | list of subcommands
    Help -> [Help]
helpCommands :: [Help],
    -- | True if the command name is the default subcommand when not mentioned explicitly
    Help -> Bool
helpDefaultSubcommand :: Bool
  }
  deriving (Help -> Help -> Bool
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
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)

-- | Function updating the help
type HelpUpdate = Help -> Help

-- | Create a Help from a list of updates
makeHelp :: [HelpUpdate] -> Help
makeHelp :: [HelpUpdate] -> Help
makeHelp = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Help
r HelpUpdate
u -> HelpUpdate
u Help
r) forall a. Monoid a => a
mempty

-- | Empty Help description
noHelp :: Help
noHelp :: Help
noHelp = Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> [OptionDescription]
-> [Help]
-> Bool
-> Help
Help forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty Bool
False

-- | Create a Help value with a short command description
shortDescription :: Text -> HelpUpdate
shortDescription :: Text -> HelpUpdate
shortDescription Text
t Help
h = Help
h {helpCommandShortDescription :: Maybe Text
helpCommandShortDescription = forall a. a -> Maybe a
Just Text
t}

-- | Create a Help value with a long command description
longDescription :: Text -> HelpUpdate
longDescription :: Text -> HelpUpdate
longDescription Text
t Help
h = Help
h {helpCommandLongDescription :: Maybe Text
helpCommandLongDescription = forall a. a -> Maybe a
Just Text
t}

-- | Create a Help value with a command name, a long and a short description
commandHelp :: Text -> Text -> Text -> Help
commandHelp :: Text -> Text -> Text -> Help
commandHelp Text
n Text
s Text
l = Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> [OptionDescription]
-> [Help]
-> Bool
-> Help
Help (forall a. a -> Maybe a
Just Text
n) forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just Text
s) (forall a. a -> Maybe a
Just Text
l) forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty Bool
False

-- | Create a Help value with no command name
noCommandName :: Help -> Help
noCommandName :: HelpUpdate
noCommandName Help
h = Help
h {helpCommandName :: Maybe Text
helpCommandName = forall a. Maybe a
Nothing}

-- | Set the current subcommand as the default one
defaultSubcommand :: Help -> Help
defaultSubcommand :: HelpUpdate
defaultSubcommand Help
h = Help
h {helpDefaultSubcommand :: Bool
helpDefaultSubcommand = Bool
True}

instance Semigroup Help where
  Help Maybe Text
n1 Maybe Text
p1 Maybe Text
s1 Maybe Text
l1 [OptionDescription]
fs1 [Help]
cs1 Bool
d1 <> :: Help -> HelpUpdate
<> Help Maybe Text
n2 Maybe Text
p2 Maybe Text
s2 Maybe Text
l2 [OptionDescription]
fs2 [Help]
cs2 Bool
d2 = do
    let subcommands :: [Help]
subcommands = (\Help
c -> Help
c {helpParentCommandName :: Maybe Text
helpParentCommandName = Maybe Text
n1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
n2}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Help]
cs1 forall a. Semigroup a => a -> a -> a
<> [Help]
cs2)
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> [OptionDescription]
-> [Help]
-> Bool
-> Help
Help (Maybe Text
n1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
n2) (Maybe Text
p1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
p2) (Maybe Text
s1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
s2) (Maybe Text
l1 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
l2) ([OptionDescription]
fs1 forall a. Semigroup a => a -> a -> a
<> [OptionDescription]
fs2) [Help]
subcommands (Bool
d1 Bool -> Bool -> Bool
|| Bool
d2)

instance Monoid Help where
  mempty :: Help
mempty = Help
noHelp
  mappend :: Help -> HelpUpdate
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | Create a Help description for the alternative of 2 different help descriptions
--   This function is used for collecting the helps of 2 parsers when using the @<|>@ operator
--
--    - two commands end-up being the subcommands of the alternative
--    - a command alternated with some fields becomes a subcommand
alt :: Help -> Help -> Help
alt :: Help -> HelpUpdate
alt h1 :: Help
h1@(Help (Just Text
_) Maybe Text
_ Maybe Text
_ Maybe Text
_ [OptionDescription]
_ [Help]
_ Bool
_) h2 :: Help
h2@(Help (Just Text
_) Maybe Text
_ Maybe Text
_ Maybe Text
_ [OptionDescription]
_ [Help]
_ Bool
_) = Help
noHelp {helpCommands :: [Help]
helpCommands = [Help
h1, Help
h2]}
alt (Help Maybe Text
Nothing Maybe Text
_ Maybe Text
_ Maybe Text
_ [OptionDescription]
fs1 [Help]
cs1 Bool
_) h2 :: Help
h2@(Help (Just Text
_) Maybe Text
_ Maybe Text
_ Maybe Text
_ [OptionDescription]
_ [Help]
_ Bool
_) = Help
noHelp {helpCommandFields :: [OptionDescription]
helpCommandFields = [OptionDescription]
fs1, helpCommands :: [Help]
helpCommands = [Help]
cs1 forall a. Semigroup a => a -> a -> a
<> [Help
h2]}
alt h1 :: Help
h1@(Help (Just Text
_) Maybe Text
_ Maybe Text
_ Maybe Text
_ [OptionDescription]
_ [Help]
_ Bool
_) (Help Maybe Text
Nothing Maybe Text
_ Maybe Text
_ Maybe Text
_ [OptionDescription]
fs2 [Help]
cs2 Bool
_) = Help
noHelp {helpCommandFields :: [OptionDescription]
helpCommandFields = [OptionDescription]
fs2, helpCommands :: [Help]
helpCommands = Help
h1 forall a. a -> [a] -> [a]
: [Help]
cs2}
alt (Help Maybe Text
Nothing Maybe Text
_ Maybe Text
_ Maybe Text
_ [OptionDescription]
fs1 [Help]
cs1 Bool
_) (Help Maybe Text
Nothing Maybe Text
_ Maybe Text
_ Maybe Text
_ [OptionDescription]
fs2 [Help]
cs2 Bool
_) = Help
noHelp {helpCommandFields :: [OptionDescription]
helpCommandFields = [OptionDescription]
fs1 forall a. Semigroup a => a -> a -> a
<> [OptionDescription]
fs2, helpCommands :: [Help]
helpCommands = [Help]
cs1 forall a. Semigroup a => a -> a -> a
<> [Help]
cs2}

-- | Create a Help value from the description of a simple option
fromCliOption :: OptionDescription -> Help
fromCliOption :: OptionDescription -> Help
fromCliOption OptionDescription
o = Help
noHelp {helpCommandFields :: [OptionDescription]
helpCommandFields = [OptionDescription
o]}