hledger: embed main man pages; new help command

hledger/Hledger/Cli.hs

@@ -13,12 +13,14 @@ module Hledger.Cli (
                      module Hledger.Cli.Balance,
                      module Hledger.Cli.Balancesheet,
                      module Hledger.Cli.Cashflow,
+                     module Hledger.Cli.Help,
                      module Hledger.Cli.Histogram,
                      module Hledger.Cli.Incomestatement,
                      module Hledger.Cli.Print,
                      module Hledger.Cli.Register,
                      module Hledger.Cli.Stats,
                      module Hledger.Cli.CliOptions,
+                     module Hledger.Cli.DocFiles,
                      module Hledger.Cli.Utils,
                      module Hledger.Cli.Version,
                      tests_Hledger_Cli,
@@ -37,11 +39,13 @@ import Hledger.Cli.Balance
 import Hledger.Cli.Balancesheet
 import Hledger.Cli.Cashflow
 import Hledger.Cli.Histogram
+import Hledger.Cli.Help
 import Hledger.Cli.Incomestatement
 import Hledger.Cli.Print
 import Hledger.Cli.Register
 import Hledger.Cli.Stats
 import Hledger.Cli.CliOptions
+import Hledger.Cli.DocFiles
 import Hledger.Cli.Utils
 import Hledger.Cli.Version
 

hledger/Hledger/Cli/CliOptions.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, FlexibleContexts, TemplateHaskell #-}
+{-# LANGUAGE CPP, ScopedTypeVariables, DeriveDataTypeable, FlexibleContexts #-}
 {-|
 
 Common cmdargs modes and flags, a command-line options type, and
@@ -65,9 +65,6 @@ 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
@@ -89,6 +86,7 @@ import Test.HUnit
 import Text.Parsec
 
 import Hledger
+import Hledger.Cli.DocFiles
 import Hledger.Cli.Version
 
 
@@ -232,13 +230,10 @@ showModeUsage :: Mode a -> 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).
+-- | Get a mode's long help, ready for console output
+-- (currently, the hledger man page formatted for 80 columns).
 showModeHelp :: Mode a -> String
-showModeHelp _ = BS8.toString hledgerManual
+showModeHelp _ = lookupDocTxt "hledger"
 
 -- | Add command aliases to the command's help string.
 withAliases :: String -> [String] -> String

hledger/Hledger/Cli/DocFiles.hs

@@ -0,0 +1,63 @@
+{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}
+{-|
+
+Embedded help files (man pages).
+
+|-}
+
+module Hledger.Cli.DocFiles (
+
+   docFiles
+  ,docTopics
+  ,lookupDocNroff
+  ,lookupDocTxt
+
+  ) where
+
+import Prelude ()
+import Prelude.Compat
+import Data.FileEmbed
+import Data.String
+
+type Topic = String
+
+-- XXX assumes cwd is the hledger package directory, for now ghci must be run from there
+docFiles :: IsString a => [(Topic, (a, a))]
+docFiles = [
+   ("cli",
+    ($(embedStringFile $ "../hledger/doc/hledger.1"),
+     $(embedStringFile $ "../hledger/doc/hledger.1.txt")))
+  ,("ui",
+    ($(embedStringFile $ "../hledger-ui/doc/hledger-ui.1"),
+     $(embedStringFile $ "../hledger-ui/doc/hledger-ui.1.txt")))
+  ,("web",
+    ($(embedStringFile $ "../hledger-web/doc/hledger-web.1"),
+     $(embedStringFile $ "../hledger-web/doc/hledger-web.1.txt")))
+  ,("api",
+    ($(embedStringFile $ "../hledger-api/doc/hledger-api.1"),
+     $(embedStringFile $ "../hledger-api/doc/hledger-api.1.txt")))
+  ,("journal",
+    ($(embedStringFile $ "../hledger-lib/doc/hledger_journal.5"),
+     $(embedStringFile $ "../hledger-lib/doc/hledger_journal.5.txt")))
+  ,("csv",
+    ($(embedStringFile $ "../hledger-lib/doc/hledger_csv.5"),
+     $(embedStringFile $ "../hledger-lib/doc/hledger_csv.5.txt")))
+  ,("timeclock",
+    ($(embedStringFile $ "../hledger-lib/doc/hledger_timeclock.5"),
+     $(embedStringFile $ "../hledger-lib/doc/hledger_timeclock.5.txt")))
+  ,("timedot",
+    ($(embedStringFile $ "../hledger-lib/doc/hledger_timedot.5"),
+     $(embedStringFile $ "../hledger-lib/doc/hledger_timedot.5.txt")))
+  ]
+
+docTopics :: [Topic]
+docTopics = map fst docFiles
+
+lookupDocNroff :: IsString a => Topic -> a
+lookupDocNroff name =
+  maybe (fromString $ "No such help topic: "++name) fst $ lookup name docFiles
+
+lookupDocTxt :: IsString a => Topic -> a
+lookupDocTxt name =
+  maybe (fromString $ "No such help topic: "++name) snd $ lookup name docFiles
+

hledger/Hledger/Cli/Help.hs

@@ -0,0 +1,42 @@
+{-|
+
+The help command.
+
+|-}
+
+module Hledger.Cli.Help (
+
+   helpmode
+  ,help'
+
+  ) where
+
+import Prelude ()
+import Prelude.Compat
+import Data.List
+import System.Console.CmdArgs.Explicit
+
+import Hledger.Data.RawOptions
+import Hledger.Cli.CliOptions
+import Hledger.Cli.DocFiles
+
+helpmode = (defCommandMode $ ["help"] ++ aliases) {
+  modeHelp = "show detailed help (the main hledger man pages)" `withAliases` aliases
+ ,modeGroupFlags = Group {
+     groupUnnamed = []
+    ,groupHidden = []
+    ,groupNamed = []
+    }
+ }
+  where aliases = []
+
+-- | Print detailed help on various topics.
+help' :: CliOpts -> IO ()
+help' opts = do
+  let args = listofstringopt "args" $ rawopts_ opts
+  case args of
+    []    -> putStrLn $
+             "Choose a topic, eg: hledger help ui\n" ++
+             intercalate ", " docTopics
+    topic:_ -> putStrLn $ lookupDocTxt topic
+

hledger/Hledger/Cli/Main.hs

@@ -55,6 +55,7 @@ import Hledger.Cli.Accounts
 import Hledger.Cli.Balance
 import Hledger.Cli.Balancesheet
 import Hledger.Cli.Cashflow
+import Hledger.Cli.Help
 import Hledger.Cli.Histogram
 import Hledger.Cli.Incomestatement
 import Hledger.Cli.Print
@@ -98,6 +99,7 @@ mainmode addons = defMode {
                        cs -> [("\nAdd-on commands", map defAddonCommandMode cs)]
     -- modes in the unnamed group, shown first without a heading:
    ,groupUnnamed = [
+        helpmode
      ]
     -- modes handled but not shown
    ,groupHidden = [
@@ -244,8 +246,8 @@ main = do
     isBadCommand         = not (null rawcmd) && null cmd
     hasVersion           = ("--version" `elem`)
     hasDetailedVersion   = ("--version+" `elem`)
-    generalUsage         = putStr $ showModeUsage $ mainmode addonDisplayNames
-    generalHelp          = putStr $ showModeHelp $ mainmode addonDisplayNames
+    printUsage           = putStr $ showModeUsage $ mainmode addonDisplayNames
+    printHelp            = putStr $ showModeHelp  $ mainmode addonDisplayNames
     badCommandError      = error' ("command "++rawcmd++" is not recognized, run with no command to see a list") >> exitFailure
     hasShortHelp args    = any (`elem` args) ["-h"]
     hasLongHelp args     = any (`elem` args) ["--help"]
@@ -265,15 +267,15 @@ main = do
   let
     runHledgerCommand
       -- high priority flags and situations. --help should be highest priority.
-      | hasShortHelp argsbeforecmd = dbgIO "" "-h before command, showing general usage" >> generalUsage
-      | hasLongHelp argsbeforecmd = dbgIO "" "--help before command, showing general help" >> generalHelp
+      | hasShortHelp argsbeforecmd = dbgIO "" "-h before command, showing general usage" >> printUsage
+      | hasLongHelp  argsbeforecmd = dbgIO "" "--help before command, showing general help" >> printHelp
       | 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" >> generalUsage
+      | isNullCommand            = dbgIO "" "no command, showing general help" >> printUsage
       | isBadCommand             = badCommandError
 
       -- internal commands
@@ -288,6 +290,7 @@ main = do
       | cmd == "register"        = withJournalDo opts register        `orShowUsage` registermode `orShowHelp` registermode
       | cmd == "stats"           = withJournalDo opts stats           `orShowUsage` statsmode `orShowHelp` statsmode
       | cmd == "test"            = test' opts                         `orShowUsage` testmode `orShowHelp` testmode
+      | cmd == "help"            = help' opts                         `orShowUsage` helpmode `orShowHelp` helpmode
 
       -- an external command
       | isExternalCommand = do

hledger/hledger.cabal

@@ -110,6 +110,7 @@ library
       Hledger.Cli
       Hledger.Cli.Main
       Hledger.Cli.CliOptions
+      Hledger.Cli.DocFiles
       Hledger.Cli.Tests
       Hledger.Cli.Utils
       Hledger.Cli.Version
@@ -118,6 +119,7 @@ library
       Hledger.Cli.Balance
       Hledger.Cli.Balancesheet
       Hledger.Cli.Cashflow
+      Hledger.Cli.Help
       Hledger.Cli.Histogram
       Hledger.Cli.Incomestatement
       Hledger.Cli.Print