addons: add -h & --help to most of them; CliOpts cleanups
This commit is contained in:
parent
1218ca55f0
commit
f4eb9e23e3
@ -2,7 +2,7 @@
|
|||||||
cd "$(dirname "$0")"
|
cd "$(dirname "$0")"
|
||||||
echo "building dependencies"
|
echo "building dependencies"
|
||||||
stack build hledger
|
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"
|
echo "building add-on commands"
|
||||||
for f in hledger-*.hs; do stack ghc $f; done
|
for f in hledger-*.hs; do stack ghc $f; done
|
||||||
echo "add-on commands available:"
|
echo "add-on commands available:"
|
||||||
|
|||||||
@ -7,21 +7,12 @@
|
|||||||
--package cmdargs
|
--package cmdargs
|
||||||
--package colour
|
--package colour
|
||||||
--package data-default
|
--package data-default
|
||||||
|
--package here
|
||||||
--package safe
|
--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 OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Data.Colour
|
import Data.Colour
|
||||||
@ -33,6 +24,7 @@ import Data.Default
|
|||||||
import Data.List
|
import Data.List
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Ord
|
import Data.Ord
|
||||||
|
import Data.String.Here
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Tree
|
import Data.Tree
|
||||||
import Graphics.Rendering.Chart
|
import Graphics.Rendering.Chart
|
||||||
@ -46,6 +38,24 @@ import Text.Printf
|
|||||||
import Hledger
|
import Hledger
|
||||||
import Hledger.Cli hiding (progname,progversion)
|
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
|
-- options
|
||||||
|
|
||||||
-- progname = "hledger-chart"
|
-- progname = "hledger-chart"
|
||||||
@ -55,8 +65,9 @@ defchartoutput = "hledger.svg"
|
|||||||
defchartitems = 10
|
defchartitems = 10
|
||||||
defchartsize = "600x400"
|
defchartsize = "600x400"
|
||||||
|
|
||||||
chartmode = (defCommandMode ["hledger-chart"]) {
|
chartmode :: Mode RawOpts
|
||||||
modeArgs = ([], Just $ argsFlag "[PATTERNS] --add-posting \"ACCT AMTEXPR\" ...")
|
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)"
|
,modeHelp = "generate a pie chart image for the top account balances (of one sign only)"
|
||||||
,modeHelpSuffix=[]
|
,modeHelpSuffix=[]
|
||||||
,modeGroupFlags = Group {
|
,modeGroupFlags = Group {
|
||||||
@ -70,7 +81,6 @@ chartmode = (defCommandMode ["hledger-chart"]) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
-- hledger-chart options, used in hledger-chart and above
|
|
||||||
data ChartOpts = ChartOpts {
|
data ChartOpts = ChartOpts {
|
||||||
chart_output_ :: FilePath
|
chart_output_ :: FilePath
|
||||||
,chart_items_ :: Int
|
,chart_items_ :: Int
|
||||||
@ -84,25 +94,16 @@ defchartopts = ChartOpts
|
|||||||
def
|
def
|
||||||
defcliopts
|
defcliopts
|
||||||
|
|
||||||
-- instance Default CliOpts where def = defcliopts
|
getHledgerChartOpts :: IO ChartOpts
|
||||||
|
getHledgerChartOpts = do
|
||||||
toChartOpts :: RawOpts -> IO ChartOpts
|
cliopts <- getHledgerOptsOrShowHelp chartmode doc
|
||||||
toChartOpts rawopts = do
|
|
||||||
cliopts <- rawOptsToCliOpts rawopts
|
|
||||||
return defchartopts {
|
return defchartopts {
|
||||||
chart_output_ = fromMaybe defchartoutput $ maybestringopt "debug-chart" rawopts
|
chart_output_ = fromMaybe defchartoutput $ maybestringopt "debug-chart" $ rawopts_ cliopts
|
||||||
,chart_items_ = fromMaybe defchartitems $ maybeintopt "debug-items" rawopts
|
,chart_items_ = fromMaybe defchartitems $ maybeintopt "debug-items" $ rawopts_ cliopts
|
||||||
,chart_size_ = fromMaybe defchartsize $ maybestringopt "debug-size" rawopts
|
,chart_size_ = fromMaybe defchartsize $ maybestringopt "debug-size" $ rawopts_ cliopts
|
||||||
,cliopts_ = 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
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
|
|||||||
@ -2,24 +2,37 @@
|
|||||||
{- stack runghc --verbosity info
|
{- stack runghc --verbosity info
|
||||||
--package hledger-lib
|
--package hledger-lib
|
||||||
--package hledger
|
--package hledger
|
||||||
-}
|
--package here
|
||||||
{-
|
|
||||||
|
|
||||||
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.
|
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
|
||||||
|
import Data.String.Here
|
||||||
import Hledger
|
import Hledger
|
||||||
import Hledger.Cli
|
import Hledger.Cli
|
||||||
import Text.Printf
|
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 :: Mode RawOpts
|
||||||
argsmode = (defCommandMode ["check-dates"])
|
argsmode = (defAddonCommandMode "check-dates")
|
||||||
{ modeHelp = "check that transactions' date are monotonically increasing"
|
{ modeHelp = "check that transactions' date are monotonically increasing"
|
||||||
, modeGroupFlags = Group
|
, modeGroupFlags = Group
|
||||||
{ groupNamed =
|
{ groupNamed =
|
||||||
@ -59,7 +72,7 @@ checkTransactions compare ts =
|
|||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
opts <- getCliOpts argsmode
|
opts <- getHledgerOptsOrShowHelp argsmode doc
|
||||||
withJournalDo opts $
|
withJournalDo opts $
|
||||||
\CliOpts{rawopts_=opts,reportopts_=ropts} j -> do
|
\CliOpts{rawopts_=opts,reportopts_=ropts} j -> do
|
||||||
d <- getCurrentDay
|
d <- getCurrentDay
|
||||||
|
|||||||
@ -1,28 +1,39 @@
|
|||||||
#!/usr/bin/env stack
|
#!/usr/bin/env stack
|
||||||
{- stack runghc --verbosity info
|
{- stack runghc --verbosity info
|
||||||
--package hledger-lib
|
--package hledger-lib
|
||||||
|
--package here
|
||||||
--package safe
|
--package safe
|
||||||
--package text
|
--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
|
Reports duplicates in the account tree: account names having the same leaf
|
||||||
but different prefixes. In other words, two or more leaves that are
|
but different prefixes. In other words, two or more leaves that are
|
||||||
categorized differently.
|
categorized differently.
|
||||||
Reads the default journal file, or another specified as an argument.
|
Reads the default journal file, or another specified as an argument.
|
||||||
|
|
||||||
http://stefanorodighiero.net/software/hledger-dupes.html
|
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 :: Journal -> [(String, AccountName)]
|
||||||
accountsNames j = map leafAndAccountName as
|
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))
|
render (leafName, accountNameL) = printf "%s as %s\n" leafName (concat $ intersperse ", " (map T.unpack accountNameL))
|
||||||
|
|
||||||
main = do
|
main = do
|
||||||
args <- getArgs
|
opts <- getHledgerOptsOrShowHelp (defAddonCommandMode "dupes") doc
|
||||||
deffile <- defaultJournalPath
|
withJournalDo opts $ \CliOpts{rawopts_=opts,reportopts_=ropts} j -> do
|
||||||
let file = headDef deffile args
|
|
||||||
j <- readJournalFile Nothing Nothing True file >>= either error' return
|
|
||||||
mapM_ render $ dupes $ accountsNames j
|
mapM_ render $ dupes $ accountsNames j
|
||||||
|
|||||||
@ -2,15 +2,33 @@
|
|||||||
{- stack runghc --verbosity info
|
{- stack runghc --verbosity info
|
||||||
--package hledger-lib
|
--package hledger-lib
|
||||||
--package hledger
|
--package hledger
|
||||||
|
--package here
|
||||||
--package time
|
--package time
|
||||||
-}
|
-}
|
||||||
{-
|
|
||||||
|
|
||||||
hledger-equity [HLEDGEROPTS] [QUERY]
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
|
||||||
Show a "closing balances" transaction that brings the balance of the
|
import Data.Maybe
|
||||||
accounts matched by QUERY (or all accounts) to zero, and an opposite
|
import Data.String.Here
|
||||||
"opening balances" transaction that restores the balances from zero.
|
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
|
The opening balances transaction is useful to carry over
|
||||||
asset/liability balances if you choose to start a new journal file,
|
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.
|
date is not specified, it defaults to today.
|
||||||
|
|
||||||
Example:
|
Example:
|
||||||
|
```
|
||||||
$ hledger equity -f 2015.journal -e 2016/1/1 assets liabilities >>2015.journal
|
$ 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:
|
Open question: how to handle txns spanning a file boundary ? Eg:
|
||||||
|
```journal
|
||||||
2015/12/30 * food
|
2015/12/30 * food
|
||||||
expenses:food:dining $10
|
expenses:food:dining $10
|
||||||
assets:bank:checking -$10 ; date:2016/1/4
|
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.
|
"closing the books" in accounting.
|
||||||
|
|
||||||
-}
|
|]
|
||||||
|
------------------------------------------------------------------------------
|
||||||
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
equitymode :: Mode RawOpts
|
||||||
|
equitymode =
|
||||||
import Data.Maybe (fromMaybe)
|
(defAddonCommandMode "equity")
|
||||||
import Data.Time.Calendar (addDays)
|
{ modeHelp =
|
||||||
import Hledger.Cli
|
"print a \"closing balances\" transaction that brings all accounts"
|
||||||
|
++ " (or with query arguments, just the matched accounts) to a zero balance,"
|
||||||
argsmode :: Mode RawOpts
|
++ " followed by an opposite \"opening balances\" transaction that"
|
||||||
argsmode = (defCommandMode ["equity"])
|
++ " restores the balances from zero."
|
||||||
{ modeHelp = ("print a \"closing balances\" transaction that brings the balance of the"
|
++ " Such transactions can be useful, eg, for bringing account balances across file boundaries."
|
||||||
++ " accounts matched by QUERY (or all accounts) to zero, and an opposite"
|
,modeArgs = ([], Just $ argsFlag "[QUERY]")
|
||||||
++ "\"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 = []
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
opts <- getCliOpts argsmode
|
opts <- getHledgerOptsOrShowHelp equitymode doc
|
||||||
withJournalDo opts $
|
withJournalDo opts $
|
||||||
\CliOpts{reportopts_=ropts} j -> do
|
\CliOpts{reportopts_=ropts} j -> do
|
||||||
today <- getCurrentDay
|
today <- getCurrentDay
|
||||||
|
|||||||
@ -2,23 +2,36 @@
|
|||||||
{- stack runghc --verbosity info
|
{- stack runghc --verbosity info
|
||||||
--package hledger-lib
|
--package hledger-lib
|
||||||
--package hledger
|
--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
|
Print only journal entries which are unique by description (or
|
||||||
something else). Reads the default or specified journal, or stdin.
|
something else). Reads the default or specified journal, or stdin.
|
||||||
|
|
||||||
-}
|
|]
|
||||||
|
------------------------------------------------------------------------------
|
||||||
import Data.List
|
|
||||||
import Data.Ord
|
|
||||||
import Hledger.Cli
|
|
||||||
|
|
||||||
main = do
|
main = do
|
||||||
putStrLn "(-f option not supported)"
|
putStrLn "(-f option not supported)"
|
||||||
opts <- getCliOpts (defCommandMode ["hledger-print-unique"])
|
opts <- getHledgerOptsOrShowHelp (defAddonCommandMode "hledger-print-unique") doc
|
||||||
withJournalDo opts $
|
withJournalDo opts $
|
||||||
\opts j@Journal{jtxns=ts} -> print' opts j{jtxns=uniquify ts}
|
\opts j@Journal{jtxns=ts} -> print' opts j{jtxns=uniquify ts}
|
||||||
where
|
where
|
||||||
|
|||||||
@ -2,25 +2,17 @@
|
|||||||
{- stack runghc --verbosity info
|
{- stack runghc --verbosity info
|
||||||
--package hledger-lib
|
--package hledger-lib
|
||||||
--package hledger
|
--package hledger
|
||||||
|
--package here
|
||||||
--package text
|
--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 OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
|
||||||
import Data.Char (toUpper)
|
import Data.Char (toUpper)
|
||||||
import Data.List
|
import Data.List
|
||||||
|
import Data.String.Here
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
|
||||||
import System.Console.CmdArgs
|
import System.Console.CmdArgs
|
||||||
import System.Console.CmdArgs.Explicit
|
import System.Console.CmdArgs.Explicit
|
||||||
|
|
||||||
@ -28,7 +20,28 @@ import Hledger
|
|||||||
import Hledger.Cli.CliOptions
|
import Hledger.Cli.CliOptions
|
||||||
import Hledger.Cli ( withJournalDo, postingsReportAsText )
|
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 :: CliOpts -> Journal -> IO ()
|
||||||
match opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
|
match opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j = do
|
||||||
|
|||||||
@ -2,47 +2,17 @@
|
|||||||
{- stack runghc --verbosity info
|
{- stack runghc --verbosity info
|
||||||
--package hledger-lib
|
--package hledger-lib
|
||||||
--package hledger
|
--package hledger
|
||||||
|
--package here
|
||||||
--package megaparsec
|
--package megaparsec
|
||||||
--package text
|
--package text
|
||||||
--package Diff
|
--package Diff
|
||||||
-}
|
-}
|
||||||
{-# LANGUAGE OverloadedStrings, LambdaCase, DeriveTraversable, ViewPatterns #-}
|
|
||||||
{-
|
|
||||||
|
|
||||||
hledger-rewrite [PATTERNS] --add-posting "ACCT AMTEXPR" ...
|
{-# LANGUAGE OverloadedStrings, LambdaCase, DeriveTraversable, ViewPatterns, QuasiQuotes #-}
|
||||||
|
|
||||||
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
|
|
||||||
|
|
||||||
-}
|
|
||||||
|
|
||||||
import Control.Monad.Writer
|
import Control.Monad.Writer
|
||||||
import Data.List (sortOn, foldl')
|
import Data.List (sortOn, foldl')
|
||||||
|
import Data.String.Here
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
-- hledger lib, cli and cmdargs utils
|
-- hledger lib, cli and cmdargs utils
|
||||||
import Hledger.Cli hiding (outputflags)
|
import Hledger.Cli hiding (outputflags)
|
||||||
@ -55,9 +25,59 @@ import Text.Megaparsec
|
|||||||
import qualified Data.Algorithm.Diff as D
|
import qualified Data.Algorithm.Diff as D
|
||||||
import Hledger.Data.AutoTransaction (runModifierTransaction)
|
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 :: Mode RawOpts
|
||||||
cmdmode = (defCommandMode ["hledger-rewrite"]) {
|
cmdmode = (defAddonCommandMode "hledger-rewrite") {
|
||||||
modeArgs = ([], Just $ argsFlag "[PATTERNS] --add-posting \"ACCT AMTEXPR\" ...")
|
modeArgs = ([], Just $ argsFlag "[QUERY] --add-posting \"ACCT AMTEXPR\" ...")
|
||||||
,modeHelp = "print all journal entries, with custom postings added to the matched ones"
|
,modeHelp = "print all journal entries, with custom postings added to the matched ones"
|
||||||
,modeGroupFlags = Group {
|
,modeGroupFlags = Group {
|
||||||
groupNamed = [("Input", inputflags)
|
groupNamed = [("Input", inputflags)
|
||||||
@ -178,7 +198,7 @@ mapDiff = \case
|
|||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} <- getCliOpts cmdmode
|
opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} <- getHledgerOptsOrShowHelp cmdmode doc
|
||||||
d <- getCurrentDay
|
d <- getCurrentDay
|
||||||
let q = queryFromOpts d ropts
|
let q = queryFromOpts d ropts
|
||||||
modifier <- modifierTransactionFromOpts rawopts
|
modifier <- modifierTransactionFromOpts rawopts
|
||||||
|
|||||||
@ -28,7 +28,7 @@ module Hledger.Cli.CliOptions (
|
|||||||
-- * CLI options
|
-- * CLI options
|
||||||
CliOpts(..),
|
CliOpts(..),
|
||||||
defcliopts,
|
defcliopts,
|
||||||
getCliOpts,
|
getHledgerOptsOrShowHelp,
|
||||||
decodeRawOpts,
|
decodeRawOpts,
|
||||||
rawOptsToCliOpts,
|
rawOptsToCliOpts,
|
||||||
checkCliOpts,
|
checkCliOpts,
|
||||||
@ -165,13 +165,14 @@ generalflagsgroup3 = (generalflagstitle, helpflags)
|
|||||||
|
|
||||||
-- cmdargs mode constructors
|
-- cmdargs mode constructors
|
||||||
|
|
||||||
-- | A basic mode template.
|
-- | A basic cmdargs mode template with a single flag: -h.
|
||||||
defMode :: Mode RawOpts
|
defMode :: Mode RawOpts
|
||||||
defMode = Mode {
|
defMode = Mode {
|
||||||
modeNames = []
|
modeNames = []
|
||||||
,modeHelp = ""
|
,modeHelp = ""
|
||||||
,modeHelpSuffix = []
|
,modeHelpSuffix = []
|
||||||
,modeValue = []
|
,modeValue = []
|
||||||
|
,modeArgs = ([], Nothing)
|
||||||
,modeCheck = Right
|
,modeCheck = Right
|
||||||
,modeReform = const Nothing
|
,modeReform = const Nothing
|
||||||
,modeExpandAt = True
|
,modeExpandAt = True
|
||||||
@ -179,14 +180,16 @@ defMode = Mode {
|
|||||||
groupNamed = []
|
groupNamed = []
|
||||||
,groupUnnamed = [
|
,groupUnnamed = [
|
||||||
flagNone ["h"] (setboolopt "h") "Show command usage."
|
flagNone ["h"] (setboolopt "h") "Show command usage."
|
||||||
|
-- ,flagNone ["help"] (setboolopt "help") "Show long help."
|
||||||
]
|
]
|
||||||
,groupHidden = []
|
,groupHidden = []
|
||||||
}
|
}
|
||||||
,modeArgs = ([], Nothing)
|
|
||||||
,modeGroupModes = toGroup []
|
,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 :: [Name] -> Mode RawOpts
|
||||||
defCommandMode names = defMode {
|
defCommandMode names = defMode {
|
||||||
modeNames=names
|
modeNames=names
|
||||||
@ -194,22 +197,20 @@ defCommandMode names = defMode {
|
|||||||
,modeArgs = ([], Just $ argsFlag "[QUERY]")
|
,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 :: Name -> Mode RawOpts
|
||||||
defAddonCommandMode addon = defMode {
|
defAddonCommandMode name = (defCommandMode [name]) {
|
||||||
modeNames = [addon]
|
modeHelp = fromMaybe "" $ lookup (stripAddonExtension name) standardAddonsHelp
|
||||||
,modeHelp = fromMaybe "" $ lookup (stripAddonExtension addon) standardAddonsHelp
|
|
||||||
,modeValue=[("command",addon)]
|
|
||||||
,modeGroupFlags = Group {
|
,modeGroupFlags = Group {
|
||||||
groupUnnamed = []
|
groupUnnamed = []
|
||||||
,groupHidden = []
|
,groupHidden = []
|
||||||
,groupNamed = [generalflagsgroup1]
|
,groupNamed = [generalflagsgroup1]
|
||||||
}
|
}
|
||||||
,modeArgs = ([], Just $ argsFlag "[ARGS]")
|
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Built-in descriptions for some of the known external addons,
|
-- | Built-in descriptions for some of the known addons.
|
||||||
-- since we don't currently have any way to ask them.
|
|
||||||
standardAddonsHelp :: [(String,String)]
|
standardAddonsHelp :: [(String,String)]
|
||||||
standardAddonsHelp = [
|
standardAddonsHelp = [
|
||||||
("chart", "generate simple balance pie charts")
|
("chart", "generate simple balance pie charts")
|
||||||
@ -360,21 +361,32 @@ checkCliOpts opts =
|
|||||||
Right _ -> Right ()
|
Right _ -> Right ()
|
||||||
-- XXX check registerWidthsFromOpts opts
|
-- XXX check registerWidthsFromOpts opts
|
||||||
|
|
||||||
-- Currently only used by some extras/ scripts:
|
-- | Parse common hledger options from the command line using the given
|
||||||
-- | Parse hledger CLI options from the command line using the given
|
-- hledger-style cmdargs mode and return them as a CliOpts.
|
||||||
-- cmdargs mode, and either return them or, if a help flag is present,
|
-- Or, when -h or --help is present, print the mode's usage message
|
||||||
-- print the mode help and exit the program.
|
-- or the provided long help and exit the program.
|
||||||
getCliOpts :: Mode RawOpts -> IO CliOpts
|
--
|
||||||
getCliOpts mode' = do
|
-- 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
|
args' <- getArgs
|
||||||
let rawopts = decodeRawOpts $ processValue mode' args'
|
let rawopts = decodeRawOpts $ processValue mode' args'
|
||||||
opts <- rawOptsToCliOpts rawopts
|
opts <- rawOptsToCliOpts rawopts
|
||||||
debugArgs args' opts
|
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 ("h" `inRawOpts` rawopts_ opts) $ putStr (showModeUsage mode') >> exitSuccess
|
||||||
when ("help" `inRawOpts` rawopts_ opts) $ printHelpForTopic (topicForMode mode') >> exitSuccess
|
|
||||||
return opts
|
return opts
|
||||||
where
|
where
|
||||||
|
longhelp' = unlines $ map hideBlockDelimiters $ lines longhelp
|
||||||
|
where
|
||||||
|
hideBlockDelimiters ('`':'`':'`':_) = ""
|
||||||
|
hideBlockDelimiters l = l
|
||||||
-- | Print debug info about arguments and options if --debug is present.
|
-- | Print debug info about arguments and options if --debug is present.
|
||||||
debugArgs :: [String] -> CliOpts -> IO ()
|
debugArgs :: [String] -> CliOpts -> IO ()
|
||||||
debugArgs args' opts =
|
debugArgs args' opts =
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user