diff --git a/bin/compile.sh b/bin/compile.sh index 0879c9c50..89b5a88b3 100755 --- a/bin/compile.sh +++ b/bin/compile.sh @@ -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:" diff --git a/bin/hledger-chart.hs b/bin/hledger-chart.hs index f935e85a5..c810b602a 100755 --- a/bin/hledger-chart.hs +++ b/bin/hledger-chart.hs @@ -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 -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 +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 () diff --git a/bin/hledger-check-dates.hs b/bin/hledger-check-dates.hs index c53396358..830b94b7a 100755 --- a/bin/hledger-check-dates.hs +++ b/bin/hledger-check-dates.hs @@ -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 diff --git a/bin/hledger-dupes.hs b/bin/hledger-dupes.hs index 2fe23bcbc..fed8a7c28 100755 --- a/bin/hledger-dupes.hs +++ b/bin/hledger-dupes.hs @@ -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 - mapM_ render $ dupes $ accountsNames j + opts <- getHledgerOptsOrShowHelp (defAddonCommandMode "dupes") doc + withJournalDo opts $ \CliOpts{rawopts_=opts,reportopts_=ropts} j -> do + mapM_ render $ dupes $ accountsNames j diff --git a/bin/hledger-equity.hs b/bin/hledger-equity.hs index 6c585c612..76f6c3ee0 100755 --- a/bin/hledger-equity.hs +++ b/bin/hledger-equity.hs @@ -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 diff --git a/bin/hledger-print-unique.hs b/bin/hledger-print-unique.hs index 20de1d394..f7f9920d4 100755 --- a/bin/hledger-print-unique.hs +++ b/bin/hledger-print-unique.hs @@ -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 diff --git a/bin/hledger-register-match.hs b/bin/hledger-register-match.hs index 44ef03834..f855b4516 100755 --- a/bin/hledger-register-match.hs +++ b/bin/hledger-register-match.hs @@ -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 diff --git a/bin/hledger-rewrite.hs b/bin/hledger-rewrite.hs index dfaa95a85..b5246f496 100755 --- a/bin/hledger-rewrite.hs +++ b/bin/hledger-rewrite.hs @@ -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 diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index c4e7a61d7..2d391a680 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -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 =