feat: commands, an explicit command to show the commands list; refactor

hledger/Hledger/Cli.hs

@@ -108,7 +108,6 @@ import System.Console.CmdArgs.Explicit
 import System.Console.CmdArgs.Explicit as CmdArgsWithoutName hiding (Name)
 import System.Environment
 import System.Exit
-import System.FilePath
 import System.Process
 import Text.Megaparsec (optional, takeWhile1P, eof)
 import Text.Megaparsec.Char (char)
@@ -225,7 +224,7 @@ main = withGhcDebug' $ do
   usecolor <- useColorOnStdout
   when usecolor setupPager
   -- Search PATH for addon commands. Exclude any that match builtin command names.
-  addons <- hledgerAddons <&> filter (not . (`elem` builtinCommandNames) . dropExtension)
+  addons <- addonCommandNames
 
   ---------------------------------------------------------------
   dbgIO "\n1. Preliminary command line parsing" ()
@@ -366,6 +365,15 @@ main = withGhcDebug' $ do
     infoFlag    = boolopt "info"    rawopts
     manFlag     = boolopt "man"     rawopts
     versionFlag = boolopt "version" rawopts
+    -- ignoredopts    cmd = error' $ cmd ++ " tried to read options but is not supposed to"
+    ignoredjournal cmd = error' $ cmd ++ " tried to read the journal but is not supposed to"
+
+  -- validate opts/args more and convert to CliOpts
+  opts <- rawOptsToCliOpts rawopts >>= \opts0 -> return opts0{progstarttime_=starttime}
+  dbgIO2 "processed opts" opts
+  dbgIO "period from opts" (period_ . _rsReportOpts $ reportspec_ opts)
+  dbgIO "interval from opts" (interval_ . _rsReportOpts $ reportspec_ opts)
+  dbgIO "query from opts & args" (_rsQuery $ reportspec_ opts)
 
   -- Ensure that anything calling getArgs later will see all args, including config file args.
   -- Some things (--color, --debug, some checks in journalFinalise) are detected by unsafePerformIO,
@@ -386,32 +394,26 @@ main = withGhcDebug' $ do
     | badcmdprovided -> error' $ "command "++clicmdarg++" is not recognized, run with no command to see a list"
 
     -- 6.4. no command found, nothing else to do - show the commands list
-    | nocmdprovided -> dbgIO1 "no command, showing commands list" () >> printCommandsList prognameandversion addons
+    | nocmdprovided -> do
+        dbgIO1 "no command, showing commands list" ()
+        commands opts (ignoredjournal "commands")
 
     -- 6.5. builtin command found
     | Just (cmdmode, cmdaction) <- mbuiltincmdaction -> do
       let mmodecmdname = headMay $ modeNames cmdmode
       dbgIO1 "running builtin command mode" $ fromMaybe "" mmodecmdname
 
-      -- validate opts/args more and convert to CliOpts
-      opts <- rawOptsToCliOpts rawopts >>= \opts0 -> return opts0{progstarttime_=starttime}
-      dbgIO2 "processed opts" opts
-      dbgIO "period from opts" (period_ . _rsReportOpts $ reportspec_ opts)
-      dbgIO "interval from opts" (interval_ . _rsReportOpts $ reportspec_ opts)
-      dbgIO "query from opts & args" (_rsQuery $ reportspec_ opts)
-      let tldrpagename = maybe "hledger" (("hledger-"<>)) mmodecmdname
-
       -- run the builtin command according to its type
       if
         -- 6.5.1. help/doc flag - show command help/docs
         | helpFlag  -> runPager $ showModeUsage cmdmode ++ "\n"
-        | tldrFlag  -> runTldrForPage tldrpagename
+        | tldrFlag  -> runTldrForPage $ maybe "hledger" (("hledger-"<>)) mmodecmdname
         | infoFlag  -> runInfoForTopic "hledger" mmodecmdname
         | manFlag   -> runManForTopic "hledger"  mmodecmdname
 
         -- 6.5.2. builtin command which should not require or read the journal - run it
         | cmdname `elem` ["demo","help","test"] ->
-          cmdaction opts $ error' $ cmdname++" tried to read the journal but is not supposed to"
+          cmdaction opts (ignoredjournal cmdname)
 
         -- 6.5.3. builtin command which should create the journal if missing - do that and run it
         | cmdname `elem` ["add","import"] -> do

hledger/Hledger/Cli/CliOptions.hs

@@ -49,7 +49,6 @@ module Hledger.Cli.CliOptions (
   showModeUsage,
   withAliases,
   likelyExecutablesInPath,
-  hledgerExecutablesInPath,
 
   -- * CLI options
   CliOpts(..),
@@ -78,7 +77,6 @@ module Hledger.Cli.CliOptions (
   registerWidthsFromOpts,
 
   -- * Other utils
-  hledgerAddons,
   topicForMode,
 
 --  -- * Convenience re-exports
@@ -91,8 +89,7 @@ import qualified Control.Exception as C
 import Control.Monad (when)
 import Data.Char
 import Data.Default
-import Data.Either (isRight)
+import Data.List.Extra (intercalate, isInfixOf, nubSort)
-import Data.List.Extra (groupSortOn, intercalate, isInfixOf, nubSort)
 import qualified Data.List.NonEmpty as NE (NonEmpty, fromList, nonEmpty)
 import Data.List.Split (splitOn)
 import Data.Maybe
@@ -783,48 +780,6 @@ registerWidthsFromOpts CliOpts{width_=Just s}  =
 
 -- Other utils
 
--- | Get the sorted unique canonical names of hledger addon commands
--- found in the current user's PATH. These are used in command line
--- parsing and to display the commands list.
---
--- Canonical addon names are the filenames of hledger-* executables in
--- PATH, without the "hledger-" prefix, and without the file extension
--- except when it's needed for disambiguation (see below).
---
--- When there are exactly two versions of an executable (same base
--- name, different extensions) that look like a source and compiled
--- pair (one has .exe, .com, or no extension), the source version will
--- be excluded (even if it happens to be newer). When there are three
--- or more versions (or two versions that don't look like a
--- source/compiled pair), they are all included, with file extensions
--- intact.
---
-hledgerAddons :: IO [String]
-hledgerAddons = do
-  -- past bug generator
-  as1 <- hledgerExecutablesInPath                     -- ["hledger-check","hledger-check-dates","hledger-check-dates.hs","hledger-check.hs","hledger-check.py"]
-  let as2 = map stripPrognamePrefix as1               -- ["check","check-dates","check-dates.hs","check.hs","check.py"]
-  let as3 = groupSortOn takeBaseName as2              -- [["check","check.hs","check.py"],["check-dates","check-dates.hs"]]
-  let as4 = concatMap dropRedundantSourceVersion as3  -- ["check","check.hs","check.py","check-dates"]
-  return as4
-
-stripPrognamePrefix = drop (length progname + 1)
-
-dropRedundantSourceVersion [f,g]
-  | map toLower (takeExtension f) `elem` compiledExts = [f]
-  | map toLower (takeExtension g) `elem` compiledExts = [g]
-dropRedundantSourceVersion fs = fs
-
-compiledExts = ["",".com",".exe"]
-
--- | Get the sorted unique filenames of all hledger-* executables in
--- the current user's PATH. These are files in any of the PATH directories,
--- named hledger-*, with either no extension (and no periods in the name)
--- or one of the addonExtensions.
--- We do not currently filter out non-file objects or files without execute permission.
-hledgerExecutablesInPath :: IO [String]
-hledgerExecutablesInPath = filter isHledgerExeName <$> likelyExecutablesInPath
-
 -- None of https://hackage.haskell.org/package/directory-1.3.8.1/docs/System-Directory.html#g:5
 -- do quite what we need (find all the executables in PATH with a filename prefix).
 -- | Get all sorted unique filenames in the current user's PATH.
@@ -845,39 +800,6 @@ likelyExecutablesInPath = do
 -- return exes''
 -- where isExecutable f = getPermissions f >>= (return . executable)
 
-isHledgerExeName :: String -> Bool
-isHledgerExeName = isRight . parsewith hledgerexenamep . T.pack
-    where
-      hledgerexenamep = do
-        _ <- string $ T.pack progname
-        _ <- char '-'
-        _ <- some $ noneOf ['.']
-        optional (string "." >> choice' (map (string . T.pack) addonExtensions))
-        eof
-
--- stripAddonExtension :: String -> String
--- stripAddonExtension = regexReplace re "" where re = "\\.(" ++ intercalate "|" addonExtensions ++ ")$"
-
-addonExtensions :: [String]
-addonExtensions =
-  ["bat"
-  ,"com"
-  ,"exe"
-  ,"hs"
-  ,"js"
-  ,"lhs"
-  ,"lua"
-  ,"php"
-  ,"pl"
-  ,"py"
-  ,"rb"
-  ,"rkt"
-  ,"sh"
-  ,"osh"
-  ,"ysh"
-  -- ,""
-  ]
-
 getEnvSafe :: String -> IO String
 getEnvSafe v = getEnv v `C.catch` (\(_::C.IOException) -> return "") -- XXX should catch only isDoesNotExistError e
 

hledger/Hledger/Cli/Commands.hs

@@ -15,11 +15,13 @@ the export list, the import list, builtinCommands, commandsList.
 {-# LANGUAGE TemplateHaskell #-}
 
 module Hledger.Cli.Commands (
-   testcmd
+   commands
+  ,testcmd
   ,builtinCommands
   ,builtinCommandNames
+  ,addonCommandNames
+  ,knownAddonCommandNames
   ,findBuiltinCommand
-  ,knownAddonCommands
   ,knownCommands
   ,printCommandsList
   ,tests_Hledger_Cli
@@ -52,17 +54,21 @@ module Hledger.Cli.Commands (
 ) 
 where
 
-import Data.Char (isAlphaNum, isSpace)
+import Data.Char (isAlphaNum, isSpace, toLower)
+import Data.Either (isRight)
 import Data.List
-import Data.List.Extra (nubSort)
+import Data.List.Extra (groupSortOn, nubSort)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Calendar
 import Safe (headErr)
 import String.ANSI
-import System.Environment (withArgs)
 import System.Console.CmdArgs.Explicit as C
+import System.Environment (withArgs)
+import System.FilePath (dropExtension, takeBaseName, takeExtension)
 import Test.Tasty (defaultMain)
+import Text.Megaparsec
+import Text.Megaparsec.Char
 
 import Hledger
 import Hledger.Cli.CliOptions
@@ -96,6 +102,7 @@ import Hledger.Cli.Commands.Run
 import Hledger.Cli.Commands.Stats
 import Hledger.Cli.Commands.Tags
 import Hledger.Cli.Utils (tests_Cli_Utils)
+import Data.Functor ((<&>))
 
 -- | The cmdargs subcommand mode (for command-line parsing)
 -- and IO action (for doing the command's work) for each builtin command.
@@ -113,6 +120,7 @@ builtinCommands = [
   ,(checkmode              , check)
   ,(closemode              , close)
   ,(codesmode              , codes)
+  ,(commandsmode           , commands)
   ,(commoditiesmode        , commodities)
   ,(demomode               , demo)
   ,(descriptionsmode       , descriptions)
@@ -191,7 +199,7 @@ accent
 -- 
 commandsList :: String -> [String] -> [String]
 commandsList progversion othercmds =
-  map (bold'.accent) _banner_smslant ++ 
+  map (bold'.accent) _banner_smslant ++   -- XXX not showing bold, why ?
   [
   -- Keep the following synced with:
   --  commands.m4
@@ -202,17 +210,18 @@ commandsList progversion othercmds =
    "-------------------------------------------------------------------------------"
   ,progversion
   ,"Usage: hledger COMMAND [OPTIONS] [-- ADDONOPTIONS]"
-  ,"Commands (builtins + addons):"
+  -- ,"Commands (builtins + addons):"  -- XXX adapt for commands --builtin
+  ,"Commands:"
   ,""
     -----------------------------------------80-------------------------------------
   ,bold' "HELP (docs, demos..)"
-  ," (no arguments)           show this commands list"
+  ," commands                 show the commands list (default)"
-  ," -h [COMMAND]             show command line help"
-  ," --tldr [COMMAND]         show command examples with tldr"
-  ," --info [COMMAND]         show the hledger manual with info"
-  ," --man  [COMMAND]         show the hledger manual with man"
-  ," help [-i|-m|-p] [TOPIC]  show any topic in the hledger manual"
   ," demo [DEMO]              show brief demos in the terminal"
+  ," help [-i|-m|-p] [TOPIC]  show the hledger manual with info/man/pager"
+  ," --tldr    [COMMAND]      show command examples   [for command] with tldr"
+  ," --help/-h [COMMAND]      show command line help  [for command]"
+  ," --info    [COMMAND]      show the hledger manual [for command] with info"
+  ," --man     [COMMAND]      show the hledger manual [for command] with man"
   ,"                          more help: https://hledger.org"
   ,""
     -----------------------------------------80-------------------------------------
@@ -301,18 +310,63 @@ commandsListExtractCommands addonsonly l =
   , not $ "https://" `isInfixOf` line
   , let cmdname:_ = words line
   ]
-  -- KEEP SYNCED WITH commandsList.
+  -- Keep synced with commandsList.
+
+commandsmode =
+  hledgerCommandMode
+    $(embedFileRelative "Hledger/Cli/Commands/Commands.txt")
+    [flagNone ["builtin"] (setboolopt "builtin")  "show only builtin commands, not addons"
+    ]
+    [(helpflagstitle, helpflags)]
+    []
+    -- flagReq  ["debug"]    (\s opts -> Right $ setopt "debug" s opts) "[N]" "show debug output (levels 1-9, default: 1)"
+
+    ([], Nothing)
+
+-- | Display the commands list.
+commands :: CliOpts -> Journal -> IO ()
+commands opts _ = do
+  addons <- if boolopt "builtin" (rawopts_ opts) then return [] else addonCommandNames
+  printCommandsList prognameandversion addons
+
+{- | Print the commands list, with a pager if appropriate, customising the
+commandsList template above with the given version string and the installed addons.
+Uninstalled known addons will be removed from the list,
+installed known addons will have the + prefix removed,
+and installed unknown addons will be added under Misc.
+-}
+printCommandsList :: String -> [String] -> IO ()
+printCommandsList progversion installedaddons =
+  seq (length $ dbg8 "uninstalledknownaddons" uninstalledknownaddons) $ -- for debug output
+    seq (length $ dbg8 "installedknownaddons" installedknownaddons) $
+      seq (length $ dbg8 "installedunknownaddons" installedunknownaddons) $
+        runPager $
+          unlines $
+            map unplus $
+              filter (not . isuninstalledaddon) $
+                commandsList progversion installedunknownaddons
+ where
+  knownaddons = knownAddonCommandNames
+  uninstalledknownaddons = knownaddons \\ installedaddons
+  installedknownaddons = knownaddons `intersect` installedaddons
+  installedunknownaddons = installedaddons \\ knownaddons
+  unplus ('+' : cs) = ' ' : cs
+  unplus s = s
+  isuninstalledaddon =
+    \case
+      ('+' : l)
+        | cmd `notElem` installedaddons ->
+            dbg9With (const $ "hiding uninstalled addon: " <> cmd) $
+              True
+       where
+        cmd = takeWhile (not . isSpace) l
+      _ -> False
 
 -- | Canonical names of all commands which have a slot in the commands list, in alphabetical order.
 -- These include the builtin commands and the known addon commands.
 knownCommands :: [String]
 knownCommands = nubSort . commandsListExtractCommands False $ commandsList progname []
 
--- | Canonical names of the known addon commands which have a slot in the commands list,
--- in alphabetical order.
-knownAddonCommands :: [String]
-knownAddonCommands = nubSort . commandsListExtractCommands True $ commandsList progname []
-
 -- | All names and aliases of the builtin commands.
 builtinCommandNames :: [String]
 builtinCommandNames = concatMap (modeNames . fst) builtinCommands
@@ -321,33 +375,91 @@ builtinCommandNames = concatMap (modeNames . fst) builtinCommands
 findBuiltinCommand :: String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ()) 
 findBuiltinCommand cmdname = find (elem cmdname . modeNames . fst) builtinCommands 
 
--- | Print the commands list, with a pager if appropriate, customising the
+{- | Canonical names of the known addon commands which have a slot in the commands list,
--- commandsList template above with the given version string and the installed addons.
+in alphabetical order.
--- Uninstalled known addons will be removed from the list,
+-}
--- installed known addons will have the + prefix removed,
+knownAddonCommandNames :: [String]
--- and installed unknown addons will be added under Misc.
+knownAddonCommandNames = nubSort . commandsListExtractCommands True $ commandsList progname []
-printCommandsList :: String -> [String] -> IO ()
-printCommandsList progversion installedaddons =
-  seq (length $ dbg8 "uninstalledknownaddons" uninstalledknownaddons) $  -- for debug output
-  seq (length $ dbg8 "installedknownaddons"   installedknownaddons)   $
-  seq (length $ dbg8 "installedunknownaddons" installedunknownaddons) $
-  runPager $ unlines $ map unplus $ filter (not.isuninstalledaddon) $
-    commandsList progversion installedunknownaddons
-  where
-    knownaddons = knownAddonCommands
-    uninstalledknownaddons  = knownaddons \\ installedaddons
-    installedknownaddons    = knownaddons `intersect` installedaddons
-    installedunknownaddons  = installedaddons \\ knownaddons
-    unplus ('+':cs) = ' ':cs
-    unplus s = s
-    isuninstalledaddon =
-      \case
-        ('+':l) | cmd `notElem` installedaddons ->
-                  dbg9With (const $ "hiding uninstalled addon: "<>cmd) $
-                  True where cmd = takeWhile (not . isSpace) l
-        _ -> False
 
--- The test command is defined here for easy access to other modules' tests.
+-- Search PATH for names of addon commands, that aren't shadowed by builtin commands.
+addonCommandNames :: IO [String]
+addonCommandNames = installedAddonCommandNames <&> filter (not . (`elem` builtinCommandNames) . dropExtension)
+
+-- | Get the sorted unique canonical names of hledger addon commands
+-- found in the current user's PATH. These are used in command line
+-- parsing and to display the commands list.
+--
+-- Canonical addon names are the filenames of hledger-* executables in
+-- PATH, without the "hledger-" prefix, and without the file extension
+-- except when it's needed for disambiguation (see below).
+--
+-- When there are exactly two versions of an executable (same base
+-- name, different extensions) that look like a source and compiled
+-- pair (one has .exe, .com, or no extension), the source version will
+-- be excluded (even if it happens to be newer). When there are three
+-- or more versions (or two versions that don't look like a
+-- source/compiled pair), they are all included, with file extensions
+-- intact.
+--
+installedAddonCommandNames :: IO [String]
+installedAddonCommandNames = do
+  -- past bug generator
+  as1 <- hledgerExecutablesInPath                     -- ["hledger-check","hledger-check-dates","hledger-check-dates.hs","hledger-check.hs","hledger-check.py"]
+  let as2 = map stripPrognamePrefix as1               -- ["check","check-dates","check-dates.hs","check.hs","check.py"]
+  let as3 = groupSortOn takeBaseName as2              -- [["check","check.hs","check.py"],["check-dates","check-dates.hs"]]
+  let as4 = concatMap dropRedundantSourceVersion as3  -- ["check","check.hs","check.py","check-dates"]
+  return as4
+
+stripPrognamePrefix = drop (length progname + 1)
+
+dropRedundantSourceVersion [f,g]
+  | map toLower (takeExtension f) `elem` compiledExts = [f]
+  | map toLower (takeExtension g) `elem` compiledExts = [g]
+dropRedundantSourceVersion fs = fs
+
+compiledExts = ["",".com",".exe"]
+
+-- | Get the sorted unique filenames of all hledger-* executables in
+-- the current user's PATH. These are files in any of the PATH directories,
+-- named hledger-*, with either no extension (and no periods in the name)
+-- or one of the addonExtensions.
+-- We do not currently filter out non-file objects or files without execute permission.
+hledgerExecutablesInPath :: IO [String]
+hledgerExecutablesInPath = filter isHledgerExeName <$> likelyExecutablesInPath
+
+isHledgerExeName :: String -> Bool
+isHledgerExeName = isRight . parsewith hledgerexenamep . T.pack
+ where
+  hledgerexenamep = do
+    _ <- string $ T.pack progname
+    _ <- char '-'
+    _ <- some $ noneOf ['.']
+    optional (string "." >> choice' (map (string . T.pack) addonExtensions))
+    eof
+
+-- stripAddonExtension :: String -> String
+-- stripAddonExtension = regexReplace re "" where re = "\\.(" ++ intercalate "|" addonExtensions ++ ")$"
+
+addonExtensions :: [String]
+addonExtensions =
+  ["bat"
+  ,"com"
+  ,"exe"
+  ,"hs"
+  ,"js"
+  ,"lhs"
+  ,"lua"
+  ,"php"
+  ,"pl"
+  ,"py"
+  ,"rb"
+  ,"rkt"
+  ,"sh"
+  ,"osh"
+  ,"ysh"
+  ]
+
+-- The test command is also defined here for easy access to other modules' tests.
 
 testmode = hledgerCommandMode
   $(embedFileRelative "Hledger/Cli/Commands/Test.txt")

hledger/Hledger/Cli/Commands/Commands.md

@@ -0,0 +1,3 @@
+## commands
+
+Show the hledger commands list.

hledger/Hledger/Cli/Commands/Commands.txt

@@ -0,0 +1,3 @@
+commands
+
+Show the hledger commands list.

hledger/hledger.cabal

@@ -69,6 +69,7 @@ extra-source-files:
     Hledger/Cli/Commands/Check.txt
     Hledger/Cli/Commands/Close.txt
     Hledger/Cli/Commands/Codes.txt
+    Hledger/Cli/Commands/Commands.txt
     Hledger/Cli/Commands/Commodities.txt
     Hledger/Cli/Commands/Demo.txt
     Hledger/Cli/Commands/Descriptions.txt

hledger/package.yaml

@@ -68,6 +68,7 @@ extra-source-files:
 - Hledger/Cli/Commands/Check.txt
 - Hledger/Cli/Commands/Close.txt
 - Hledger/Cli/Commands/Codes.txt
+- Hledger/Cli/Commands/Commands.txt
 - Hledger/Cli/Commands/Commodities.txt
 - Hledger/Cli/Commands/Demo.txt
 - Hledger/Cli/Commands/Descriptions.txt

hledger/test/commands.test

@@ -0,0 +1,13 @@
+# * commands command
+
+# ** 0. Print the commands list by default.
+$ hledger
+> /Commands:/
+
+# ** 0. Print the commands list with the commands command specified.
+#$ hledger commands
+#> /Commands /
+
+# ** 0. Print the commands list showing only builtin commands.
+$ hledger commands --builtin
+> /Commands:$/