slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

addons: add -h & --help to most of them; CliOpts cleanups

Browse Source
This commit is contained in:
Simon Michael 2017-01-23 06:17:17 -08:00
parent 1218ca55f0
commit f4eb9e23e3
9 changed files with 257 additions and 165 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
bin/compile.sh
View File

@ -2,7 +2,7 @@
cd "$(dirname "$0")"
echo "building dependencies"
stack build hledger
stack install Chart Chart-diagrams colour # additional deps for hledger-chart
stack install Chart Chart-diagrams colour here # additional deps needed by addons
echo "building add-on commands"
for f in hledger-*.hs; do stack ghc $f; done
echo "add-on commands available:"

59
bin/hledger-chart.hs
View File

@ -7,21 +7,12 @@
--package cmdargs
--package colour
--package data-default
--package here
--package safe
-}
{-
hledger-chart
Generates primitive pie charts, based on the old hledger-chart package.
Supposed to show only balances of one sign, but this might be broke.
Copyright (c) 2007-2017 Simon Michael <simon@joyful.com>
Released under GPL version 3 or later.
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
import Control.Monad
import Data.Colour
@ -33,6 +24,7 @@ import Data.Default
import Data.List
import Data.Maybe
import Data.Ord
import Data.String.Here
import qualified Data.Text as T
import Data.Tree
import Graphics.Rendering.Chart
@ -46,6 +38,24 @@ import Text.Printf
import Hledger
import Hledger.Cli hiding (progname,progversion)
doc = [here|
Usage:
```
$ hledger-chart [FILE]
Generates primitive pie charts of account balances, in SVG format.
...common hledger options...
```
Based on the old hledger-chart package, this is not yet useful.
It's supposed to show only balances of one sign, but this might be broken.
Copyright (c) 2007-2017 Simon Michael <simon@joyful.com>
Released under GPL version 3 or later.
|]
-- options
-- progname = "hledger-chart"
@ -55,8 +65,9 @@ defchartoutput = "hledger.svg"
defchartitems = 10
defchartsize = "600x400"
chartmode = (defCommandMode ["hledger-chart"]) {
modeArgs = ([], Just $ argsFlag "[PATTERNS] --add-posting \"ACCT AMTEXPR\" ...")
chartmode :: Mode RawOpts
chartmode = (defAddonCommandMode "hledger-chart") {
modeArgs = ([], Just $ argsFlag "[QUERY] --add-posting \"ACCT AMTEXPR\" ...")
,modeHelp = "generate a pie chart image for the top account balances (of one sign only)"
,modeHelpSuffix=[]
,modeGroupFlags = Group {
@ -70,7 +81,6 @@ chartmode = (defCommandMode ["hledger-chart"]) {
}
}
-- hledger-chart options, used in hledger-chart and above
data ChartOpts = ChartOpts {
chart_output_ :: FilePath
,chart_items_ :: Int
@ -84,25 +94,16 @@ defchartopts = ChartOpts
def
defcliopts
-- instance Default CliOpts where def = defcliopts
toChartOpts :: RawOpts -> IO ChartOpts
toChartOpts rawopts = do
cliopts <- rawOptsToCliOpts rawopts
getHledgerChartOpts :: IO ChartOpts
getHledgerChartOpts = do
cliopts <- getHledgerOptsOrShowHelp chartmode doc
return defchartopts {
chart_output_ = fromMaybe defchartoutput $ maybestringopt "debug-chart" rawopts
,chart_items_ = fromMaybe defchartitems $ maybeintopt "debug-items" rawopts
,chart_size_ = fromMaybe defchartsize $ maybestringopt "debug-size" rawopts
chart_output_ = fromMaybe defchartoutput $ maybestringopt "debug-chart" $ rawopts_ cliopts
,chart_items_ = fromMaybe defchartitems $ maybeintopt "debug-items" $ rawopts_ cliopts
,chart_size_ = fromMaybe defchartsize $ maybestringopt "debug-size" $ rawopts_ cliopts
,cliopts_ = cliopts
}
checkChartOpts :: ChartOpts -> IO ChartOpts
checkChartOpts opts = do
(checkCliOpts $ cliopts_ opts) `seq` return opts
getHledgerChartOpts :: IO ChartOpts
getHledgerChartOpts = processArgs chartmode >>= return . decodeRawOpts >>= toChartOpts >>= checkChartOpts
-- main
main :: IO ()

37
bin/hledger-check-dates.hs
View File

@ -2,24 +2,37 @@
{- stack runghc --verbosity info
--package hledger-lib
--package hledger
-}
{-
hledger-check-dates [--strict] [--date2] [-f JOURNALFILE]
Check that transactions' date are monotonically increasing.
With --strict, dates must also be unique.
With --date2, checks transactions' secondary dates.
Reads the default journal file, or another specified with -f.
--package here
-}
{-# LANGUAGE QuasiQuotes #-}
import Data.String.Here
import Hledger
import Hledger.Cli
import Text.Printf
------------------------------------------------------------------------------
doc = [here|
$ hledger-check-dates -h
check-dates [OPTIONS] [ARGS]
check that transactions' date are monotonically increasing
Flags:
--strict makes date comparing strict
...common hledger options...
With --strict, dates must also be unique.
With --date2, checks transactions' secondary dates.
Reads the default journal file, or another specified with -f.
|]
------------------------------------------------------------------------------
argsmode :: Mode RawOpts
argsmode = (defCommandMode ["check-dates"])
argsmode = (defAddonCommandMode "check-dates")
{ modeHelp = "check that transactions' date are monotonically increasing"
, modeGroupFlags = Group
{ groupNamed =
@ -59,7 +72,7 @@ checkTransactions compare ts =
main :: IO ()
main = do
opts <- getCliOpts argsmode
opts <- getHledgerOptsOrShowHelp argsmode doc
withJournalDo opts $
\CliOpts{rawopts_=opts,reportopts_=ropts} j -> do
d <- getCurrentDay

37
bin/hledger-dupes.hs
View File

@ -1,28 +1,39 @@
#!/usr/bin/env stack
{- stack runghc --verbosity info
--package hledger-lib
--package here
--package safe
--package text
-}
{-
hledger-dupes [FILE]
{-# LANGUAGE QuasiQuotes #-}
import Hledger
import Hledger.Cli
import Text.Printf (printf)
import System.Environment (getArgs)
import Safe (headDef)
import Data.List
import Data.Function
import Data.String.Here
import qualified Data.Text as T
doc = [here|
Usage:
```
$ hledger-dupes [FILE]
...common hledger options...
```
Reports duplicates in the account tree: account names having the same leaf
but different prefixes. In other words, two or more leaves that are
categorized differently.
Reads the default journal file, or another specified as an argument.
http://stefanorodighiero.net/software/hledger-dupes.html
-}
import Hledger
import Text.Printf (printf)
import System.Environment (getArgs)
import Safe (headDef)
import Data.List
import Data.Function
import qualified Data.Text as T
|]
accountsNames :: Journal -> [(String, AccountName)]
accountsNames j = map leafAndAccountName as
@ -44,8 +55,6 @@ render :: (String, [AccountName]) -> IO ()
render (leafName, accountNameL) = printf "%s as %s\n" leafName (concat $ intersperse ", " (map T.unpack accountNameL))
main = do
args <- getArgs
deffile <- defaultJournalPath
let file = headDef deffile args
j <- readJournalFile Nothing Nothing True file >>= either error' return
opts <- getHledgerOptsOrShowHelp (defAddonCommandMode "dupes") doc
withJournalDo opts $ \CliOpts{rawopts_=opts,reportopts_=ropts} j -> do
mapM_ render $ dupes $ accountsNames j

73
bin/hledger-equity.hs
View File

@ -2,15 +2,33 @@
{- stack runghc --verbosity info
--package hledger-lib
--package hledger
--package here
--package time
-}
{-
hledger-equity [HLEDGEROPTS] [QUERY]
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
Show a "closing balances" transaction that brings the balance of the
accounts matched by QUERY (or all accounts) to zero, and an opposite
"opening balances" transaction that restores the balances from zero.
import Data.Maybe
import Data.String.Here
import Data.Time.Calendar
import Hledger.Cli
------------------------------------------------------------------------------
doc = [here|
Usage:
```
$ hledger-equity -h
equity [OPTIONS] [QUERY]
print a "closing balances" transaction that brings all accounts (or with
query arguments, just the matched accounts) to a zero balance, followed by an
opposite "opening balances" transaction that restores the balances from zero.
Such transactions can be useful, eg, for bringing account balances across
file boundaries.
...common hledger options...
```
The opening balances transaction is useful to carry over
asset/liability balances if you choose to start a new journal file,
@ -26,46 +44,39 @@ the closing transaction is dated one day earlier). If a report end
date is not specified, it defaults to today.
Example:
```
$ hledger equity -f 2015.journal -e 2016/1/1 assets liabilities >>2015.journal
move opening balances txn to 2016.journal
# & move the opening balances transaction to 2016.journal
```
Open question: how to handle txns spanning a file boundary ? Eg:
```journal
2015/12/30 * food
expenses:food:dining $10
assets:bank:checking -$10 ; date:2016/1/4
```
This might or might not have some connection to the concept of
This command might or might not have some connection to the concept of
"closing the books" in accounting.
-}
|]
------------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
import Data.Maybe (fromMaybe)
import Data.Time.Calendar (addDays)
import Hledger.Cli
argsmode :: Mode RawOpts
argsmode = (defCommandMode ["equity"])
{ modeHelp = ("print a \"closing balances\" transaction that brings the balance of the"
++ " accounts matched by QUERY (or all accounts) to zero, and an opposite"
++ "\"opening balances\" transaction that restores the balances from zero.")
++ " (or the specified account and its subaccounts)"
, modeGroupFlags = Group
{ groupNamed =
-- XXX update to match hledger
[ ("Input",inputflags)
, ("Reporting",reportflags)
, ("Misc",helpflags)
]
, groupUnnamed = []
, groupHidden = []
}
equitymode :: Mode RawOpts
equitymode =
(defAddonCommandMode "equity")
{ modeHelp =
"print a \"closing balances\" transaction that brings all accounts"
++ " (or with query arguments, just the matched accounts) to a zero balance,"
++ " followed by an opposite \"opening balances\" transaction that"
++ " restores the balances from zero."
++ " Such transactions can be useful, eg, for bringing account balances across file boundaries."
,modeArgs = ([], Just $ argsFlag "[QUERY]")
}
main :: IO ()
main = do
opts <- getCliOpts argsmode
opts <- getHledgerOptsOrShowHelp equitymode doc
withJournalDo opts $
\CliOpts{reportopts_=ropts} j -> do
today <- getCurrentDay

29
bin/hledger-print-unique.hs
View File

@ -2,23 +2,36 @@
{- stack runghc --verbosity info
--package hledger-lib
--package hledger
--package here
-}
{-
hledger-print-unique [-f JOURNALFILE | -f-]
{-# LANGUAGE QuasiQuotes #-}
import Data.List
import Data.Ord
import Data.String.Here
import Hledger.Cli
------------------------------------------------------------------------------
doc = [here|
Usage:
```
$ hledger-print-unique -h
hledger-print-unique [OPTIONS] [ARGS]
...common hledger options...
```
Print only journal entries which are unique by description (or
something else). Reads the default or specified journal, or stdin.
-}
import Data.List
import Data.Ord
import Hledger.Cli
|]
------------------------------------------------------------------------------
main = do
putStrLn "(-f option not supported)"
opts <- getCliOpts (defCommandMode ["hledger-print-unique"])
opts <- getHledgerOptsOrShowHelp (defAddonCommandMode "hledger-print-unique") doc
withJournalDo opts $
\opts j@Journal{jtxns=ts} -> print' opts j{jtxns=uniquify ts}
where

37
bin/hledger-register-match.hs
View File

@ -2,25 +2,17 @@
{- stack runghc --verbosity info
--package hledger-lib
--package hledger
--package here
--package text
-}
{-
hledger-register-match DESC
A helper for ledger-autosync. This prints the one posting whose transaction
description is closest to DESC, in the style of the register command.
If there are multiple equally good matches, it shows the most recent.
Query options (options, not arguments) can be used to restrict the search space.
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
import Data.Char (toUpper)
import Data.List
import Data.String.Here
import qualified Data.Text as T
import System.Console.CmdArgs
import System.Console.CmdArgs.Explicit
@ -28,7 +20,28 @@ import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli ( withJournalDo, postingsReportAsText )
main = getCliOpts (defCommandMode ["hledger-register-match"]) >>= flip withJournalDo match
------------------------------------------------------------------------------
doc = [here|
Usage:
```
$ hledger-register-match -h
hledger-register-match [OPTIONS] [ARGS]
...common hledger options...
```
A helper for ledger-autosync. This prints the one posting whose transaction
description is closest to DESC, in the style of the register command.
If there are multiple equally good matches, it shows the most recent.
Query options (options, not arguments) can be used to restrict the search space.
|]
------------------------------------------------------------------------------
main = do
opts <- getHledgerOptsOrShowHelp (defAddonCommandMode "hledger-register-match") doc
withJournalDo opts match
match :: CliOpts -> Journal -> IO ()
match opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do

92
bin/hledger-rewrite.hs
View File

@ -2,47 +2,17 @@
{- stack runghc --verbosity info
--package hledger-lib
--package hledger
--package here
--package megaparsec
--package text
--package Diff
-}
{-# LANGUAGE OverloadedStrings, LambdaCase, DeriveTraversable, ViewPatterns #-}
{-
hledger-rewrite [PATTERNS] --add-posting "ACCT AMTEXPR" ...
A start at a generic rewriter of journal entries.
Reads the default journal and prints the entries, like print,
but adds the specified postings to any entries matching PATTERNS.
Examples:
hledger-rewrite.hs ^income --add-posting '(liabilities:tax) *.33 ; income tax' --add-posting '(reserve:gifts) $100'
hledger-rewrite.hs expenses:gifts --add-posting '(reserve:gifts) *-1"'
hledger-rewrite.hs -f rewrites.hledger
rewrites.hledger may consist of entries like:
= ^income amt:<0 date:2017
(liabilities:tax) *0.33 ; tax on income
(reserve:grocery) *0.25 ; reserve 25% for grocery
(reserve:) *0.25 ; reserve 25% for grocery
Note the single quotes to protect the dollar sign from bash, and the two spaces between account and amount.
See the command-line help for more details.
Currently does not work when invoked via hledger, run it directly instead.
Related: https://github.com/simonmichael/hledger/issues/99
TODO:
- should allow regex matching and interpolating matched name in replacement
- should apply all matching rules to a transaction, not just one
- should be possible to use this on unbalanced entries, eg while editing one
-}
{-# LANGUAGE OverloadedStrings, LambdaCase, DeriveTraversable, ViewPatterns, QuasiQuotes #-}
import Control.Monad.Writer
import Data.List (sortOn, foldl')
import Data.String.Here
import qualified Data.Text as T
-- hledger lib, cli and cmdargs utils
import Hledger.Cli hiding (outputflags)
@ -55,9 +25,59 @@ import Text.Megaparsec
import qualified Data.Algorithm.Diff as D
import Hledger.Data.AutoTransaction (runModifierTransaction)
------------------------------------------------------------------------------
doc = [here|
Usage:
```
$ hledger-rewrite -h
hledger-rewrite [OPTIONS] [QUERY] --add-posting "ACCT AMTEXPR" ...
print all journal entries, with custom postings added to the matched ones
Flags:
--add-posting='ACCT AMTEXPR' add a posting to ACCT, which may be
parenthesised. AMTEXPR is either a literal
amount, or *N which means the transaction's
first matched amount multiplied by N (a
decimal number). Two spaces separate ACCT
and AMTEXPR.
--diff generate diff suitable as an input for
...common hledger options...
```
A start at a generic rewriter of journal entries.
Reads the default journal and prints the entries, like print,
but adds the specified postings to any entries matching PATTERNS.
Examples:
```
hledger-rewrite.hs ^income --add-posting '(liabilities:tax) *.33 ; income tax' --add-posting '(reserve:gifts) $100'
hledger-rewrite.hs expenses:gifts --add-posting '(reserve:gifts) *-1"'
hledger-rewrite.hs -f rewrites.hledger
```
rewrites.hledger may consist of entries like:
```
= ^income amt:<0 date:2017
(liabilities:tax) *0.33 ; tax on income
(reserve:grocery) *0.25 ; reserve 25% for grocery
(reserve:) *0.25 ; reserve 25% for grocery
```
Note the single quotes to protect the dollar sign from bash, and the two spaces between account and amount.
See the command-line help for more details.
Currently does not work when invoked via hledger, run it directly instead.
Related: https://github.com/simonmichael/hledger/issues/99
TODO:
- should allow regex matching and interpolating matched name in replacement
- should apply all matching rules to a transaction, not just one
- should be possible to use this on unbalanced entries, eg while editing one
|]
------------------------------------------------------------------------------
cmdmode :: Mode RawOpts
cmdmode = (defCommandMode ["hledger-rewrite"]) {
modeArgs = ([], Just $ argsFlag "[PATTERNS] --add-posting \"ACCT AMTEXPR\" ...")
cmdmode = (defAddonCommandMode "hledger-rewrite") {
modeArgs = ([], Just $ argsFlag "[QUERY] --add-posting \"ACCT AMTEXPR\" ...")
,modeHelp = "print all journal entries, with custom postings added to the matched ones"
,modeGroupFlags = Group {
groupNamed = [("Input", inputflags)
@ -178,7 +198,7 @@ mapDiff = \case
main :: IO ()
main = do
opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} <- getCliOpts cmdmode
opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} <- getHledgerOptsOrShowHelp cmdmode doc
d <- getCurrentDay
let q = queryFromOpts d ropts
modifier <- modifierTransactionFromOpts rawopts

52
hledger/Hledger/Cli/CliOptions.hs
View File

@ -28,7 +28,7 @@ module Hledger.Cli.CliOptions (
-- * CLI options
CliOpts(..),
defcliopts,
getCliOpts,
getHledgerOptsOrShowHelp,
decodeRawOpts,
rawOptsToCliOpts,
checkCliOpts,
@ -165,13 +165,14 @@ generalflagsgroup3 = (generalflagstitle, helpflags)
-- cmdargs mode constructors
-- | A basic mode template.
-- | A basic cmdargs mode template with a single flag: -h.
defMode :: Mode RawOpts
defMode = Mode {
modeNames = []
,modeHelp = ""
,modeHelpSuffix = []
,modeValue = []
,modeArgs = ([], Nothing)
,modeCheck = Right
,modeReform = const Nothing
,modeExpandAt = True
@ -179,14 +180,16 @@ defMode = Mode {
groupNamed = []
,groupUnnamed = [
flagNone ["h"] (setboolopt "h") "Show command usage."
-- ,flagNone ["help"] (setboolopt "help") "Show long help."
]
,groupHidden = []
}
,modeArgs = ([], Nothing)
,modeGroupModes = toGroup []
}
-- | A basic subcommand mode with the given command name(s).
-- | A cmdargs mode suitable for a hledger built-in command
-- with the given names (primary name + optional aliases).
-- The usage message shows [QUERY] as argument.
defCommandMode :: [Name] -> Mode RawOpts
defCommandMode names = defMode {
modeNames=names
@ -194,22 +197,20 @@ defCommandMode names = defMode {
,modeArgs = ([], Just $ argsFlag "[QUERY]")
}
-- | A basic subcommand mode suitable for an add-on command.
-- | A cmdargs mode suitable for a hledger add-on command with the given name.
-- Like defCommandMode, but adds a appropriate short help message if the addon name
-- is recognised, and includes hledger's general flags (input + reporting + help flags) as default.
defAddonCommandMode :: Name -> Mode RawOpts
defAddonCommandMode addon = defMode {
modeNames = [addon]
,modeHelp = fromMaybe "" $ lookup (stripAddonExtension addon) standardAddonsHelp
,modeValue=[("command",addon)]
defAddonCommandMode name = (defCommandMode [name]) {
modeHelp = fromMaybe "" $ lookup (stripAddonExtension name) standardAddonsHelp
,modeGroupFlags = Group {
groupUnnamed = []
,groupHidden = []
,groupNamed = [generalflagsgroup1]
}
,modeArgs = ([], Just $ argsFlag "[ARGS]")
}
-- | Built-in descriptions for some of the known external addons,
-- since we don't currently have any way to ask them.
-- | Built-in descriptions for some of the known addons.
standardAddonsHelp :: [(String,String)]
standardAddonsHelp = [
("chart", "generate simple balance pie charts")
@ -360,21 +361,32 @@ checkCliOpts opts =
Right _ -> Right ()
-- XXX check registerWidthsFromOpts opts
-- Currently only used by some extras/ scripts:
-- | Parse hledger CLI options from the command line using the given
-- cmdargs mode, and either return them or, if a help flag is present,
-- print the mode help and exit the program.
getCliOpts :: Mode RawOpts -> IO CliOpts
getCliOpts mode' = do
-- | Parse common hledger options from the command line using the given
-- hledger-style cmdargs mode and return them as a CliOpts.
-- Or, when -h or --help is present, print the mode's usage message
-- or the provided long help and exit the program.
--
-- When --debug is present, also prints some debug output.
--
-- The long help is assumed to possibly contain markdown literal blocks
-- delimited by lines beginning with ``` - these delimiters are removed.
-- Also it is assumed to lack a terminating newline, which is added.
--
-- This is useful for addon commands.
getHledgerOptsOrShowHelp :: Mode RawOpts -> String -> IO CliOpts
getHledgerOptsOrShowHelp mode' longhelp = do
args' <- getArgs
let rawopts = decodeRawOpts $ processValue mode' args'
opts <- rawOptsToCliOpts rawopts
debugArgs args' opts
-- if any (`elem` args) ["--help","-h","-?"]
when ("help" `inRawOpts` rawopts_ opts) $ putStrLn longhelp' >> exitSuccess
when ("h" `inRawOpts` rawopts_ opts) $ putStr (showModeUsage mode') >> exitSuccess
when ("help" `inRawOpts` rawopts_ opts) $ printHelpForTopic (topicForMode mode') >> exitSuccess
return opts
where
longhelp' = unlines $ map hideBlockDelimiters $ lines longhelp
where
hideBlockDelimiters ('`':'`':'`':_) = ""
hideBlockDelimiters l = l
-- | Print debug info about arguments and options if --debug is present.
debugArgs :: [String] -> CliOpts -> IO ()
debugArgs args' opts =