Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Hledger.Cli
Description
This is the root module of the hledger
package,
providing hledger's command-line interface.
The main function,
commands,
command-line options,
and utilities useful to other hledger command-line programs
are exported.
It also re-exports hledger-lib:Hledger
and cmdargs:System.Concole.CmdArgs.Explicit
See also:
- hledger-lib:Hledger
- The README files
- The high-level developer docs
About
hledger - a fast, reliable, user-friendly plain text accounting tool. Copyright (c) 2007-2024 Simon Michael simon@joyful.com and contributors Released under GPL version 3 or later.
hledger is a Haskell rewrite of John Wiegley's "ledger". It generates financial reports from a plain text general journal. You can use the command line:
$ hledger
or ghci:
$ make ghci ghci> Right j <- runExceptT $ readJournalFile definputopts "examples/sample.journal" -- or: j <- defaultJournal ghci> :t j j :: Journal ghci> stats defcliopts j Main file : examples/sample.journal Included files : Transactions span : 2008-01-01 to 2009-01-01 (366 days) Last transaction : 2008-12-31 (733772 days from now) Transactions : 5 (0.0 per day) Transactions last 30 days: 0 (0.0 per day) Transactions last 7 days : 0 (0.0 per day) Payees/descriptions : 5 Accounts : 8 (depth 3) Commodities : 1 ($) Market prices : 0 () Run time (throughput) : 1695276900.00s (0 txns/s) ghci> balance defcliopts j $1 assets:bank:saving $-2 assets:cash $1 expenses:food $1 expenses:supplies $-1 income:gifts $-1 income:salary $1 liabilities:debts -------------------- 0 ghci>
etc.
Synopsis
- main :: IO ()
- mainmode :: [Name] -> Mode RawOpts
- argsToCliOpts :: [String] -> [String] -> IO CliOpts
- module Hledger.Cli.CliOptions
- module Hledger.Cli.Conf
- module Hledger.Cli.Commands
- module Hledger.Cli.DocFiles
- module Hledger.Cli.Utils
- module Hledger.Cli.Version
- module Hledger
- data Complete
- data Arg a = Arg {}
- class Remap (m :: Type -> Type) where
- remap :: (a -> b) -> (b -> (a, a -> b)) -> m a -> m b
- data Flag a = Flag {}
- type Update a = String -> a -> Either String a
- data FlagInfo
- data Mode a = Mode {
- modeGroupModes :: Group (Mode a)
- modeNames :: [Name]
- modeValue :: a
- modeCheck :: a -> Either String a
- modeReform :: a -> Maybe [String]
- modeExpandAt :: Bool
- modeHelp :: Help
- modeHelpSuffix :: [String]
- modeArgs :: ([Arg a], Maybe (Arg a))
- modeGroupFlags :: Group (Flag a)
- data Group a = Group {
- groupUnnamed :: [a]
- groupHidden :: [a]
- groupNamed :: [(Help, [a])]
- type FlagHelp = String
- type Help = String
- data HelpFormat
- process :: Mode a -> [String] -> Either String a
- expandArgsAt :: [String] -> IO [String]
- joinArgs :: [String] -> String
- splitArgs :: String -> [String]
- parseBool :: String -> Maybe Bool
- fromGroup :: Group a -> [a]
- toGroup :: [a] -> Group a
- modeModes :: Mode a -> [Mode a]
- modeFlags :: Mode a -> [Flag a]
- fromFlagOpt :: FlagInfo -> String
- checkMode :: Mode a -> Maybe String
- remap2 :: Remap m => (a -> b) -> (b -> a) -> m a -> m b
- remapUpdate :: (a -> b) -> (b -> (a, a -> b)) -> Update a -> Update b
- modeEmpty :: a -> Mode a
- mode :: Name -> a -> Help -> Arg a -> [Flag a] -> Mode a
- modes :: String -> a -> Help -> [Mode a] -> Mode a
- flagNone :: [Name] -> (a -> a) -> Help -> Flag a
- flagOpt :: String -> [Name] -> Update a -> FlagHelp -> Help -> Flag a
- flagReq :: [Name] -> Update a -> FlagHelp -> Help -> Flag a
- flagArg :: Update a -> FlagHelp -> Arg a
- flagBool :: [Name] -> (Bool -> a -> a) -> Help -> Flag a
- complete :: Mode a -> [String] -> (Int, Int) -> [Complete]
- helpText :: [String] -> HelpFormat -> Mode a -> [Text]
- processArgs :: Mode a -> IO a
- processValue :: Mode a -> [String] -> a
- processValueIO :: Mode a -> [String] -> IO a
- flagHelpSimple :: (a -> a) -> Flag a
- flagHelpFormat :: (HelpFormat -> TextFormat -> a -> a) -> Flag a
- flagVersion :: (a -> a) -> Flag a
- flagNumericVersion :: (a -> a) -> Flag a
- flagsVerbosity :: (Verbosity -> a -> a) -> [Flag a]
Documentation
hledger CLI's main procedure.
Here we will parse the command line, read any config file, and search for hledger-* addon executables in the user's PATH, then choose the appropriate builtin operation or addon operation to run, then run it in the right way, usually reading input data (eg a journal) first.
When making a CLI usable and robust with main command, builtin subcommands, various kinds of addon commands, and config files that add general and command-specific options, while balancing circular dependencies, environment, idioms, legacy, and libraries with their own requirements and limitations: things get crazy, and there is a tradeoff against complexity and bug risk. We try to provide the most intuitive, expressive and robust CLI that's feasible while keeping the CLI processing below sufficiently comprehensible, troubleshootable, and tested. It's an ongoing quest. See also: Hledger.Cli.CliOptions, cli.test, addons.test, --debug and --debug=8.
Probably the biggest source of complexity here is that cmdargs can't parse a command line containing undeclared flags, but this arises often with our addon commands and builtin/custom commands which haven't implemented all options, so we have to work hard to work around this. https://github.com/ndmitchell/cmdargs/issues/36 is the wishlist issue; implementing that would simplify hledger's CLI processing a lot.
mainmode :: [Name] -> Mode RawOpts Source #
The overall cmdargs mode describing hledger's command-line options and subcommands. The names of known addons are provided so they too can be recognised as commands.
argsToCliOpts :: [String] -> [String] -> IO CliOpts Source #
A helper for addons/scripts: this parses hledger CliOpts from these command line arguments and add-on command names, roughly how hledger main does. If option parsing/validating fails, it exits the program with usageError. Unlike main, this does not read extra args from a config file or search for addons; to do those things, mimic the code in main for now.
Re-exports
module Hledger.Cli.CliOptions
module Hledger.Cli.Conf
module Hledger.Cli.Commands
module Hledger.Cli.DocFiles
module Hledger.Cli.Utils
module Hledger.Cli.Version
module Hledger
System.Console.CmdArgs.Explicit
How to complete a command line option.
The Show
instance is suitable for parsing from shell scripts.
Constructors
CompleteValue String | Complete to a particular value |
CompleteFile String FilePath | Complete to a prefix, and a file |
CompleteDir String FilePath | Complete to a prefix, and a directory |
An unnamed argument. Anything not starting with -
is considered an argument,
apart from "-"
which is considered to be the argument "-"
, and any arguments
following "--"
. For example:
programname arg1 -j - --foo arg3 -- -arg4 --arg5=1 arg6
Would have the arguments:
["arg1","-","arg3","-arg4","--arg5=1","arg6"]
Constructors
Arg | |
class Remap (m :: Type -> Type) where #
Like functor, but where the the argument isn't just covariant.
Methods
Arguments
:: (a -> b) | Embed a value |
-> (b -> (a, a -> b)) | Extract the mode and give a way of re-embedding |
-> m a | |
-> m b |
Convert between two values.
Instances
Remap Arg | |
Defined in System.Console.CmdArgs.Explicit.Type | |
Remap Flag | |
Defined in System.Console.CmdArgs.Explicit.Type | |
Remap Mode | |
Defined in System.Console.CmdArgs.Explicit.Type |
A flag, consisting of a list of flag names and other information.
Constructors
Flag | |
type Update a = String -> a -> Either String a #
A function to take a string, and a value, and either produce an error message
(Left
), or a modified value (Right
).
The FlagInfo
type has the following meaning:
FlagReq FlagOpt FlagOptRare/FlagNone -xfoo -x=foo -x=foo -x -foo -x foo -x=foo -x foo -x foo -x=foo -x=foo -x=foo -x=foo --xx foo --xx=foo --xx foo --xx foo --xx=foo --xx=foo --xx=foo --xx=foo
Constructors
FlagReq | Required argument |
FlagOpt String | Optional argument |
FlagOptRare String | Optional argument that requires an = before the value |
FlagNone | No argument |
A mode. Do not use the Mode
constructor directly, instead
use mode
to construct the Mode
and then record updates.
Each mode has three main features:
- A list of submodes (
modeGroupModes
) - A list of flags (
modeGroupFlags
) - Optionally an unnamed argument (
modeArgs
)
To produce the help information for a mode, either use helpText
or show
.
Constructors
Mode | |
Fields
|
A group of items (modes or flags). The items are treated as a list, but the group structure is used when displaying the help message.
Constructors
Group | |
Fields
|
data HelpFormat #
Specify the format to output the help.
Constructors
HelpFormatDefault | Equivalent to |
HelpFormatOne | Display only the first mode. |
HelpFormatAll | Display all modes. |
HelpFormatBash | Bash completion information |
HelpFormatZsh | Z shell completion information |
Instances
process :: Mode a -> [String] -> Either String a #
Process a list of flags (usually obtained from getArgs
/expandArgsAt
) with a mode. Returns
Left
and an error message if the command line fails to parse, or Right
and
the associated value.
expandArgsAt :: [String] -> IO [String] #
Expand @
directives in a list of arguments, usually obtained from getArgs
.
As an example, given the file test.txt
with the lines hello
and world
:
expandArgsAt ["@test.txt","!"] == ["hello","world","!"]
Any @
directives in the files will be recursively expanded (raising an error
if there is infinite recursion).
To supress @
expansion, pass any @
arguments after --
.
joinArgs :: [String] -> String #
Given a sequence of arguments, join them together in a manner that could be used on
the command line, giving preference to the Windows cmd
shell quoting conventions.
For an alternative version, intended for actual running the result in a shell, see "System.Process.showCommandForUser"
splitArgs :: String -> [String] #
Given a string, split into the available arguments. The inverse of joinArgs
.
Convert a list into a group, placing all fields in groupUnnamed
.
fromFlagOpt :: FlagInfo -> String #
Extract the value from inside a FlagOpt
or FlagOptRare
, or raises an error.
remap2 :: Remap m => (a -> b) -> (b -> a) -> m a -> m b #
Restricted version of remap
where the values are isomorphic.
remapUpdate :: (a -> b) -> (b -> (a, a -> b)) -> Update a -> Update b #
Create an empty mode specifying only modeValue
. All other fields will usually be populated
using record updates.
mode :: Name -> a -> Help -> Arg a -> [Flag a] -> Mode a #
Create a mode with a name, an initial value, some help text, a way of processing arguments and a list of flags.
modes :: String -> a -> Help -> [Mode a] -> Mode a #
Create a list of modes, with a program name, an initial value, some help text and the child modes.
flagNone :: [Name] -> (a -> a) -> Help -> Flag a #
Create a flag taking no argument value, with a list of flag names, an update function and some help text.
flagOpt :: String -> [Name] -> Update a -> FlagHelp -> Help -> Flag a #
Create a flag taking an optional argument value, with an optional value, a list of flag names, an update function, the type of the argument and some help text.
flagReq :: [Name] -> Update a -> FlagHelp -> Help -> Flag a #
Create a flag taking a required argument value, with a list of flag names, an update function, the type of the argument and some help text.
flagArg :: Update a -> FlagHelp -> Arg a #
Create an argument flag, with an update function and the type of the argument.
flagBool :: [Name] -> (Bool -> a -> a) -> Help -> Flag a #
Create a boolean flag, with a list of flag names, an update function and some help text.
Arguments
:: Mode a | Mode specifying which arguments are allowed |
-> [String] | Arguments the user has already typed |
-> (Int, Int) | 0-based index of the argument they are currently on, and the position in that argument |
-> [Complete] |
Given a current state, return the set of commands you could type now, in preference order.
helpText :: [String] -> HelpFormat -> Mode a -> [Text] #
Generate a help message from a mode. The first argument is a prefix,
which is prepended when not using HelpFormatBash
or HelpFormatZsh
.
processArgs :: Mode a -> IO a #
Process the flags obtained by
and getArgs
with a mode. Displays
an error and exits with failure if the command line fails to parse, or returns
the associated value. Implemented in terms of expandArgsAt
process
. This function makes
use of the following environment variables:
$CMDARGS_COMPLETE
- causes the program to produce completions usingcomplete
, then exit. Completions are based on the result ofgetArgs
, the index of the current argument is taken from$CMDARGS_COMPLETE
(set it to-
to complete the last argument), and the index within that argument is taken from$CMDARGS_COMPLETE_POS
(if set).$CMDARGS_HELPER
/$CMDARGS_HELPER_PROG
- uses the helper mechanism for entering command line programs as described in System.Console.CmdArgs.Helper.
processValue :: Mode a -> [String] -> a #
Process a list of flags (usually obtained from
and getArgs
) with a mode.
Throws an error if the command line fails to parse, or returns
the associated value. Implemeneted in terms of expandArgsAt
process
. This function
does not take account of any environment variables that may be set
(see processArgs
).
If you are in IO
you will probably get a better user experience by calling processValueIO
.
processValueIO :: Mode a -> [String] -> IO a #
Like processValue
but on failure prints to stderr and exits the program.
flagHelpSimple :: (a -> a) -> Flag a #
Create a help flag triggered by -?
/--help
.
flagHelpFormat :: (HelpFormat -> TextFormat -> a -> a) -> Flag a #
Create a help flag triggered by -?
/--help
. The user
may optionally modify help by specifying the format, such as:
--help=all - help for all modes --help=html - help in HTML format --help=100 - wrap the text at 100 characters --help=100,one - full text wrapped at 100 characters
flagVersion :: (a -> a) -> Flag a #
Create a version flag triggered by -V
/--version
.
flagNumericVersion :: (a -> a) -> Flag a #
Create a version flag triggered by --numeric-version
.
flagsVerbosity :: (Verbosity -> a -> a) -> [Flag a] #
Create verbosity flags triggered by -v
/--verbose
and
-q
/--quiet