cli: refactor: new Commands module

Builtin commands are now gathered more tightly in a single module,
Hledger.Cli.Commands, reducing duplication and facilitating change.

The tests command was difficult and has been dropped for now.

The obsolete convert/info/man commands have been dropped.

cli: refactor: a proper commands list, better Main/Commands separation

The legacy "convert" command has been dropped.

The activity command's module is now named consistently.

hledger-ui/Hledger/UI/AccountsScreen.hs

@@ -29,7 +29,8 @@ import System.Console.ANSI
 import System.FilePath (takeFileName)
 
 import Hledger
-import Hledger.Cli hiding (progname,prognameandversion,green)
+import Hledger.Cli hiding (progname,prognameandversion)
+import Hledger.Cli.Add (add)
 import Hledger.UI.UIOptions
 import Hledger.UI.UITypes
 import Hledger.UI.UIState

hledger-ui/Hledger/UI/ErrorScreen.hs

@@ -19,7 +19,7 @@ import Data.Time.Calendar (Day)
 import Graphics.Vty (Event(..),Key(..))
 import Text.Megaparsec.Compat
 
-import Hledger.Cli hiding (progname,prognameandversion,green)
+import Hledger.Cli hiding (progname,prognameandversion)
 import Hledger.UI.UIOptions
 import Hledger.UI.UITypes
 import Hledger.UI.UIState

hledger-ui/Hledger/UI/Main.hs

@@ -40,7 +40,7 @@ import Control.Concurrent.Chan (newChan, writeChan)
 #endif
 
 import Hledger
-import Hledger.Cli hiding (progname,prognameandversion,green)
+import Hledger.Cli hiding (progname,prognameandversion)
 import Hledger.UI.UIOptions
 import Hledger.UI.UITypes
 import Hledger.UI.UIState (toggleHistorical)

hledger-ui/Hledger/UI/RegisterScreen.hs

@@ -30,7 +30,8 @@ import System.Console.ANSI
 
 
 import Hledger
-import Hledger.Cli hiding (progname,prognameandversion,green)
+import Hledger.Cli hiding (progname,prognameandversion)
+import Hledger.Cli.Add (add)
 import Hledger.UI.UIOptions
 -- import Hledger.UI.Theme
 import Hledger.UI.UITypes

hledger-ui/Hledger/UI/TransactionScreen.hs

@@ -20,7 +20,7 @@ import Brick.Widgets.List (listMoveTo)
 import Brick.Widgets.Border (borderAttr)
 
 import Hledger
-import Hledger.Cli hiding (progname,prognameandversion,green)
+import Hledger.Cli hiding (progname,prognameandversion)
 import Hledger.UI.UIOptions
 -- import Hledger.UI.Theme
 import Hledger.UI.UITypes

hledger-web/Handler/AddForm.hs

@@ -20,9 +20,9 @@ import Data.Time.Calendar
 import Text.Megaparsec.Compat (digitChar, eof, some, string, runParser, ParseError, MPErr)
 
 import Hledger.Utils
-import Hledger.Data hiding (num)
+import Hledger.Data
 import Hledger.Read
-import Hledger.Cli hiding (num)
+import Hledger.Cli.Add (appendToJournalFileOrStdout)
 
 
 -- Part of the data required from the add form.

hledger/Hledger/Cli.hs

@@ -10,21 +10,8 @@ adds some more which are easier to define here.
 {-# LANGUAGE OverloadedStrings #-}
 
 module Hledger.Cli (
-                     module Hledger.Cli.Accounts,
-                     module Hledger.Cli.Add,
-                     module Hledger.Cli.Balance,
-                     module Hledger.Cli.Balancesheet,
-                     module Hledger.Cli.Balancesheetequity,
-                     module Hledger.Cli.Cashflow,
-                     module Hledger.Cli.Help,
-                     module Hledger.Cli.Histogram,
-                     module Hledger.Cli.Incomestatement,
-                     module Hledger.Cli.Info,
-                     module Hledger.Cli.Man,
-                     module Hledger.Cli.Print,
-                     module Hledger.Cli.Register,
-                     module Hledger.Cli.Stats,
                      module Hledger.Cli.CliOptions,
+                     module Hledger.Cli.Commands,
                      module Hledger.Cli.DocFiles,
                      module Hledger.Cli.Utils,
                      module Hledger.Cli.Version,
@@ -41,21 +28,8 @@ import System.Console.CmdArgs.Explicit hiding (Name) -- don't clash with hledger
 import Test.HUnit
 
 import Hledger
-import Hledger.Cli.Accounts
-import Hledger.Cli.Add
-import Hledger.Cli.Balance
-import Hledger.Cli.Balancesheet
-import Hledger.Cli.Balancesheetequity
-import Hledger.Cli.Cashflow
-import Hledger.Cli.Histogram
-import Hledger.Cli.Help
-import Hledger.Cli.Incomestatement
-import Hledger.Cli.Info
-import Hledger.Cli.Man
-import Hledger.Cli.Print
-import Hledger.Cli.Register
-import Hledger.Cli.Stats
 import Hledger.Cli.CliOptions
+import Hledger.Cli.Commands
 import Hledger.Cli.DocFiles
 import Hledger.Cli.Utils
 import Hledger.Cli.Version
@@ -65,16 +39,8 @@ tests_Hledger_Cli :: Test
 tests_Hledger_Cli = TestList
  [
     tests_Hledger
-   -- ,tests_Hledger_Cli_Add
-   ,tests_Hledger_Cli_Balance
-   ,tests_Hledger_Cli_Balancesheet
-   ,tests_Hledger_Cli_Cashflow
-   -- ,tests_Hledger_Cli_Histogram
-   ,tests_Hledger_Cli_Incomestatement
    ,tests_Hledger_Cli_CliOptions
-   -- ,tests_Hledger_Cli_Print
+   ,tests_Hledger_Cli_Commands
-   ,tests_Hledger_Cli_Register
-   -- ,tests_Hledger_Cli_Stats
 
 
    ,"apply account directive" ~: 

hledger/Hledger/Cli/Activity.hs

@@ -1,10 +1,10 @@
 {-|
 
-Print a histogram report. (The "activity" command).
+Print a bar chart of posting activity per day, or other report interval. 
 
 -}
 
-module Hledger.Cli.Histogram
+module Hledger.Cli.Activity
 where
 
 import Data.List
@@ -33,10 +33,9 @@ activitymode = (defCommandMode $ ["activity"] ++ aliases) {
 barchar :: Char
 barchar = '*'
 
--- | Print a histogram of some statistic per report interval, such as
+-- | Print a bar chart of number of postings per report interval.
--- number of postings per day.
+activity :: CliOpts -> Journal -> IO ()
-histogram :: CliOpts -> Journal -> IO ()
+activity CliOpts{reportopts_=ropts} j = do
-histogram CliOpts{reportopts_=ropts} j = do
   d <- getCurrentDay
   putStr $ showHistogram ropts (queryFromOpts d ropts) j
 

hledger/Hledger/Cli/Add.hs

@@ -5,7 +5,12 @@ A history-aware add command to help with data entry.
 {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-unused-do-bind #-}
 {-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, RecordWildCards, TypeOperators, FlexibleContexts, OverloadedStrings #-}
 
-module Hledger.Cli.Add
+module Hledger.Cli.Add (
+   addmode
+  ,add
+  ,appendToJournalFileOrStdout
+  ,transactionsSimilarTo
+)
 where
 
 import Prelude ()

hledger/Hledger/Cli/Commands.hs

@@ -0,0 +1,163 @@
+{-|
+hledger's built-in commands, and helpers for printing the commands list.
+-}
+
+{-# LANGUAGE QuasiQuotes #-}
+
+module Hledger.Cli.Commands (
+   findCommand
+  ,builtinCommands
+  ,builtinCommandNames
+  ,printCommandsList
+  ,tests_Hledger_Cli_Commands
+) 
+where
+
+import Data.String.Here
+import Data.List
+import Data.List.Split (splitOn)
+import System.Console.CmdArgs.Explicit as C
+import Test.HUnit
+
+import Hledger.Cli.Accounts
+import Hledger.Cli.Activity
+import Hledger.Cli.Add
+import Hledger.Cli.Balance
+import Hledger.Cli.Balancesheet
+import Hledger.Cli.Balancesheetequity
+import Hledger.Cli.Cashflow
+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.Data
+import Hledger.Utils (regexReplace)
+
+
+-- | The cmdargs subcommand mode and IO action for each builtin command.
+-- Command actions take parsed CLI options and a (lazy) finalised journal.
+builtinCommands :: [(Mode RawOpts, CliOpts -> Journal -> IO ())]
+builtinCommands = [
+   (accountsmode           , accounts) 
+  ,(activitymode           , activity) 
+  ,(addmode                , add) 
+  ,(balancemode            , balance) 
+  ,(balancesheetmode       , balancesheet) 
+  ,(balancesheetequitymode , balancesheetequity) 
+  ,(cashflowmode           , cashflow) 
+  ,(helpmode               , help') 
+  ,(incomestatementmode    , incomestatement) 
+  ,(printmode              , print') 
+  ,(registermode           , register) 
+  ,(statsmode              , stats) 
+  ]
+
+-- | All names and aliases of builtin commands.
+builtinCommandNames :: [String]
+builtinCommandNames = concatMap (modeNames . fst) builtinCommands
+
+-- | Look up a builtin command's mode and action by exact command name or alias. 
+findCommand :: String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ()) 
+findCommand cmdname = find (elem cmdname . modeNames . fst) builtinCommands 
+
+-- | A template for the commands list, containing entries (indented lines)
+-- for all currently known builtin and addon commands.
+-- These will be filtered based on the commands found at runtime,  
+-- except those beginning with "hledger", which are not filtered. 
+-- OTHERCMDS is replaced with an entry for each unknown addon command found. 
+-- COUNT is replaced with the number of commands found.
+--  
+-- The command descriptions here should be kept synced with 
+-- each command's builtin help and with hledger manual's command list.
+--
+commandsListTemplate :: String
+commandsListTemplate = [here|Commands available (COUNT):
+
+Standard reports:
+ accounts             show chart of accounts
+ balancesheet (bs)    show a balance sheet
+ balancesheetequity (bse)    show a balance sheet with equity
+ cashflow (cf)        show a cashflow statement
+ incomestatement (is) show an income statement
+ transactions (txns)  show transactions in some account
+
+General reporting:
+ activity             show a bar chart of posting counts per interval
+ balance (bal)        show accounts and balances
+ budget               add automated postings/txns/bucket accts (experimental)
+ chart                generate simple balance pie charts (experimental)
+ check                check more powerful balance assertions
+ check-dates          check transactions are ordered by date
+ check-dupes          check for accounts with the same leaf name
+ irr                  calculate internal rate of return of an investment
+ prices               show market price records
+ print                show transaction journal entries
+ print-unique         show only transactions with unique descriptions
+ register (reg)       show postings and running total
+ register-match       show best matching transaction for a description
+ stats                show some journal statistics
+
+Interfaces:
+ add                  console ui for adding transactions
+ api                  web api server
+ iadd                 curses ui for adding transactions
+ ui                   curses ui
+ web                  web ui
+
+Misc:
+ autosync             download/deduplicate/convert OFX data
+ equity               generate transactions to zero & restore account balances
+ interest             generate interest transactions
+ rewrite              add automated postings to certain transactions
+ test                 run some self tests
+OTHERCMDS
+Help:
+ help                 show any of the hledger manuals in various formats
+ hledger CMD -h       show command usage
+ hledger -h           show general usage
+|]
+
+-- | Print the commands list, modifying the template above based on
+-- the currently available addons. Missing addons will be removed, and
+-- extra addons will be added under Misc.
+printCommandsList :: [String] -> IO ()
+printCommandsList addonsFound = putStr commandsList
+  where
+    commandsFound = builtinCommandNames ++ addonsFound
+    unknownCommandsFound = addonsFound \\ knownCommands
+
+    adjustline l | " hledger " `isPrefixOf` l = [l]
+    adjustline (' ':l) | not $ w `elem` commandsFound = []
+      where w = takeWhile (not . (`elem` "| ")) l
+    adjustline l = [l]
+
+    commandsList1 =
+      regexReplace "OTHERCMDS" (unlines [' ':w | w <- unknownCommandsFound]) $
+      unlines $ concatMap adjustline $ lines commandsListTemplate
+
+    commandsList =
+      regexReplace "COUNT" (show $ length $ commandsFromCommandsList commandsList1)
+      commandsList1
+
+knownCommands :: [String]
+knownCommands = sort $ commandsFromCommandsList commandsListTemplate
+
+-- | Extract the command names from a commands list like the above:
+-- the first word (or words separated by |) of lines beginning with a space.
+commandsFromCommandsList :: String -> [String]
+commandsFromCommandsList s = concatMap (splitOn "|") [w | ' ':l <- lines s, let w:_ = words l]
+
+tests_Hledger_Cli_Commands :: Test
+tests_Hledger_Cli_Commands = TestList [
+  -- ,tests_Hledger_Cli_Add
+   tests_Hledger_Cli_Balance
+  ,tests_Hledger_Cli_Balancesheet
+  ,tests_Hledger_Cli_Cashflow
+  -- ,tests_Hledger_Cli_Histogram
+  ,tests_Hledger_Cli_Incomestatement
+  -- ,tests_Hledger_Cli_Print
+  ,tests_Hledger_Cli_Register
+  -- ,tests_Hledger_Cli_Stats
+  ]

hledger/Hledger/Cli/Help.hs

@@ -27,6 +27,7 @@ import System.Environment
 import System.IO
 
 import Hledger.Data.RawOptions
+import Hledger.Data.Types
 import Hledger.Cli.CliOptions
 import Hledger.Cli.DocFiles
 --import Hledger.Utils.Debug
@@ -52,8 +53,8 @@ helpmode = (defCommandMode $ ["help"] ++ aliases) {
 -- You can select a docs viewer with one of the `--info`, `--man`, `--pager`, `--cat` flags.
 -- Otherwise it will use the first available of: info, man, $PAGER, less, stdout
 -- (and always stdout if output is non-interactive). 
-help' :: CliOpts -> IO ()
+help' :: CliOpts -> Journal -> IO ()
-help' opts = do
+help' opts _ = do
   exes <- likelyExecutablesInPath
   pagerprog <- fromMaybe "less" <$> lookupEnv "PAGER"
   interactive <- hIsTerminalDevice stdout

hledger/Hledger/Cli/Info.hs

@@ -1,41 +0,0 @@
-{-|
-
-The info command.
-
-|-}
-
-module Hledger.Cli.Info (
-
-   infomode
-  ,info'
-
-  ) 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
-
-infomode = (defCommandMode $ ["info"] ++ aliases) {
-  modeHelp = "show any of the hledger manuals with info" `withAliases` aliases
- ,modeGroupFlags = Group {
-     groupUnnamed = []
-    ,groupHidden = []
-    ,groupNamed = []
-    }
- }
-  where aliases = []
-
--- | Try to use info to view the selected manual.
-info' :: CliOpts -> IO ()
-info' opts = do
-  let args = listofstringopt "args" $ rawopts_ opts
-  case args of
-    []    -> putStrLn $
-             "Choose a topic, eg: hledger info cli\n" ++
-             intercalate ", " docTopics
-    topic:_ -> runInfoForTopic topic

hledger/Hledger/Cli/Main.hs

@@ -40,11 +40,9 @@ See "Hledger.Data.Ledger" for more examples.
 
 module Hledger.Cli.Main where
 
--- import Control.Monad
 import Data.Char (isDigit)
-import Data.String.Here
 import Data.List
-import Data.List.Split (splitOn)
+import Data.String.Here
 import Safe
 import System.Console.CmdArgs.Explicit as C
 import System.Environment
@@ -54,31 +52,16 @@ import System.Process
 import Text.Printf
 
 import Hledger (ensureJournalFileExists)
-import Hledger.Cli.Add
-import Hledger.Cli.Accounts
-import Hledger.Cli.Balance
-import Hledger.Cli.Balancesheet
-import Hledger.Cli.Balancesheetequity
-import Hledger.Cli.Cashflow
-import Hledger.Cli.Help
-import Hledger.Cli.Histogram
-import Hledger.Cli.Incomestatement
-import Hledger.Cli.Info
-import Hledger.Cli.Man
-import Hledger.Cli.Print
-import Hledger.Cli.Register
-import Hledger.Cli.Stats
 import Hledger.Cli.CliOptions
-import Hledger.Cli.Tests
+import Hledger.Cli.Commands
 import Hledger.Cli.Utils
 import Hledger.Cli.Version
 import Hledger.Data.Dates (getCurrentDay)
-import Hledger.Data.RawOptions (RawOpts)
 import Hledger.Reports.ReportOptions (period_, interval_, queryFromOpts)
 import Hledger.Utils
 
 
--- | The overall cmdargs mode describing command-line options for hledger.
+-- | The overall cmdargs mode describing hledger's command-line options and subcommands.
 mainmode addons = defMode {
   modeNames = [progname ++ " [CMD]"]
  ,modeArgs = ([], Just $ argsFlag "[ARGS]")
@@ -91,24 +74,7 @@ mainmode addons = defMode {
    ,groupNamed = [
      ]
     -- subcommands handled but not shown in the help:
-   ,groupHidden = [
+   ,groupHidden = map fst builtinCommands ++ map quickAddonCommandMode addons
-      oldconvertmode
-     ,accountsmode
-     ,activitymode
-     ,addmode
-     ,balancemode
-     ,balancesheetmode
-     ,balancesheetequitymode
-     ,cashflowmode
-     ,helpmode
-     ,incomestatementmode
-     ,infomode
-     ,manmode
-     ,printmode
-     ,registermode
-     ,statsmode
-     ,testmode
-     ] ++ map quickAddonCommandMode addons
    }
  ,modeGroupFlags = Group {
      -- flags in named groups:
@@ -134,171 +100,7 @@ PROGNAME help [MANUAL]           show any of the hledger manuals in various form
 |]
  }
 
-oldconvertmode = (defCommandMode ["convert"]) {
+-- | Let's go!
-  modeValue = [("command","convert")]
- ,modeHelp = "convert is no longer needed, just use -f FILE.csv"
- ,modeArgs = ([], Just $ argsFlag "[CSVFILE]")
- ,modeGroupFlags = Group {
-     groupUnnamed = []
-    ,groupHidden = helpflags
-    ,groupNamed = []
-    }
- }
-
-builtinCommands :: [Mode RawOpts]
-builtinCommands =
-  let gs = modeGroupModes $ mainmode []
-  in concatMap snd (groupNamed gs) ++ groupUnnamed gs ++ groupHidden gs
-
-builtinCommandNames :: [String]
-builtinCommandNames = concatMap modeNames builtinCommands
-
--- | Parse hledger CLI options from these command line arguments and
--- add-on command names, or raise any error.
-argsToCliOpts :: [String] -> [String] -> IO CliOpts
-argsToCliOpts args addons = do
-  let
-    args'        = moveFlagsAfterCommand args
-    cmdargsopts  = either usageError id $ process (mainmode addons) args'
-    cmdargsopts' = decodeRawOpts cmdargsopts
-  rawOptsToCliOpts cmdargsopts'
-
--- | A hacky workaround for cmdargs not accepting flags before the
--- subcommand name: try to detect and move such flags after the
--- command.  This allows the user to put them in either position.
--- The order of options is not preserved, but this should be ok.
---
--- Since we're not parsing flags as precisely as cmdargs here, this is
--- imperfect. We make a decent effort to:
--- - move all no-argument help/input/report flags
--- - move all required-argument help/input/report flags along with their values, space-separated or not
--- - not confuse things further or cause misleading errors.
-moveFlagsAfterCommand :: [String] -> [String]
-moveFlagsAfterCommand args = moveArgs $ ensureDebugHasArg args
-  where
-    -- quickly! make sure --debug has a numeric argument, or this all goes to hell
-    ensureDebugHasArg as =
-      case break (=="--debug") as of
-       (bs,"--debug":c:cs) | null c || not (all isDigit c) -> bs++"--debug=1":c:cs
-       (bs,"--debug":[])                                   -> bs++"--debug=1":[]
-       _                                                   -> as
-
-    -- -h ..., --version ...
-    moveArgs (f:a:as)   | isMovableNoArgFlag f                   = (moveArgs $ a:as) ++ [f]
-    -- -f FILE ..., --alias ALIAS ...
-    moveArgs (f:v:a:as) | isMovableReqArgFlag f, isValue v       = (moveArgs $ a:as) ++ [f,v]
-    -- -fFILE ..., --alias=ALIAS ...
-    moveArgs (fv:a:as)  | isMovableReqArgFlagAndValue fv         = (moveArgs $ a:as) ++ [fv]
-    -- -f(missing arg)
-    moveArgs (f:a:as)   | isMovableReqArgFlag f, not (isValue a) = (moveArgs $ a:as) ++ [f]
-    -- anything else
-    moveArgs as = as
-
-isMovableNoArgFlag a  = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` noargflagstomove
-
-isMovableReqArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` reqargflagstomove
-
-isMovableReqArgFlagAndValue ('-':'-':a:as) = case break (== '=') (a:as) of (f:fs,_:_) -> (f:fs) `elem` reqargflagstomove
-                                                                           _          -> False
-isMovableReqArgFlagAndValue ('-':shortflag:_:_) = [shortflag] `elem` reqargflagstomove
-isMovableReqArgFlagAndValue _ = False
-
-isValue "-"     = True
-isValue ('-':_) = False
-isValue _       = True
-
-flagstomove = inputflags ++ reportflags ++ helpflags
-noargflagstomove  = concatMap flagNames $ filter ((==FlagNone).flagInfo) flagstomove
-reqargflagstomove = -- filter (/= "debug") $
-                    concatMap flagNames $ filter ((==FlagReq ).flagInfo) flagstomove
-
--- | Template for the commands list. 
--- Includes an entry for all known or hypothetical builtin and addon commands; 
--- these will be filtered based on the commands found at runtime.  
--- Commands beginning with "hledger" are not filtered ("hledger -h" etc.) 
--- COUNT is replaced with the number of commands found.  
--- OTHERCMDS is replaced with an entry for each unknown addon command found. 
--- The command descriptions here should be synced with each command's builtin help 
--- and with hledger manual's command list.
-commandsListTemplate :: String
-commandsListTemplate = [here|Commands available (COUNT):
-
-Standard reports:
- accounts             show chart of accounts
- balancesheet (bs)    show a balance sheet
- balancesheetequity (bse)    show a balance sheet with equity
- cashflow (cf)        show a cashflow statement
- incomestatement (is) show an income statement
- transactions (txns)  show transactions in some account
-
-General reporting:
- activity             show a bar chart of posting counts per interval
- balance (bal)        show accounts and balances
- budget               add automated postings/txns/bucket accts (experimental)
- chart                generate simple balance pie charts (experimental)
- check                check more powerful balance assertions
- check-dates          check transactions are ordered by date
- check-dupes          check for accounts with the same leaf name
- irr                  calculate internal rate of return of an investment
- prices               show market price records
- print                show transaction journal entries
- print-unique         show only transactions with unique descriptions
- register (reg)       show postings and running total
- register-match       show best matching transaction for a description
- stats                show some journal statistics
-
-Interfaces:
- add                  console ui for adding transactions
- api                  web api server
- iadd                 curses ui for adding transactions
- ui                   curses ui
- web                  web ui
-
-Misc:
- autosync             download/deduplicate/convert OFX data
- equity               generate transactions to zero & restore account balances
- interest             generate interest transactions
- rewrite              add automated postings to certain transactions
- test                 run some self tests
-OTHERCMDS
-Help:
- help                 show any of the hledger manuals in various formats
- hledger CMD -h       show command usage
- hledger -h           show general usage
-|]
-
-knownCommands :: [String]
-knownCommands = sort $ commandsFromCommandsList commandsListTemplate
-
--- | Extract the command names from a commands list like the above:
--- the first word (or words separated by |) of lines beginning with a space.
-commandsFromCommandsList :: String -> [String]
-commandsFromCommandsList s = concatMap (splitOn "|") [w | ' ':l <- lines s, let w:_ = words l]
-
--- | Print the commands list, modifying the template above based on
--- the currently available addons. Missing addons will be removed, and
--- extra addons will be added under Misc.
-printCommandsList :: [String] -> IO ()
-printCommandsList addonsFound = putStr commandsList
-  where
-    commandsFound = builtinCommandNames ++ addonsFound
-    unknownCommandsFound = addonsFound \\ knownCommands
-
-    adjustline l | " hledger " `isPrefixOf` l = [l]
-    adjustline (' ':l) | not $ w `elem` commandsFound = []
-      where w = takeWhile (not . (`elem` "| ")) l
-    adjustline l = [l]
-
-    commandsList1 =
-      regexReplace "OTHERCMDS" (unlines [' ':w | w <- unknownCommandsFound]) $
-      unlines $ concatMap adjustline $ lines commandsListTemplate
-
-    commandsList =
-      regexReplace "COUNT" (show $ length $ commandsFromCommandsList commandsList1)
-      commandsList1
-
-
--- | Let's go.
 main :: IO ()
 main = do
 
@@ -373,24 +175,17 @@ main = do
       | isNullCommand            = dbgIO "" "no command, showing commands list" >> printCommandsList addons
       | isBadCommand             = badCommandError
 
-      -- internal commands
+      -- builtin commands
-      | cmd == "activity"        = withJournalDo opts histogram       `orShowHelp` activitymode
+      | Just (cmdmode, cmdaction) <- findCommand cmd = do 
-      | cmd == "add"             = (journalFilePathFromOpts opts >>= (ensureJournalFileExists . head) >> withJournalDo opts add) `orShowHelp` addmode
+        if cmd=="add" -- add command does extra work before reading journal
-      | cmd == "accounts"        = withJournalDo opts accounts        `orShowHelp` accountsmode
+        then (do
-      | cmd == "balance"         = withJournalDo opts balance         `orShowHelp` balancemode
+          journalFilePathFromOpts opts >>= (ensureJournalFileExists . head) 
-      | cmd == "balancesheet"    = withJournalDo opts balancesheet    `orShowHelp` balancesheetmode
+          withJournalDo opts cmdaction)
-      | cmd == "balancesheetequity"    = withJournalDo opts balancesheetequity    `orShowHelp` balancesheetequitymode
+          `orShowHelp` cmdmode
-      | cmd == "cashflow"        = withJournalDo opts cashflow        `orShowHelp` cashflowmode
+        else
-      | cmd == "incomestatement" = withJournalDo opts incomestatement `orShowHelp` incomestatementmode
+          withJournalDo opts cmdaction `orShowHelp` cmdmode
-      | cmd == "print"           = withJournalDo opts print'          `orShowHelp` printmode
-      | cmd == "register"        = withJournalDo opts register        `orShowHelp` registermode
-      | cmd == "stats"           = withJournalDo opts stats           `orShowHelp` statsmode
-      | cmd == "test"            = test' opts                         `orShowHelp` testmode
-      | cmd == "help"            = help' opts                         `orShowHelp` helpmode
-      | cmd == "man"             = man opts                           `orShowHelp` manmode
-      | cmd == "info"            = info' opts                         `orShowHelp` infomode
 
-      -- an external command
+      -- addon commands
       | isExternalCommand = do
           let externalargs = argsbeforecmd ++ filter (not.(=="--")) argsaftercmd
           let shellcmd = printf "%s-%s %s" progname cmd (unwords' externalargs) :: String
@@ -400,20 +195,69 @@ main = do
           system shellcmd >>= exitWith
 
       -- deprecated commands
-      | cmd == "convert"         = error' (modeHelp oldconvertmode) >> exitFailure
+      -- | cmd == "convert"         = error' (modeHelp oldconvertmode) >> exitFailure
 
       -- shouldn't reach here
       | otherwise                = usageError ("could not understand the arguments "++show args) >> exitFailure
 
   runHledgerCommand
 
+-- | Parse hledger CLI options from these command line arguments and
+-- add-on command names, or raise any error.
+argsToCliOpts :: [String] -> [String] -> IO CliOpts
+argsToCliOpts args addons = do
+  let
+    args'        = moveFlagsAfterCommand args
+    cmdargsopts  = either usageError id $ process (mainmode addons) args'
+    cmdargsopts' = decodeRawOpts cmdargsopts
+  rawOptsToCliOpts cmdargsopts'
 
--- tests_runHledgerCommand = [
+-- | A hacky workaround for cmdargs not accepting flags before the
---   -- "runHledgerCommand" ~: do
+-- subcommand name: try to detect and move such flags after the
---   --   let opts = defreportopts{query_="expenses"}
+-- command.  This allows the user to put them in either position.
---   --   d <- getCurrentDay
+-- The order of options is not preserved, but this should be ok.
---   --   runHledgerCommand addons opts@CliOpts{command_=cmd} args
+--
+-- Since we're not parsing flags as precisely as cmdargs here, this is
+-- imperfect. We make a decent effort to:
+-- - move all no-argument help/input/report flags
+-- - move all required-argument help/input/report flags along with their values, space-separated or not
+-- - not confuse things further or cause misleading errors.
+moveFlagsAfterCommand :: [String] -> [String]
+moveFlagsAfterCommand args = moveArgs $ ensureDebugHasArg args
+  where
+    -- quickly! make sure --debug has a numeric argument, or this all goes to hell
+    ensureDebugHasArg as =
+      case break (=="--debug") as of
+       (bs,"--debug":c:cs) | null c || not (all isDigit c) -> bs++"--debug=1":c:cs
+       (bs,"--debug":[])                                   -> bs++"--debug=1":[]
+       _                                                   -> as
 
---  ]
+    -- -h ..., --version ...
+    moveArgs (f:a:as)   | isMovableNoArgFlag f                   = (moveArgs $ a:as) ++ [f]
+    -- -f FILE ..., --alias ALIAS ...
+    moveArgs (f:v:a:as) | isMovableReqArgFlag f, isValue v       = (moveArgs $ a:as) ++ [f,v]
+    -- -fFILE ..., --alias=ALIAS ...
+    moveArgs (fv:a:as)  | isMovableReqArgFlagAndValue fv         = (moveArgs $ a:as) ++ [fv]
+    -- -f(missing arg)
+    moveArgs (f:a:as)   | isMovableReqArgFlag f, not (isValue a) = (moveArgs $ a:as) ++ [f]
+    -- anything else
+    moveArgs as = as
 
+isMovableNoArgFlag a  = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` noargflagstomove
+
+isMovableReqArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` reqargflagstomove
+
+isMovableReqArgFlagAndValue ('-':'-':a:as) = case break (== '=') (a:as) of (f:fs,_:_) -> (f:fs) `elem` reqargflagstomove
+                                                                           _          -> False
+isMovableReqArgFlagAndValue ('-':shortflag:_:_) = [shortflag] `elem` reqargflagstomove
+isMovableReqArgFlagAndValue _ = False
+
+isValue "-"     = True
+isValue ('-':_) = False
+isValue _       = True
+
+flagstomove = inputflags ++ reportflags ++ helpflags
+noargflagstomove  = concatMap flagNames $ filter ((==FlagNone).flagInfo) flagstomove
+reqargflagstomove = -- filter (/= "debug") $
+                    concatMap flagNames $ filter ((==FlagReq ).flagInfo) flagstomove
 

hledger/Hledger/Cli/Man.hs

@@ -1,41 +0,0 @@
-{-|
-
-The man command.
-
-|-}
-
-module Hledger.Cli.Man (
-
-   manmode
-  ,man
-
-  ) 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
-
-manmode = (defCommandMode $ ["man"] ++ aliases) {
-  modeHelp = "show any of the hledger manuals with man" `withAliases` aliases
- ,modeGroupFlags = Group {
-     groupUnnamed = []
-    ,groupHidden = []
-    ,groupNamed = []
-    }
- }
-  where aliases = []
-
--- | Try to use man to view the selected manual.
-man :: CliOpts -> IO ()
-man opts = do
-  let args = listofstringopt "args" $ rawopts_ opts
-  case args of
-    []    -> putStrLn $
-             "Choose a topic, eg: hledger man cli\n" ++
-             intercalate ", " docTopics
-    topic:_ -> runManForTopic topic

hledger/hledger.cabal

@@ -122,18 +122,17 @@ library
       Hledger.Cli.Tests
       Hledger.Cli.Utils
       Hledger.Cli.Version
-      Hledger.Cli.Add
       Hledger.Cli.Accounts
+      Hledger.Cli.Activity
+      Hledger.Cli.Add
       Hledger.Cli.Balance
       Hledger.Cli.Balancesheet
       Hledger.Cli.Balancesheetequity
+      Hledger.Cli.Commands
       Hledger.Cli.CompoundBalanceCommand
       Hledger.Cli.Cashflow
       Hledger.Cli.Help
-      Hledger.Cli.Histogram
       Hledger.Cli.Incomestatement
-      Hledger.Cli.Info
-      Hledger.Cli.Man
       Hledger.Cli.Print
       Hledger.Cli.Register
       Hledger.Cli.Stats

hledger/package.yaml

@@ -103,18 +103,17 @@ library:
   - Hledger.Cli.Tests
   - Hledger.Cli.Utils
   - Hledger.Cli.Version
-  - Hledger.Cli.Add
   - Hledger.Cli.Accounts
+  - Hledger.Cli.Activity
+  - Hledger.Cli.Add
   - Hledger.Cli.Balance
   - Hledger.Cli.Balancesheet
   - Hledger.Cli.Balancesheetequity
+  - Hledger.Cli.Commands
   - Hledger.Cli.CompoundBalanceCommand
   - Hledger.Cli.Cashflow
   - Hledger.Cli.Help
-  - Hledger.Cli.Histogram
   - Hledger.Cli.Incomestatement
-  - Hledger.Cli.Info
-  - Hledger.Cli.Man
   - Hledger.Cli.Print
   - Hledger.Cli.Register
   - Hledger.Cli.Stats