hledger: long --help flag shows man page

hledger now embeds its man page, and will display it on --help (like
Ledger and git). -h and --help are now different, like git.

hledger/Hledger/Cli/CliOptions.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, FlexibleContexts #-}
+{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, FlexibleContexts, TemplateHaskell #-}
 {-|
 
 Common cmdargs modes and flags, a command-line options type, and
@@ -21,6 +21,7 @@ module Hledger.Cli.CliOptions (
   defCommandMode,
   defAddonCommandMode,
   argsFlag,
+  showModeUsage,
   showModeHelp,
   withAliases,
 
@@ -64,6 +65,9 @@ import Prelude ()
 import Prelude.Compat
 import qualified Control.Exception as C
 import Control.Monad (when)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.UTF8 as BS8
+import Data.FileEmbed
 #if !MIN_VERSION_base(4,8,0)
 import Data.Functor.Compat ((<$>))
 #endif
@@ -93,7 +97,8 @@ import Hledger.Cli.Version
 -- | Common help flags: --help, --debug, --version...
 helpflags :: [Flag RawOpts]
 helpflags = [
-  flagNone ["help","h"] (setboolopt "help") "show general help or (after command) command help"
+  flagNone ["h"] (setboolopt "shorthelp") "show general usage or (after command) command usage"
+ ,flagNone ["help"] (setboolopt "longhelp") "show detailed help"
  -- ,flagNone ["browse-args"] (setboolopt "browse-args") "use a web UI to select options and build up a command line"
  ,flagReq  ["debug"]    (\s opts -> Right $ setopt "debug" s opts) "N" "show increasing amounts of debug output if N is 1-9. With no argument, show level 1"
  ,flagNone ["version"] (setboolopt "version") "show version information"
@@ -166,7 +171,7 @@ defMode =   Mode {
  ,modeGroupFlags = Group {
      groupNamed = []
     ,groupUnnamed = [
-        flagNone ["help","h","?"] (setboolopt "help") "Show command help."
+        flagNone ["h"] (setboolopt "shorthelp") "Show command help."
         ]
     ,groupHidden = []
     }
@@ -222,11 +227,19 @@ standardAddonsHelp = [
   ,("addon9", "dummy add-on command for testing")
   ]
 
--- | Get a mode's help message as a nicely wrapped string.
+-- | Get a mode's usage message as a nicely wrapped string.
-showModeHelp :: Mode a -> String
+showModeUsage :: Mode a -> String
-showModeHelp = (showText defaultWrap :: [Text] -> String) .
+showModeUsage = (showText defaultWrap :: [Text] -> String) .
                (helpText [] HelpFormatDefault :: Mode a -> [Text])
 
+hledgerManual :: BS.ByteString
+hledgerManual = $(embedFile "doc/hledger.1.txt")
+
+-- | Get the hledger long help, ready for console output
+-- (currently, the hledger.1 man page formatted for 80 columns).
+showModeHelp :: Mode a -> String
+showModeHelp _ = BS8.toString hledgerManual
+
 -- | Add command aliases to the command's help string.
 withAliases :: String -> [String] -> String
 s `withAliases` []     = s
@@ -348,8 +361,8 @@ getCliOpts mode' = do
   opts <- rawOptsToCliOpts rawopts
   debugArgs args' opts
   -- if any (`elem` args) ["--help","-h","-?"]
-  when ("help" `inRawOpts` rawopts_ opts) $
+  when ("shorthelp" `inRawOpts` rawopts_ opts) $ putStr (showModeUsage mode') >> exitSuccess
-    putStr (showModeHelp mode') >> exitSuccess
+  when ("longhelp"  `inRawOpts` rawopts_ opts) $ putStr (showModeHelp mode') >> exitSuccess
   return opts
   where
     -- | Print debug info about arguments and options if --debug is present.

hledger/Hledger/Cli/Main.hs

@@ -242,12 +242,16 @@ main = do
     isInternalCommand    = cmd `elem` builtinCommandNames -- not (null cmd) && not (cmd `elem` addons)
     isExternalCommand    = not (null cmd) && cmd `elem` addonPreciseNames -- probably
     isBadCommand         = not (null rawcmd) && null cmd
-    hasHelp args         = any (`elem` args) ["--help","-h","-?"]
     hasVersion           = ("--version" `elem`)
     hasDetailedVersion   = ("--version+" `elem`)
+    generalUsage         = putStr $ showModeUsage $ mainmode addonDisplayNames
     generalHelp          = putStr $ showModeHelp $ mainmode addonDisplayNames
     badCommandError      = error' ("command "++rawcmd++" is not recognized, run with no command to see a list") >> exitFailure
-    f `orShowHelp` mode  = if hasHelp args then putStr (showModeHelp mode) else f
+    hasShortHelp args    = any (`elem` args) ["-h"]
+    hasLongHelp args     = any (`elem` args) ["--help"]
+    hasHelp args         = hasShortHelp args || hasLongHelp args
+    f `orShowUsage` mode = if hasShortHelp args then putStr (showModeUsage mode) else f
+    f `orShowHelp` mode  = if hasLongHelp  args then putStr (showModeHelp mode) else f
   dbgIO "processed opts" opts
   dbgIO "command matched" cmd
   dbgIO "isNullCommand" isNullCommand
@@ -261,28 +265,29 @@ main = do
   let
     runHledgerCommand
       -- high priority flags and situations. --help should be highest priority.
-      | hasHelp argsbeforecmd    = dbgIO "" "--help before command, showing general help" >> generalHelp
+      | hasShortHelp argsbeforecmd = dbgIO "" "-h before command, showing general usage" >> generalUsage
+      | hasLongHelp argsbeforecmd = dbgIO "" "--help before command, showing general help" >> generalHelp
       | not (hasHelp argsaftercmd) && (hasVersion argsbeforecmd || (hasVersion argsaftercmd && isInternalCommand))
                                  = putStrLn prognameandversion
       | not (hasHelp argsaftercmd) && (hasDetailedVersion argsbeforecmd || (hasDetailedVersion argsaftercmd && isInternalCommand))
                                  = putStrLn prognameanddetailedversion
       -- \| (null externalcmd) && "binary-filename" `inRawOpts` rawopts = putStrLn $ binaryfilename progname
       -- \| "--browse-args" `elem` args     = System.Console.CmdArgs.Helper.execute "cmdargs-browser" mainmode' args >>= (putStr . show)
-      | isNullCommand            = dbgIO "" "no command, showing general help" >> generalHelp
+      | isNullCommand            = dbgIO "" "no command, showing general help" >> generalUsage
       | isBadCommand             = badCommandError
 
       -- internal commands
-      | cmd == "activity"        = withJournalDo opts histogram       `orShowHelp` activitymode
+      | cmd == "activity"        = withJournalDo opts histogram       `orShowUsage` activitymode `orShowHelp` activitymode
-      | cmd == "add"             = (journalFilePathFromOpts opts >>= (ensureJournalFileExists . head) >> withJournalDo opts add) `orShowHelp` addmode
+      | cmd == "add"             = (journalFilePathFromOpts opts >>= (ensureJournalFileExists . head) >> withJournalDo opts add) `orShowUsage` addmode `orShowHelp` addmode
-      | cmd == "accounts"        = withJournalDo opts accounts        `orShowHelp` accountsmode
+      | cmd == "accounts"        = withJournalDo opts accounts        `orShowUsage` accountsmode `orShowHelp` accountsmode
-      | cmd == "balance"         = withJournalDo opts balance         `orShowHelp` balancemode
+      | cmd == "balance"         = withJournalDo opts balance         `orShowUsage` balancemode `orShowHelp` balancemode
-      | cmd == "balancesheet"    = withJournalDo opts balancesheet    `orShowHelp` balancesheetmode
+      | cmd == "balancesheet"    = withJournalDo opts balancesheet    `orShowUsage` balancesheetmode `orShowHelp` balancesheetmode
-      | cmd == "cashflow"        = withJournalDo opts cashflow        `orShowHelp` cashflowmode
+      | cmd == "cashflow"        = withJournalDo opts cashflow        `orShowUsage` cashflowmode `orShowHelp` cashflowmode
-      | cmd == "incomestatement" = withJournalDo opts incomestatement `orShowHelp` incomestatementmode
+      | cmd == "incomestatement" = withJournalDo opts incomestatement `orShowUsage` incomestatementmode `orShowHelp` incomestatementmode
-      | cmd == "print"           = withJournalDo opts print'          `orShowHelp` printmode
+      | cmd == "print"           = withJournalDo opts print'          `orShowUsage` printmode `orShowHelp` printmode
-      | cmd == "register"        = withJournalDo opts register        `orShowHelp` registermode
+      | cmd == "register"        = withJournalDo opts register        `orShowUsage` registermode `orShowHelp` registermode
-      | cmd == "stats"           = withJournalDo opts stats           `orShowHelp` statsmode
+      | cmd == "stats"           = withJournalDo opts stats           `orShowUsage` statsmode `orShowHelp` statsmode
-      | cmd == "test"            = test' opts                         `orShowHelp` testmode
+      | cmd == "test"            = test' opts                         `orShowUsage` testmode `orShowHelp` testmode
 
       -- an external command
       | isExternalCommand = do

hledger/future-package.yaml

@@ -63,11 +63,13 @@ dependencies:
   - hledger-lib == 0.27
   - base >= 4.3 && < 5
   - base-compat >= 0.8.1
+  - bytestring
   - containers
   - unordered-containers
   - cmdargs >= 0.10 && < 0.11
   - csv
   - directory
+  - file-embed
   - filepath
   - haskeline >= 0.6 && <= 0.8
   - HUnit

hledger/hledger.cabal

@@ -61,11 +61,13 @@ library
       hledger-lib == 0.27
     , base >= 4.3 && < 5
     , base-compat >= 0.8.1
+    , bytestring
     , containers
     , unordered-containers
     , cmdargs >= 0.10 && < 0.11
     , csv
     , directory
+    , file-embed
     , filepath
     , haskeline >= 0.6 && <= 0.8
     , HUnit
@@ -135,11 +137,13 @@ executable hledger
       hledger-lib == 0.27
     , base >= 4.3 && < 5
     , base-compat >= 0.8.1
+    , bytestring
     , containers
     , unordered-containers
     , cmdargs >= 0.10 && < 0.11
     , csv
     , directory
+    , file-embed
     , filepath
     , haskeline >= 0.6 && <= 0.8
     , HUnit
@@ -188,11 +192,13 @@ test-suite test
       hledger-lib == 0.27
     , base >= 4.3 && < 5
     , base-compat >= 0.8.1
+    , bytestring
     , containers
     , unordered-containers
     , cmdargs >= 0.10 && < 0.11
     , csv
     , directory
+    , file-embed
     , filepath
     , haskeline >= 0.6 && <= 0.8
     , HUnit
@@ -249,6 +255,7 @@ benchmark bench
                     tabular >= 0.2 && < 0.3,
                     timeit,
                     process,
+                    file-embed,
                     filepath,
                     directory