hledger 0.23.3 → 0.24
raw patch · 19 files changed
+538/−220 lines, 19 filesdep +htmldep +regex-tdfadep ~hledgerdep ~hledger-libdep ~parsecPVP ok
version bump matches the API change (PVP)
Dependencies added: html, regex-tdfa
Dependency ranges changed: hledger, hledger-lib, parsec
API changes (from Hackage documentation)
- Hledger.Cli.Options: formatFromOpts :: ReportOpts -> Either String [OutputFormat]
+ Hledger.Cli.Options: defaultOutputFormat :: [Char]
+ Hledger.Cli.Options: detailedversionflag :: Flag RawOpts
+ Hledger.Cli.Options: ignore_assertions_ :: CliOpts -> Bool
+ Hledger.Cli.Options: lineFormatFromOpts :: ReportOpts -> Either String [OutputFormat]
+ Hledger.Cli.Options: maybeAccountNameDrop :: ReportOpts -> AccountName -> AccountName
+ Hledger.Cli.Options: outputFileFromOpts :: CliOpts -> IO FilePath
+ Hledger.Cli.Options: outputFormatFromOpts :: CliOpts -> String
+ Hledger.Cli.Options: outputFormats :: [[Char]]
+ Hledger.Cli.Options: output_file_ :: CliOpts -> Maybe FilePath
+ Hledger.Cli.Options: output_format_ :: CliOpts -> Maybe String
+ Hledger.Cli.Options: outputflags :: [Flag RawOpts]
+ Hledger.Cli.Utils: writeOutput :: CliOpts -> String -> IO ()
+ Hledger.Cli.Version: prognameanddetailedversion :: String
- Hledger.Cli.Add: amountAndCommentWizard :: EntryState -> Wizard Haskeline (Amount, [Char])
+ Hledger.Cli.Add: amountAndCommentWizard :: EntryState -> Wizard Haskeline (Amount, String)
- Hledger.Cli.Add: dateAndCodeWizard :: EntryState -> Wizard Haskeline (Day, [Char])
+ Hledger.Cli.Add: dateAndCodeWizard :: EntryState -> Wizard Haskeline (Day, String)
- Hledger.Cli.Add: withCompletion :: :<: WithSettings b => CompletionFunc IO -> Wizard b a -> Wizard b a
+ Hledger.Cli.Add: withCompletion :: (:<:) WithSettings b => CompletionFunc IO -> Wizard b a -> Wizard b a
- Hledger.Cli.Balance: balanceReportAsText :: ReportOpts -> BalanceReport -> [String]
+ Hledger.Cli.Balance: balanceReportAsText :: ReportOpts -> BalanceReport -> String
- Hledger.Cli.Balance: cumulativeBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> [String]
+ Hledger.Cli.Balance: cumulativeBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String
- Hledger.Cli.Balance: historicalBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> [String]
+ Hledger.Cli.Balance: historicalBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String
- Hledger.Cli.Balance: periodBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> [String]
+ Hledger.Cli.Balance: periodBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String
- Hledger.Cli.Histogram: printDayWith :: PrintfType (t2 -> t) => (t1 -> t2) -> (DateSpan, t1) -> t
+ Hledger.Cli.Histogram: printDayWith :: (PrintfArg t2, PrintfType t1) => (t -> t2) -> (DateSpan, t) -> t1
- Hledger.Cli.Options: CliOpts :: RawOpts -> String -> Maybe FilePath -> Maybe FilePath -> [String] -> Int -> Bool -> Maybe String -> ReportOpts -> CliOpts
+ Hledger.Cli.Options: CliOpts :: RawOpts -> String -> Maybe FilePath -> Maybe FilePath -> Maybe FilePath -> Maybe String -> [String] -> Bool -> Int -> Bool -> Maybe String -> ReportOpts -> CliOpts
Files
- CHANGES +91/−1
- Hledger/Cli.hs +19/−12
- Hledger/Cli/Accounts.hs +1/−1
- Hledger/Cli/Add.hs +21/−19
- Hledger/Cli/Balance.hs +87/−44
- Hledger/Cli/Balancesheet.hs +3/−3
- Hledger/Cli/Cashflow.hs +2/−2
- Hledger/Cli/Histogram.hs +1/−1
- Hledger/Cli/Incomestatement.hs +2/−2
- Hledger/Cli/Main.hs +7/−3
- Hledger/Cli/Options.hs +115/−44
- Hledger/Cli/Print.hs +48/−10
- Hledger/Cli/Register.hs +64/−22
- Hledger/Cli/Stats.hs +1/−2
- Hledger/Cli/Utils.hs +14/−4
- Hledger/Cli/Version.hs +5/−2
- app/hledger-cli.hs +6/−0
- hledger-cli.hs +0/−6
- hledger.cabal +51/−42
CHANGES view
@@ -1,6 +1,96 @@+User-visible changes in hledger (see also hledger-lib):++0.24 (unreleased)++General:+- fix redundant compilation when cabal installing the hledger packages+- switch to Decimal for representing amounts (#118)+- report interval headings (eg in balance, register reports) are shown+ compactly when possible+- general speedups++Journal format:+- detect decimal point and digit groups more robustly (#196)+- check that transaction dates are followed by whitespace or newline+- check that dates use a consistent separator character+- balance assertions now are specific to a single commodity, like+ Ledger (#195)+- support multi-line comments using "comment", "end comment"+ directives, like Ledger++CSV format:+- reading CSV data from stdin now works better+- the rules file include directive is now relative to the current+ file's directory (#198)+- the original order of same-day transactions is now usually preserved+ (if the records appear to be in reverse date order, we reverse them+ before finally sorting by transaction date)+- CSV output is now built in to the balance, print, and register+ commands, controlled by -O/--output-format (and -o/--output-file,+ see below)++CLI:+- the --width and --debug options now require their argument (#149)+- when an option is repeated, the last value takes precedence (#219).+ This is helpful eg for customising your reporting command aliases on+ the fly.+- smart dates (used in -p/-b/-e/date:/date2:) now must use a+ consistent separator character, and must be parseable to the end+- output destination and format selection is now built in to the+ balance, print and register commands, controlled by -o/--output-file+ and -O/--output-format options. Notes:+ - -o - means stdout+ - an output file name suffix matching a supported format will also+ set the output format, unless overridden by --output-format+ - commands' supported output formats are listed in their+ command-line help. Two formats are currently available:+ txt (the default) and csv.+- balance assertions can be disabled with --ignore-assertions++Account aliases:+- all matching account aliases are now applied, not just one directive+ and one option+- account aliases now match by case insensitive regular expressions+ matching anywhere in the account name+- account aliases can replace multiple occurrences of the pattern+ within an account name+- an account alias replacement pattern can reference matched groups+ with \N++Queries:+- date:/date2: with a malformed date now reports an error instead of+ being ignored+- amt: now supports >= or <=+- clarify status: docs and behaviour; "*" is no longer a synonym for+ "1" (fixes #227)++balance:+- fix: in tree mode, --drop is ignored instead of showing empty account names+- a depth limit of 0 now shows summary items with account name "...",+ instead of an empty report (#206)+- in multicolumn balance reports, -E now also shows posting-less+ accounts with a non-zero balance during the period (in addition to+ showing leading & trailing empty columns)+- in multicolumn reports, multi-commodity amounts are rendered on one+ line for better layout (#186)+- multicolumn reports' title now includes the report span++register:+- runs faster with large output+- supports date2:, and date:/date2: combined with --date2, better (fixes+ #201, #221, #222)+- a depth limit of 0 now shows summary items (see balance)+- -A/--average now implies -E/--empty+- postings with multi-commodity amounts are now top-aligned, like+ Ledger++Extra commands:+- hledger-equity: fix end date in title; print closing entry too+- hledger-check-dates: added+ 0.23.3 (2014/9/12) -- allow text 1.2+ (fixes #207)+- allow text 1.2+ (#207) 0.23.2 (2014/5/8)
Hledger/Cli.hs view
@@ -1,4 +1,4 @@-{-| +{-| Hledger.Cli re-exports the options, utilities and commands provided by the hledger command-line program. This module also aggregates the@@ -63,24 +63,25 @@ ,"account directive" ~:- let sameParse str1 str2 = do j1 <- readJournal Nothing Nothing Nothing str1 >>= either error' return- j2 <- readJournal Nothing Nothing Nothing str2 >>= either error' return+ let ignoresourcepos j = j{jtxns=map (\t -> t{tsourcepos=nullsourcepos}) (jtxns j)} in+ let sameParse str1 str2 = do j1 <- readJournal Nothing Nothing True Nothing str1 >>= either error' (return . ignoresourcepos)+ j2 <- readJournal Nothing Nothing True Nothing str2 >>= either error' (return . ignoresourcepos) j1 `is` j2{filereadtime=filereadtime j1, files=files j1, jContext=jContext j1} in TestList [- "account directive 1" ~: sameParse + "account directive 1" ~: sameParse "2008/12/07 One\n test:from $-1\n test:to $1\n" "!account test\n2008/12/07 One\n from $-1\n to $1\n" - ,"account directive 2" ~: sameParse + ,"account directive 2" ~: sameParse "2008/12/07 One\n test:foo:from $-1\n test:foo:to $1\n" "!account test\n!account foo\n2008/12/07 One\n from $-1\n to $1\n" - ,"account directive 3" ~: sameParse + ,"account directive 3" ~: sameParse "2008/12/07 One\n test:from $-1\n test:to $1\n" "!account test\n!account foo\n!end\n2008/12/07 One\n from $-1\n to $1\n" - ,"account directive 4" ~: sameParse + ,"account directive 4" ~: sameParse ("2008/12/07 One\n alpha $-1\n beta $1\n" ++ "!account outer\n2008/12/07 Two\n aigh $-2\n bee $2\n" ++ "!account inner\n2008/12/07 Three\n gamma $-3\n delta $3\n" ++@@ -95,7 +96,7 @@ ) ,"account directive should preserve \"virtual\" posting type" ~: do- j <- readJournal Nothing Nothing Nothing "!account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return+ j <- readJournal Nothing Nothing True Nothing "!account test\n2008/12/07 One\n (from) $-1\n (to) $1\n" >>= either error' return let p = head $ tpostings $ head $ jtxns j assertBool "" $ paccount p == "test:from" assertBool "" $ ptype p == VirtualPosting@@ -103,7 +104,7 @@ ] ,"account aliases" ~: do- j <- readJournal Nothing Nothing Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return+ j <- readJournal Nothing Nothing True Nothing "!alias expenses = equity:draw:personal\n1/1\n (expenses:food) 1\n" >>= either error' return let p = head $ tpostings $ head $ jtxns j assertBool "" $ paccount p == "equity:draw:personal:food" @@ -125,7 +126,7 @@ -- `is` "aa:aa:aaaaaaaaaaaaaa") ,"default year" ~: do- j <- readJournal Nothing Nothing Nothing defaultyear_journal_str >>= either error' return+ j <- readJournal Nothing Nothing True Nothing defaultyear_journal_str >>= either error' return tdate (head $ jtxns j) `is` fromGregorian 2009 1 1 return () @@ -135,7 +136,7 @@ ] - + -- fixtures/test data -- date1 = parsedate "2008/11/26"@@ -339,9 +340,10 @@ -- ] journal7 :: Journal-journal7 = nulljournal {jtxns = +journal7 = nulljournal {jtxns = [ txnTieKnot Transaction {+ tsourcepos=nullsourcepos, tdate=parsedate "2007/01/01", tdate2=Nothing, tstatus=False,@@ -357,6 +359,7 @@ } , txnTieKnot Transaction {+ tsourcepos=nullsourcepos, tdate=parsedate "2007/02/01", tdate2=Nothing, tstatus=False,@@ -372,6 +375,7 @@ } , txnTieKnot Transaction {+ tsourcepos=nullsourcepos, tdate=parsedate "2007/01/02", tdate2=Nothing, tstatus=False,@@ -387,6 +391,7 @@ } , txnTieKnot Transaction {+ tsourcepos=nullsourcepos, tdate=parsedate "2007/01/03", tdate2=Nothing, tstatus=False,@@ -402,6 +407,7 @@ } , txnTieKnot Transaction {+ tsourcepos=nullsourcepos, tdate=parsedate "2007/01/03", tdate2=Nothing, tstatus=False,@@ -417,6 +423,7 @@ } , txnTieKnot Transaction {+ tsourcepos=nullsourcepos, tdate=parsedate "2007/01/03", tdate2=Nothing, tstatus=False,
Hledger/Cli/Accounts.hs view
@@ -56,7 +56,7 @@ as' | tree_ ropts = expandAccountNames as | otherwise = as render a | tree_ ropts = replicate (2 * (accountNameLevel a - 1)) ' ' ++ accountLeafName a- | otherwise = accountNameDrop (drop_ ropts) a+ | otherwise = maybeAccountNameDrop ropts a mapM_ (putStrLn . render) as' tests_Hledger_Cli_Accounts = TestList []
Hledger/Cli/Add.hs view
@@ -20,10 +20,10 @@ import System.Console.CmdArgs.Explicit import System.Console.Haskeline (runInputT, defaultSettings, setComplete) import System.Console.Haskeline.Completion-import System.Console.Wizard +import System.Console.Wizard import System.Console.Wizard.Haskeline import System.IO ( stderr, hPutStr, hPutStrLn )-import Text.ParserCombinators.Parsec hiding (Line)+import Text.Parsec import Text.Printf import Hledger@@ -128,9 +128,9 @@ -- liftIO $ hPrintf stderr {- "Transaction entered:\n%s" -} (show t) output $ show t y <- let def = "y" in- retryMsg "Please enter y or n." $ - parser ((fmap ('y' ==)) . headMay . map toLower . strip) $ - defaultTo' def $ nonEmpty $ + retryMsg "Please enter y or n." $+ parser ((fmap ('y' ==)) . headMay . map toLower . strip) $+ defaultTo' def $ nonEmpty $ maybeRestartTransaction $ line $ green $ printf "Save this transaction to the journal ?%s: " (showDefault def) if y then return t else throw RestartTransactionException@@ -167,10 +167,10 @@ dateAndCodeWizard EntryState{..} = do let def = headDef (showDate esDefDate) esArgs- retryMsg "A valid hledger smart date is required. Eg: 2014/2/14, 14, yesterday." $ - parser (parseSmartDateAndCode esToday) $ + retryMsg "A valid hledger smart date is required. Eg: 2014/2/14, 14, yesterday." $+ parser (parseSmartDateAndCode esToday) $ withCompletion (dateCompleter def) $- defaultTo' def $ nonEmpty $ + defaultTo' def $ nonEmpty $ maybeExit $ maybeRestartTransaction $ -- maybeShowHelp $@@ -178,7 +178,8 @@ where parseSmartDateAndCode refdate s = either (const Nothing) (\(d,c) -> return (fixSmartDate refdate d, c)) edc where- edc = parseWithCtx nullctx dateandcodep $ lowercase s+ edc = runParser dateandcodep nullctx "" $ lowercase s+ dateandcodep :: Stream [Char] m t => ParsecT [Char] JournalContext m (SmartDate, String) dateandcodep = do d <- smartdate c <- optionMaybe codep@@ -191,7 +192,7 @@ descriptionAndCommentWizard EntryState{..} = do let def = headDef "" esArgs s <- withCompletion (descriptionCompleter esJournal def) $- defaultTo' def $ nonEmpty $ + defaultTo' def $ nonEmpty $ maybeRestartTransaction $ line $ green $ printf "Description%s: " (showDefault def) let (desc,comment) = (strip a, strip $ dropWhile (==';') b) where (a,b) = break (==';') s@@ -213,7 +214,7 @@ let es1 = es{esArgs=drop 1 esArgs} (amt,comment) <- amountAndCommentWizard es1 return $ Just nullposting{paccount=stripbrackets acct- ,pamount=mixed amt+ ,pamount=Mixed [amt] ,pcomment=comment ,ptype=accountNamePostingType acct }@@ -233,7 +234,7 @@ retryMsg "A valid hledger account name is required. Eg: assets:cash, expenses:food:eating out." $ parser (parseAccountOrDotOrNull def canfinish) $ withCompletion (accountCompleter esJournal def) $- defaultTo' def $ -- nonEmpty $ + defaultTo' def $ -- nonEmpty $ maybeRestartTransaction $ line $ green $ printf "Account %d%s%s: " pnum (endmsg::String) (showDefault def) where@@ -241,7 +242,7 @@ parseAccountOrDotOrNull _ _ "." = dbg $ Just "." -- . always signals end of txn parseAccountOrDotOrNull "" True "" = dbg $ Just "" -- when there's no default and txn is balanced, "" also signals end of txn parseAccountOrDotOrNull def@(_:_) _ "" = dbg $ Just def -- when there's a default, "" means use that- parseAccountOrDotOrNull _ _ s = dbg $ either (const Nothing) validateAccount $ parseWithCtx (jContext esJournal) accountnamep s -- otherwise, try to parse the input as an accountname+ parseAccountOrDotOrNull _ _ s = dbg $ either (const Nothing) validateAccount $ runParser accountnamep (jContext esJournal) "" s -- otherwise, try to parse the input as an accountname dbg = id -- strace validateAccount s | no_new_accounts_ esOpts && not (s `elem` journalAccountNames esJournal) = Nothing | otherwise = Just s@@ -259,14 +260,15 @@ _ | pnum > 1 && not (isZeroMixedAmount balancingamt) -> showamt balancingamt _ -> "" retryMsg "A valid hledger amount is required. Eg: 1, $2, 3 EUR, \"4 red apples\"." $- parser parseAmountAndComment $ + parser parseAmountAndComment $ withCompletion (amountCompleter def) $- defaultTo' def $ nonEmpty $ + defaultTo' def $ nonEmpty $ maybeRestartTransaction $ line $ green $ printf "Amount %d%s: " pnum (showDefault def)- where - parseAmountAndComment = either (const Nothing) Just . parseWithCtx nodefcommodityctx amountandcommentp- nodefcommodityctx = (jContext esJournal){ctxCommodityAndStyle=Nothing}+ where+ parseAmountAndComment = either (const Nothing) Just . runParser amountandcommentp nodefcommodityctx ""+ nodefcommodityctx = (jContext esJournal){ctxDefaultCommodityAndStyle=Nothing}+ amountandcommentp :: Stream [Char] m t => ParsecT [Char] JournalContext m (Amount, String) amountandcommentp = do a <- amountp many spacenonewline@@ -298,7 +300,7 @@ maybeRestartTransaction = parser (\s -> if s=="<" then throw RestartTransactionException else Just s) -- maybeShowHelp :: Wizard Haskeline String -> Wizard Haskeline String--- maybeShowHelp wizard = maybe (liftIO showHelp >> wizard) return $ +-- maybeShowHelp wizard = maybe (liftIO showHelp >> wizard) return $ -- parser (\s -> if s=="?" then Nothing else Just s) wizard -- Completion helpers
Hledger/Cli/Balance.hs view
@@ -129,7 +129,7 @@ period. Here, checking's balance increased by 10 in Feb: > Change of balance (flow):- > + > > Jan Feb Mar > assets:checking 20 10 -5 @@ -138,7 +138,7 @@ Here, 30 is the sum of checking postings during Jan and Feb: > Ending balance (cumulative):- > + > > Jan Feb Mar > assets:checking 20 30 25 @@ -148,7 +148,7 @@ pre-Jan postings which created a starting balance of 100: > Ending balance (historical):- > + > > Jan Feb Mar > assets:checking 120 130 125 @@ -161,7 +161,7 @@ * An account less deep than the report's max depth, with just one interesting subaccount, and the same balance as the subaccount, is non-interesting, and prefixed to the subaccount's line, unless-@--no-elide@ is in effect. +@--no-elide@ is in effect. * An account with a zero inclusive balance and less than two interesting subaccounts is not displayed at all, unless @--empty@ is in effect.@@ -242,20 +242,17 @@ ,tests_Hledger_Cli_Balance ) where -import Data.List-import Data.Maybe--- import System.Console.CmdArgs import System.Console.CmdArgs.Explicit as C--- import System.Console.CmdArgs.Text+import Text.CSV import Test.HUnit+import Text.Printf (printf) import Text.Tabular as T import Text.Tabular.AsciiArt import Hledger-import Prelude hiding (putStr)-import Hledger.Utils.UTF8IOCompat (putStr) import Hledger.Data.OutputFormat import Hledger.Cli.Options+import Hledger.Cli.Utils -- | Command line options for this command.@@ -272,6 +269,7 @@ ,flagNone ["cumulative"] (\opts -> setboolopt "cumulative" opts) "multicolumn mode: show accumulated ending balances" ,flagNone ["historical","H"] (\opts -> setboolopt "historical" opts) "multicolumn mode: show historical ending balances" ]+ ++ outputflags ,groupHidden = [] ,groupNamed = [generalflagsgroup1] }@@ -280,24 +278,48 @@ -- | The balance command, prints a balance report. balance :: CliOpts -> Journal -> IO ()-balance CliOpts{reportopts_=ropts} j = do+balance opts@CliOpts{reportopts_=ropts} j = do d <- getCurrentDay- let output =- case formatFromOpts ropts of- Left err -> [err]- Right _ ->- case (intervalFromOpts ropts, balancetype_ ropts) of- (NoInterval,_) -> balanceReportAsText ropts $ balanceReport ropts (queryFromOpts d ropts) j- (_,PeriodBalance) -> periodBalanceReportAsText ropts $ multiBalanceReport ropts (queryFromOpts d ropts) j- (_,CumulativeBalance) -> cumulativeBalanceReportAsText ropts $ multiBalanceReport ropts (queryFromOpts d ropts) j- (_,HistoricalBalance) -> historicalBalanceReportAsText ropts $ multiBalanceReport ropts (queryFromOpts d ropts) j- putStr $ unlines output+ case lineFormatFromOpts ropts of+ Left err -> error' $ unlines [err]+ Right _ -> do+ let format = outputFormatFromOpts opts+ interval = intervalFromOpts ropts+ baltype = balancetype_ ropts+ case interval of+ NoInterval -> do+ let report = balanceReport ropts (queryFromOpts d ropts) j+ render = case format of+ "csv" -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r+ _ -> balanceReportAsText+ writeOutput opts $ render ropts report+ _ -> do+ let report = multiBalanceReport ropts (queryFromOpts d ropts) j+ render = case format of+ "csv" -> \ropts r -> (++ "\n") $ printCSV $ multiBalanceReportAsCsv ropts r+ _ -> case baltype of+ PeriodBalance -> periodBalanceReportAsText+ CumulativeBalance -> cumulativeBalanceReportAsText+ HistoricalBalance -> historicalBalanceReportAsText+ writeOutput opts $ render ropts report --- | Render an old-style single-column balance report as plain text.-balanceReportAsText :: ReportOpts -> BalanceReport -> [String]-balanceReportAsText opts ((items, total)) = concat lines ++ t+-- single-column balance reports++-- | Render a single-column balance report as CSV.+balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV+balanceReportAsCsv opts (items, total) =+ ["account","balance"] :+ [[a, showMixedAmountWithoutPrice b] | ((a, _, _), b) <- items]+ +++ if no_total_ opts+ then []+ else [["total", showMixedAmountOneLineWithoutPrice total]]++-- | Render a single-column balance report as plain text.+balanceReportAsText :: ReportOpts -> BalanceReport -> String+balanceReportAsText opts ((items, total)) = unlines $ concat lines ++ t where- lines = case formatFromOpts opts of+ lines = case lineFormatFromOpts opts of Right f -> map (balanceReportItemAsText opts f) items Left err -> [[err]] t = if no_total_ opts@@ -314,6 +336,7 @@ "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" let opts = defreportopts balanceReportAsText opts (balanceReport opts (queryFromOpts (parsedate "2008/11/26") opts) j) `is`+ unlines [" -100 актив:наличные" ," 100 расходы:покупки" ,"--------------------"@@ -337,7 +360,7 @@ -- 'amounts' could contain several quantities of the same commodity with different price. -- In order to combine them into single value (which is expected) we take the first price and -- use it for the whole mixed amount. This could be suboptimal. XXX- let Mixed normAmounts = normaliseMixedAmountPreservingFirstPrice (Mixed amounts) in+ let Mixed normAmounts = normaliseMixedAmountSquashPricesForDisplay (Mixed amounts) in case normAmounts of [] -> [] [a] -> [formatBalanceReportItem opts (Just accountName) depth a format]@@ -359,22 +382,35 @@ formatField :: ReportOpts -> Maybe AccountName -> Int -> Amount -> Bool -> Maybe Int -> Maybe Int -> HledgerFormatField -> String formatField opts accountName depth total ljust min max field = case field of- AccountField -> formatValue ljust min max $ maybe "" (accountNameDrop (drop_ opts)) accountName+ AccountField -> formatValue ljust min max $ maybe "" (maybeAccountNameDrop opts) accountName DepthSpacerField -> case min of Just m -> formatValue ljust Nothing max $ replicate (depth * m) ' ' Nothing -> formatValue ljust Nothing max $ replicate depth ' ' TotalField -> formatValue ljust min max $ showAmountWithoutPrice total _ -> "" +-- multi-column balance reports++-- | Render a multi-column balance report as CSV.+multiBalanceReportAsCsv :: ReportOpts -> MultiBalanceReport -> CSV+multiBalanceReportAsCsv opts (MultiBalanceReport (colspans, items, coltotals)) =+ ("account" : "short account" : "indent" : map showDateSpan colspans) :+ [a : a' : show i : map showMixedAmountOneLineWithoutPrice amts | ((a,a',i), amts) <- items]+ +++ if no_total_ opts+ then []+ else [["totals", "", ""] ++ map showMixedAmountOneLineWithoutPrice coltotals]+ -- | Render a multi-column period balance report as plain text suitable for console output.-periodBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> [String]-periodBalanceReportAsText opts (MultiBalanceReport (colspans, items, coltotals)) =- (["Change of balance (flow):"] ++) $+periodBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String+periodBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, coltotals)) =+ unlines $+ ([printf "Balance changes in %s:" (showDateSpan $ multiBalanceReportSpan r)] ++) $ trimborder $ lines $ render id ((" "++) . showDateSpan)- showMixedAmountWithoutPrice+ showMixedAmountOneLineWithoutPrice $ Table (T.Group NoLine $ map (Header . padright acctswidth) accts) (T.Group NoLine $ map Header colspans)@@ -388,18 +424,19 @@ accts = map renderacct items' renderacct ((a,a',i),_) | tree_ opts = replicate ((i-1)*2) ' ' ++ a'- | otherwise = accountNameDrop (drop_ opts) a+ | otherwise = maybeAccountNameDrop opts a acctswidth = maximum $ map length $ accts totalrow | no_total_ opts = row "" [] | otherwise = row "" coltotals -- | Render a multi-column cumulative balance report as plain text suitable for console output.-cumulativeBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> [String]-cumulativeBalanceReportAsText opts (MultiBalanceReport (colspans, items, coltotals)) =- (["Ending balance (cumulative):"] ++) $+cumulativeBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String+cumulativeBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, coltotals)) =+ unlines $+ ([printf "Ending balances (cumulative) in %s:" (showDateSpan $ multiBalanceReportSpan r)] ++) $ trimborder $ lines $- render id ((" "++) . maybe "" (showDate . prevday) . spanEnd) showMixedAmountWithoutPrice $- addtotalrow $ + render id ((" "++) . maybe "" (showDate . prevday) . spanEnd) showMixedAmountOneLineWithoutPrice $+ addtotalrow $ Table (T.Group NoLine $ map (Header . padright acctswidth) accts) (T.Group NoLine $ map Header colspans)@@ -409,18 +446,19 @@ accts = map renderacct items renderacct ((a,a',i),_) | tree_ opts = replicate ((i-1)*2) ' ' ++ a'- | otherwise = accountNameDrop (drop_ opts) a+ | otherwise = maybeAccountNameDrop opts a acctswidth = maximum $ map length $ accts addtotalrow | no_total_ opts = id | otherwise = (+----+ row "" coltotals) -- | Render a multi-column historical balance report as plain text suitable for console output.-historicalBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> [String]-historicalBalanceReportAsText opts (MultiBalanceReport (colspans, items, coltotals)) =- (["Ending balance (historical):"] ++) $+historicalBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String+historicalBalanceReportAsText opts r@(MultiBalanceReport (colspans, items, coltotals)) =+ unlines $+ ([printf "Ending balances (historical) in %s:" (showDateSpan $ multiBalanceReportSpan r)] ++) $ trimborder $ lines $- render id ((" "++) . maybe "" (showDate . prevday) . spanEnd) showMixedAmountWithoutPrice $- addtotalrow $ + render id ((" "++) . maybe "" (showDate . prevday) . spanEnd) showMixedAmountOneLineWithoutPrice $+ addtotalrow $ Table (T.Group NoLine $ map (Header . padright acctswidth) accts) (T.Group NoLine $ map Header colspans)@@ -430,10 +468,15 @@ accts = map renderacct items renderacct ((a,a',i),_) | tree_ opts = replicate ((i-1)*2) ' ' ++ a'- | otherwise = accountNameDrop (drop_ opts) a+ | otherwise = maybeAccountNameDrop opts a acctswidth = maximum $ map length $ accts addtotalrow | no_total_ opts = id | otherwise = (+----+ row "" coltotals)++-- | Figure out the overall date span of a multicolumn balance report.+multiBalanceReportSpan :: MultiBalanceReport -> DateSpan+multiBalanceReportSpan (MultiBalanceReport ([], _, _)) = DateSpan Nothing Nothing+multiBalanceReportSpan (MultiBalanceReport (colspans, _, _)) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans) tests_Hledger_Cli_Balance = TestList
Hledger/Cli/Balancesheet.hs view
@@ -38,7 +38,7 @@ -- | Print a simple balance sheet. balancesheet :: CliOpts -> Journal -> IO () balancesheet CliOpts{reportopts_=ropts} j = do- -- let lines = case formatFromOpts ropts of Left err, Right ...+ -- let lines = case lineFormatFromOpts ropts of Left err, Right ... d <- getCurrentDay let q = queryFromOpts d (withoutBeginDate ropts) assetreport@(_,assets) = balanceReport ropts (And [q, journalAssetAccountQuery j]) j@@ -47,9 +47,9 @@ LT.putStr $ [lt|Balance Sheet Assets:-#{unlines $ balanceReportAsText ropts assetreport}+#{balanceReportAsText ropts assetreport} Liabilities:-#{unlines $ balanceReportAsText ropts liabilityreport}+#{balanceReportAsText ropts liabilityreport} Total: -------------------- #{padleft 20 $ showMixedAmountWithoutPrice total}
Hledger/Cli/Cashflow.hs view
@@ -40,7 +40,7 @@ -- | Print a simple cashflow statement. cashflow :: CliOpts -> Journal -> IO () cashflow CliOpts{reportopts_=ropts} j = do- -- let lines = case formatFromOpts ropts of Left err, Right ...+ -- let lines = case lineFormatFromOpts ropts of Left err, Right ... d <- getCurrentDay let q = queryFromOpts d ropts cashreport@(_,total) = balanceReport ropts (And [q, journalCashAccountQuery j]) j@@ -51,7 +51,7 @@ LT.putStr $ [lt|Cashflow Statement Cash flows:-#{unlines $ balanceReportAsText ropts cashreport}+#{balanceReportAsText ropts cashreport} Total: -------------------- #{padleft 20 $ showMixedAmountWithoutPrice total}
Hledger/Cli/Histogram.hs view
@@ -1,4 +1,4 @@-{-| +{-| Print a histogram report. (The "activity" command).
Hledger/Cli/Incomestatement.hs view
@@ -46,9 +46,9 @@ LT.putStr $ [lt|Income Statement Revenues:-#{unlines $ balanceReportAsText ropts incomereport}+#{balanceReportAsText ropts incomereport} Expenses:-#{unlines $ balanceReportAsText ropts expensereport}+#{balanceReportAsText ropts expensereport} Total: -------------------- #{padleft 20 $ showMixedAmountWithoutPrice total}
Hledger/Cli/Main.hs view
@@ -111,7 +111,9 @@ -- flags in the unnamed group, shown last without a heading: ,groupUnnamed = [] -- flags accepted but not shown in the help:- ,groupHidden = inputflags -- included here so they'll not raise a confusing error if present with no COMMAND+ ,groupHidden =+ detailedversionflag :+ inputflags -- included here so they'll not raise a confusing error if present with no COMMAND } } @@ -225,8 +227,8 @@ isBadCommand = not (null rawcmd) && null cmd hasHelp args = any (`elem` args) ["--help","-h","-?"] hasVersion = ("--version" `elem`)+ hasDetailedVersion = ("--version+" `elem`) generalHelp = putStr $ showModeHelp $ mainmode addonDisplayNames- version = putStrLn prognameandversion badCommandError = error' ("command "++rawcmd++" is not recognized, run with no command to see a list") >> exitFailure f `orShowHelp` mode = if hasHelp args then putStr (showModeHelp mode) else f dbgM "processed opts" opts@@ -244,7 +246,9 @@ -- high priority flags and situations. --help should be highest priority. | hasHelp argsbeforecmd = dbgM "" "--help before command, showing general help" >> generalHelp | not (hasHelp argsaftercmd) && (hasVersion argsbeforecmd || (hasVersion argsaftercmd && isInternalCommand))- = version+ = putStrLn prognameandversion+ | not (hasHelp argsaftercmd) && (hasDetailedVersion argsbeforecmd || (hasDetailedVersion argsaftercmd && isInternalCommand))+ = putStrLn prognameanddetailedversion -- \| (null externalcmd) && "binary-filename" `inRawOpts` rawopts = putStrLn $ binaryfilename progname -- \| "--browse-args" `elem` args = System.Console.CmdArgs.Helper.execute "cmdargs-browser" mainmode' args >>= (putStr . show) | isNullCommand = dbgM "" "no command, showing general help" >> generalHelp
Hledger/Cli/Options.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-} {-| Common cmdargs modes and flags, a command-line options type, and@@ -10,8 +11,10 @@ -- * cmdargs flags & modes helpflags,+ detailedversionflag, inputflags, reportflags,+ outputflags, generalflagsgroup1, generalflagsgroup2, generalflagsgroup3,@@ -21,7 +24,7 @@ argsFlag, showModeHelp, withAliases,- + -- * CLI options CliOpts(..), defcliopts,@@ -29,6 +32,8 @@ decodeRawOpts, rawOptsToCliOpts, checkCliOpts,+ outputFormats,+ defaultOutputFormat, -- possibly these should move into argsToCliOpts -- * CLI option accessors@@ -36,14 +41,17 @@ aliasesFromOpts, journalFilePathFromOpts, rulesFilePathFromOpts,+ outputFileFromOpts,+ outputFormatFromOpts, -- | For register: OutputWidth(..), Width(..), defaultWidth, defaultWidthWithFlag, widthFromOpts,+ maybeAccountNameDrop, -- | For balance:- formatFromOpts,+ lineFormatFromOpts, -- * Other utils hledgerAddons,@@ -51,9 +59,10 @@ -- * Tests tests_Hledger_Cli_Options -) +) where- ++import Control.Applicative ((<$>)) import qualified Control.Exception as C import Control.Monad (when) import Data.List@@ -67,7 +76,7 @@ import System.Exit (exitSuccess) import System.FilePath import Test.HUnit-import Text.ParserCombinators.Parsec as P+import Text.Parsec import Hledger import Hledger.Data.OutputFormat as OutputFormat@@ -81,16 +90,21 @@ helpflags = [ flagNone ["help","h"] (setboolopt "help") "show general help or (after command) command help" -- ,flagNone ["browse-args"] (setboolopt "browse-args") "use a web UI to select options and build up a command line"- ,flagOpt "1" ["debug"] (\s opts -> Right $ setopt "debug" s opts) "N" "show debug output (increase N for more)"+ ,flagReq ["debug"] (\s opts -> Right $ setopt "debug" s opts) "N" "show debug output if N is 1-9 (default: 0)" ,flagNone ["version"] (setboolopt "version") "show version information" ] +-- | A hidden flag, just for the hledger executable.+detailedversionflag :: Flag RawOpts+detailedversionflag = flagNone ["version+"] (setboolopt "version+") "show version information with extra detail"+ -- | Common input-related flags: --file, --rules-file, --alias... inputflags :: [Flag RawOpts] inputflags = [ flagReq ["file","f"] (\s opts -> Right $ setopt "file" s opts) "FILE" "use a different input file. For stdin, use -" ,flagReq ["rules-file"] (\s opts -> Right $ setopt "rules-file" s opts) "RFILE" "CSV conversion rules file (default: FILE.rules)" ,flagReq ["alias"] (\s opts -> Right $ setopt "alias" s opts) "OLD=NEW" "display accounts named OLD as NEW"+ ,flagNone ["ignore-assertions"] (setboolopt "ignore-assertions") "ignore any balance assertions in the journal" ] -- | Common report-related flags: --period, --cost, etc.@@ -98,22 +112,28 @@ reportflags = [ flagReq ["begin","b"] (\s opts -> Right $ setopt "begin" s opts) "DATE" "include postings/txns on or after this date" ,flagReq ["end","e"] (\s opts -> Right $ setopt "end" s opts) "DATE" "include postings/txns before this date"- ,flagNone ["daily","D"] (\opts -> setboolopt "daily" opts) "multiperiod/multicolumn report by day"- ,flagNone ["weekly","W"] (\opts -> setboolopt "weekly" opts) "multiperiod/multicolumn report by week"- ,flagNone ["monthly","M"] (\opts -> setboolopt "monthly" opts) "multiperiod/multicolumn report by month"- ,flagNone ["quarterly","Q"] (\opts -> setboolopt "quarterly" opts) "multiperiod/multicolumn report by quarter"- ,flagNone ["yearly","Y"] (\opts -> setboolopt "yearly" opts) "multiperiod/multicolumn report by year"+ ,flagNone ["daily","D"] (setboolopt "daily") "multiperiod/multicolumn report by day"+ ,flagNone ["weekly","W"] (setboolopt "weekly") "multiperiod/multicolumn report by week"+ ,flagNone ["monthly","M"] (setboolopt "monthly") "multiperiod/multicolumn report by month"+ ,flagNone ["quarterly","Q"] (setboolopt "quarterly") "multiperiod/multicolumn report by quarter"+ ,flagNone ["yearly","Y"] (setboolopt "yearly") "multiperiod/multicolumn report by year" ,flagReq ["period","p"] (\s opts -> Right $ setopt "period" s opts) "PERIODEXP" "set start date, end date, and/or reporting interval all at once (overrides the flags above)"- ,flagNone ["date2","aux-date"] (\opts -> setboolopt "date2" opts) "use postings/txns' secondary dates instead"+ ,flagNone ["date2","aux-date"] (setboolopt "date2") "use postings/txns' secondary dates instead" - ,flagNone ["cleared","C"] (\opts -> setboolopt "cleared" opts) "include only cleared postings/txns"- ,flagNone ["uncleared","U"] (\opts -> setboolopt "uncleared" opts) "include only uncleared postings/txns"- ,flagNone ["real","R"] (\opts -> setboolopt "real" opts) "include only non-virtual postings"+ ,flagNone ["cleared","C"] (setboolopt "cleared") "include only pending/cleared postings/txns"+ ,flagNone ["uncleared","U"] (setboolopt "uncleared") "include only uncleared postings/txns"+ ,flagNone ["real","R"] (setboolopt "real") "include only non-virtual postings" ,flagReq ["depth"] (\s opts -> Right $ setopt "depth" s opts) "N" "hide accounts/postings deeper than N"- ,flagNone ["empty","E"] (\opts -> setboolopt "empty" opts) "show empty/zero things which are normally omitted"- ,flagNone ["cost","B"] (\opts -> setboolopt "cost" opts) "show amounts in their cost price's commodity"+ ,flagNone ["empty","E"] (setboolopt "empty") "show empty/zero things which are normally omitted"+ ,flagNone ["cost","B"] (setboolopt "cost") "show amounts in their cost price's commodity" ] +-- | Common output-related flags: --output-file, --output-format...+outputflags = [+ flagReq ["output-file","o"] (\s opts -> Right $ setopt "output-file" s opts) "FILE[.FMT]" "write output to FILE instead of stdout. A recognised FMT suffix influences the format."+ ,flagReq ["output-format","O"] (\s opts -> Right $ setopt "output-format" s opts) "FMT" "select the output format. Supported formats: txt, csv."+ ]+ argsFlag :: FlagHelp -> Arg RawOpts argsFlag desc = flagArg (\s opts -> Right $ setopt "args" s opts) desc @@ -198,7 +218,7 @@ -- | Get a mode's help message as a nicely wrapped string. showModeHelp :: Mode a -> String-showModeHelp = (showText defaultWrap :: [Text] -> String) . +showModeHelp = (showText defaultWrap :: [Text] -> String) . (helpText [] HelpFormatDefault :: Mode a -> [Text]) -- | Add command aliases to the command's help string.@@ -229,7 +249,10 @@ ,command_ :: String ,file_ :: Maybe FilePath ,rules_file_ :: Maybe FilePath+ ,output_file_ :: Maybe FilePath+ ,output_format_ :: Maybe String ,alias_ :: [String]+ ,ignore_assertions_ :: Bool ,debug_ :: Int -- ^ debug level, set by @--debug[=N]@. See also 'Hledger.Utils.debugLevel'. ,no_new_accounts_ :: Bool -- add ,width_ :: Maybe String -- register@@ -249,10 +272,13 @@ def def def+ def+ def+ def -- | Convert possibly encoded option values to regular unicode strings. decodeRawOpts :: RawOpts -> RawOpts-decodeRawOpts = map (\(name,val) -> (name, fromSystemString val))+decodeRawOpts = map (\(name',val) -> (name', fromSystemString val)) -- | Parse raw option string values to the desired final data types. -- Any relative smart dates will be converted to fixed dates based on@@ -265,17 +291,20 @@ ,command_ = stringopt "command" rawopts ,file_ = maybestringopt "file" rawopts ,rules_file_ = maybestringopt "rules-file" rawopts+ ,output_file_ = maybestringopt "output-file" rawopts+ ,output_format_ = maybestringopt "output-format" rawopts ,alias_ = map stripquotes $ listofstringopt "alias" rawopts ,debug_ = intopt "debug" rawopts+ ,ignore_assertions_ = boolopt "ignore-assertions" rawopts ,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add ,width_ = maybestringopt "width" rawopts -- register ,reportopts_ = ropts }- + -- | Do final validation of processed opts, raising an error if there is trouble. checkCliOpts :: CliOpts -> IO CliOpts -- or pure.. checkCliOpts opts@CliOpts{reportopts_=ropts} = do- case formatFromOpts ropts of+ case lineFormatFromOpts ropts of Left err -> optserror $ "could not parse format option: "++err Right _ -> return () case widthFromOpts opts of@@ -288,26 +317,26 @@ -- 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- args <- getArgs- let rawopts = decodeRawOpts $ processValue mode args+getCliOpts mode' = do+ args' <- getArgs+ let rawopts = decodeRawOpts $ processValue mode' args' opts <- rawOptsToCliOpts rawopts >>= checkCliOpts- debugArgs args opts+ debugArgs args' opts -- if any (`elem` args) ["--help","-h","-?"] when ("help" `inRawOpts` rawopts_ opts) $- putStr (showModeHelp mode) >> exitSuccess+ putStr (showModeHelp mode') >> exitSuccess return opts where -- | Print debug info about arguments and options if --debug is present. debugArgs :: [String] -> CliOpts -> IO ()- debugArgs args opts =- when ("--debug" `elem` args) $ do- progname <- getProgName- putStrLn $ "running: " ++ progname- putStrLn $ "raw args: " ++ show args+ debugArgs args' opts =+ when ("--debug" `elem` args') $ do+ progname' <- getProgName+ putStrLn $ "running: " ++ progname'+ putStrLn $ "raw args: " ++ show args' putStrLn $ "processed opts:\n" ++ show opts d <- getCurrentDay- putStrLn $ "search query: " ++ (show $ queryFromOpts d $ reportopts_ opts)+ putStrLn $ "search query: " ++ show (queryFromOpts d $ reportopts_ opts) -- CliOpts accessors @@ -332,6 +361,44 @@ d <- getCurrentDirectory expandPath d $ fromMaybe f $ file_ opts ++-- | Get the expanded, absolute output file path from options,+-- or the default (-, meaning stdout).+outputFileFromOpts :: CliOpts -> IO FilePath+outputFileFromOpts opts = do+ d <- getCurrentDirectory+ case output_file_ opts of+ Just p -> expandPath d p+ Nothing -> return "-"++defaultOutputFormat = "txt"++outputFormats =+ [defaultOutputFormat] +++ ["csv"+ ]++-- | Get the output format from the --output-format option,+-- otherwise from a recognised file extension in the --output-file option,+-- otherwise the default (txt).+outputFormatFromOpts :: CliOpts -> String+outputFormatFromOpts opts =+ case output_format_ opts of+ Just f -> f+ Nothing ->+ case filePathExtension <$> output_file_ opts of+ Just ext | ext `elem` outputFormats -> ext+ _ -> defaultOutputFormat++-- -- | Get the file name without its last extension, from a file path.+-- filePathBaseFileName :: FilePath -> String+-- filePathBaseFileName = fst . splitExtension . snd . splitFileName++-- | Get the last file extension, without the dot, from a file path.+-- May return the null string.+filePathExtension :: FilePath -> String+filePathExtension = dropWhile (=='.') . snd . splitExtension . snd . splitFileName+ -- | Get the (tilde-expanded) rules file path from options, if any. rulesFilePathFromOpts :: CliOpts -> IO (Maybe FilePath) rulesFilePathFromOpts opts = do@@ -342,12 +409,12 @@ -- | Parse the format option if provided, possibly returning an error, -- otherwise get the default value.-formatFromOpts :: ReportOpts -> Either String [OutputFormat]-formatFromOpts = maybe (Right defaultBalanceFormat) parseStringFormat . format_+lineFormatFromOpts :: ReportOpts -> Either String [OutputFormat]+lineFormatFromOpts = maybe (Right defaultBalanceLineFormat) parseStringFormat . format_ -- | Default line format for balance report: "%20(total) %2(depth_spacer)%-(account)"-defaultBalanceFormat :: [OutputFormat]-defaultBalanceFormat = [+defaultBalanceLineFormat :: [OutputFormat]+defaultBalanceLineFormat = [ FormatField False (Just 20) Nothing TotalField , FormatLiteral " " , FormatField True (Just 2) Nothing DepthSpacerField@@ -358,7 +425,7 @@ -- | Output width configuration (for register). data OutputWidth =- TotalWidth Width -- ^ specify the overall width + TotalWidth Width -- ^ specify the overall width | FieldWidths [Width] -- ^ specify each field's width deriving Show @@ -388,17 +455,22 @@ Left e -> Left $ show e Right x -> Right x -outputwidthp :: GenParser Char st OutputWidth+outputwidthp :: Stream [Char] m t => ParsecT [Char] st m OutputWidth outputwidthp = try (do w <- widthp ws <- many1 (char ',' >> widthp) return $ FieldWidths $ w:ws) <|> TotalWidth `fmap` widthp -widthp :: GenParser Char st Width+widthp :: Stream [Char] m t => ParsecT [Char] st m Width widthp = (string "auto" >> return Auto) <|> (Width . read) `fmap` many1 digit +-- | Drop leading components of accounts names as specified by --drop, but only in --flat mode.+maybeAccountNameDrop :: ReportOpts -> AccountName -> AccountName+maybeAccountNameDrop opts a | tree_ opts = a+ | otherwise = accountNameDrop (drop_ opts) a+ -- Other utils -- | Get the sorted unique precise names and display names of hledger@@ -422,8 +494,7 @@ -- groupBy (\a b -> dropExtension a == dropExtension b) $ map stripprefix exes let displaynames = concatMap stripext $- groupBy (\a b -> dropExtension a == dropExtension b) $- precisenames+ groupBy (\a b -> dropExtension a == dropExtension b) precisenames return (precisenames, displaynames) where stripprefix = drop (length progname + 1)@@ -456,9 +527,9 @@ isHledgerExeName = isRight . parsewith hledgerexenamep where hledgerexenamep = do- string progname- char '-'- many1 (noneOf ".")+ _ <- string progname+ _ <- char '-'+ _ <- many1 (noneOf ".") optional (string "." >> choice' (map string addonExtensions)) eof
Hledger/Cli/Print.hs view
@@ -1,4 +1,4 @@-{-| +{-| A ledger-compatible @print@ command. @@ -14,17 +14,17 @@ import Data.List import System.Console.CmdArgs.Explicit import Test.HUnit+import Text.CSV import Hledger-import Prelude hiding (putStr)-import Hledger.Utils.UTF8IOCompat (putStr) import Hledger.Cli.Options+import Hledger.Cli.Utils printmode = (defCommandMode $ ["print"] ++ aliases) { modeHelp = "show transaction entries" `withAliases` aliases ,modeGroupFlags = Group {- groupUnnamed = []+ groupUnnamed = outputflags ,groupHidden = [] ,groupNamed = [generalflagsgroup1] }@@ -33,20 +33,24 @@ -- | Print journal transactions in standard format. print' :: CliOpts -> Journal -> IO ()-print' CliOpts{reportopts_=ropts} j = do+print' opts@CliOpts{reportopts_=ropts} j = do d <- getCurrentDay let q = queryFromOpts d ropts- putStr $ entriesReportAsText ropts q $ entriesReport ropts q j+ fmt = outputFormatFromOpts opts+ (render, ropts') = case fmt of+ "csv" -> ((++"\n") . printCSV . entriesReportAsCsv, ropts{accountlistmode_=ALFlat})+ _ -> (entriesReportAsText, ropts)+ writeOutput opts $ render $ entriesReport ropts' q j -entriesReportAsText :: ReportOpts -> Query -> EntriesReport -> String-entriesReportAsText _ _ items = concatMap showTransactionUnelided items+entriesReportAsText :: EntriesReport -> String+entriesReportAsText items = concatMap showTransactionUnelided items -- XXX -- tests_showTransactions = [ -- "showTransactions" ~: do -- -- "print expenses" ~:--- do +-- do -- let opts = defreportopts{query_="expenses"} -- d <- getCurrentDay -- showTransactions opts (queryFromOpts d opts) samplejournal `is` unlines@@ -58,7 +62,7 @@ -- ] -- -- , "print report with depth arg" ~:--- do +-- do -- let opts = defreportopts{depth_=Just 2} -- d <- getCurrentDay -- showTransactions opts (queryFromOpts d opts) samplejournal `is` unlines@@ -81,6 +85,40 @@ -- ,"" -- ] -- ]++entriesReportAsCsv :: EntriesReport -> CSV+entriesReportAsCsv items =+ concat $+ ([["nth","date","date2","status","code","description","comment","account","amount","commodity","credit","debit","status","posting-comment"]]:).snd $+ mapAccumL (\n e -> (n + 1, transactionToCSV n e)) 0 items++transactionToCSV :: Integer -> Transaction -> CSV+transactionToCSV n t =+ map (\p -> show n:date:date2:status:code:description:comment:p)+ (concatMap postingToCSV $ tpostings t)+ where+ description = tdescription t+ date = showDate (tdate t)+ date2 = maybe "" showDate (tdate2 t)+ status = if tstatus t then "*" else ""+ code = tcode t+ comment = chomp $ strip $ tcomment t++postingToCSV :: Posting -> CSV+postingToCSV p =+ map (\(a@(Amount {aquantity=q,acommodity=c})) ->+ let a_ = a{acommodity=""} in+ let amount = showAmount a_ in+ let commodity = c in+ let credit = if q < 0 then showAmount $ negate a_ else "" in+ let debit = if q > 0 then showAmount a_ else "" in+ account:amount:commodity:credit:debit:status:comment:[])+ amounts+ where+ Mixed amounts = pamount p+ status = if pstatus p then "*" else ""+ account = showAccountName Nothing (ptype p) (paccount p)+ comment = chomp $ strip $ pcomment p tests_Hledger_Cli_Print = TestList [] -- tests_showTransactions
Hledger/Cli/Register.hs view
@@ -1,4 +1,4 @@-{-| +{-| A ledger-compatible @register@ command. @@ -15,13 +15,13 @@ import Data.List import Data.Maybe import System.Console.CmdArgs.Explicit+import Text.CSV import Test.HUnit import Text.Printf import Hledger-import Prelude hiding (putStr)-import Hledger.Utils.UTF8IOCompat (putStr) import Hledger.Cli.Options+import Hledger.Cli.Utils registermode = (defCommandMode $ ["register"] ++ aliases) {@@ -29,10 +29,11 @@ ,modeGroupFlags = Group { groupUnnamed = [ flagNone ["historical","H"] (\opts -> setboolopt "historical" opts) "include prior postings in the running total"- ,flagNone ["average","A"] (\opts -> setboolopt "average" opts) "show a running average instead of the running total"+ ,flagNone ["average","A"] (\opts -> setboolopt "average" opts) "show a running average instead of the running total (implies --empty)" ,flagNone ["related","r"] (\opts -> setboolopt "related" opts) "show postings' siblings instead"- ,flagOpt (show defaultWidthWithFlag) ["width","w"] (\s opts -> Right $ setopt "width" s opts) "N" "set output width to 120, or N (default: 80)"+ ,flagReq ["width","w"] (\s opts -> Right $ setopt "width" s opts) "N" "set output width (default: 80)" ]+ ++ outputflags ,groupHidden = [] ,groupNamed = [generalflagsgroup1] }@@ -43,8 +44,31 @@ register :: CliOpts -> Journal -> IO () register opts@CliOpts{reportopts_=ropts} j = do d <- getCurrentDay- putStr $ postingsReportAsText opts $ postingsReport ropts (queryFromOpts d ropts) j+ let fmt = outputFormatFromOpts opts+ render | fmt=="csv" = const ((++"\n") . printCSV . postingsReportAsCsv)+ | otherwise = postingsReportAsText+ writeOutput opts $ render opts $ postingsReport ropts (queryFromOpts d ropts) j +postingsReportAsCsv :: PostingsReport -> CSV+postingsReportAsCsv (_,is) =+ ["date","description","account","amount","running total or balance"]+ :+ map postingsReportItemAsCsvRecord is++postingsReportItemAsCsvRecord :: PostingsReportItem -> Record+postingsReportItemAsCsvRecord (_, _, _, p, b) = [date,desc,acct,amt,bal]+ where+ date = showDate $ postingDate p+ desc = maybe "" tdescription $ ptransaction p+ acct = bracket $ paccount p+ where+ bracket = case ptype p of+ BalancedVirtualPosting -> (\s -> "["++s++"]")+ VirtualPosting -> (\s -> "("++s++")")+ _ -> id+ amt = showMixedAmountOneLineWithoutPrice $ pamount p+ bal = showMixedAmountOneLineWithoutPrice b+ -- | Render a register report as plain text suitable for console output. postingsReportAsText :: CliOpts -> PostingsReport -> String postingsReportAsText opts = unlines . map (postingsReportItemAsText opts) . snd@@ -69,33 +93,51 @@ -- date and description are shown for the first posting of a transaction only. -- @ postingsReportItemAsText :: CliOpts -> PostingsReportItem -> String-postingsReportItemAsText opts (mdate, mdesc, p, b) =- concatTopPadded [date, " ", desc, " ", acct, " ", amt, " ", bal]+postingsReportItemAsText opts (mdate, menddate, mdesc, p, b) =+ intercalate "\n" $+ [printf ("%-"++datew++"s %-"++descw++"s %-"++acctw++"s %"++amtw++"s %"++balw++"s")+ date desc acct amtfirstline balfirstline]+ +++ [printf (spacer ++ "%"++amtw++"s %"++balw++"s") a b | (a,b) <- zip amtrest balrest ]+ where totalwidth = case widthFromOpts opts of Left _ -> defaultWidth -- shouldn't happen Right (TotalWidth (Width w)) -> w Right (TotalWidth Auto) -> defaultWidth -- XXX Right (FieldWidths _) -> defaultWidth -- XXX- datewidth = 10 amtwidth = 12 balwidth = 12+ (datewidth, date) = case (mdate,menddate) of+ (Just _, Just _) -> (21, showDateSpan (DateSpan mdate menddate))+ (Nothing, Just _) -> (21, "")+ (Just d, Nothing) -> (10, showDate d)+ _ -> (10, "") remaining = totalwidth - (datewidth + 1 + 2 + amtwidth + 2 + balwidth)- (descwidth, acctwidth) | even r = (r', r')- | otherwise = (r', r'+1)- where r = remaining - 2- r' = r `div` 2- date = maybe (replicate datewidth ' ') (printf ("%-"++show datewidth++"s") . showDate) mdate- desc = maybe (replicate descwidth ' ') (printf ("%-"++show descwidth++"s") . take descwidth . elideRight descwidth) mdesc- acct = printf ("%-"++(show acctwidth)++"s") a+ (descwidth, acctwidth) | isJust menddate = (0, remaining-2)+ | even remaining = (r2, r2)+ | otherwise = (r2, r2+1) where- a = bracket $ elideAccountName awidth $ paccount p- (bracket, awidth) = case ptype p of+ r2 = (remaining-2) `div` 2+ [datew,descw,acctw,amtw,balw] = map show [datewidth,descwidth,acctwidth,amtwidth,balwidth]++++ desc = maybe "" (take descwidth . elideRight descwidth) mdesc+ acct = parenthesise $ elideAccountName awidth $ paccount p+ where+ (parenthesise, awidth) = case ptype p of BalancedVirtualPosting -> (\s -> "["++s++"]", acctwidth-2)- VirtualPosting -> (\s -> "("++s++")", acctwidth-2)- _ -> (id,acctwidth)- amt = padleft amtwidth $ showMixedAmountWithoutPrice $ pamount p- bal = padleft balwidth $ showMixedAmountWithoutPrice b+ VirtualPosting -> (\s -> "("++s++")", acctwidth-2)+ _ -> (id,acctwidth)+ amt = showMixedAmountWithoutPrice $ pamount p+ bal = showMixedAmountWithoutPrice b+ (amtlines, ballines) = (lines amt, lines bal)+ (amtlen, ballen) = (length amtlines, length ballines)+ numlines = max amtlen ballen+ (amtfirstline:amtrest) = take numlines $ amtlines ++ repeat "" -- posting amount is top-aligned+ (balfirstline:balrest) = take numlines $ replicate (numlines - ballen) "" ++ ballines -- balance amount is bottom-aligned+ spacer = replicate (totalwidth - (amtwidth + 2 + balwidth)) ' ' -- XXX -- showPostingWithBalanceForVty showtxninfo p b = postingsReportItemAsText defreportopts $ mkpostingsReportItem showtxninfo p b
Hledger/Cli/Stats.hs view
@@ -57,8 +57,7 @@ -- w2 = maximum $ map (length . show . snd) stats stats = [ ("Main journal file" :: String, path) -- ++ " (from " ++ source ++ ")")- ,("Included journal files", unlines $ reverse $ -- cf journalAddFile- drop 1 $ journalFilePaths j)+ ,("Included journal files", unlines $ drop 1 $ journalFilePaths j) ,("Transactions span", printf "%s to %s (%d days)" (start span) (end span) days) ,("Last transaction", maybe "none" show lastdate ++ showelapsed lastelapsed) ,("Transactions", printf "%d (%0.1f per day)" tnum txnrate)
Hledger/Cli/Utils.hs view
@@ -9,6 +9,7 @@ module Hledger.Cli.Utils ( withJournalDo,+ writeOutput, journalReload, journalReloadIfChanged, journalFileIsNewer,@@ -34,7 +35,9 @@ import System.Time (ClockTime, getClockTime, diffClockTimes, TimeDiff(TimeDiff)) import Test.HUnit import Text.Printf+import Text.Regex.TDFA ((=~)) + -- kludge - adapt to whichever directory version is installed, or when -- cabal macros aren't available, assume the new directory #ifdef MIN_VERSION_directory@@ -65,16 +68,22 @@ -- to let the add command work. rulespath <- rulesFilePathFromOpts opts journalpath <- journalFilePathFromOpts opts- ej <- readJournalFile Nothing rulespath journalpath+ ej <- readJournalFile Nothing rulespath (not $ ignore_assertions_ opts) journalpath either error' (cmd opts . journalApplyAliases (aliasesFromOpts opts)) ej +-- | Write some output to stdout or to a file selected by --output-file.+writeOutput :: CliOpts -> String -> IO ()+writeOutput opts s = do+ f <- outputFileFromOpts opts+ (if f == "-" then putStr else writeFile f) s+ -- -- | Get a journal from the given string and options, or throw an error. -- readJournalWithOpts :: CliOpts -> String -> IO Journal -- readJournalWithOpts opts s = readJournal Nothing Nothing Nothing s >>= either error' return -- | Re-read a journal from its data file, or return an error string. journalReload :: Journal -> IO (Either String Journal)-journalReload j = readJournalFile Nothing Nothing $ journalFilePath j+journalReload j = readJournalFile Nothing Nothing True $ journalFilePath j -- | Re-read a journal from its data file mostly, only if the file has -- changed since last read (or if there is no file, ie data read from@@ -179,7 +188,8 @@ safeGetDirectoryContents fp = getDirectoryContents fp -- | Does the second file represent a backup of the first, and if so which version is it ?+-- XXX nasty regex types intruding, add a simpler api to Hledger.Utils.Regex backupNumber :: FilePath -> FilePath -> Maybe Int-backupNumber f g = case regexMatch ("^" ++ f ++ "\\.([0-9]+)$") g of- Just (_, ((_,suffix):_)) -> readMay suffix+backupNumber f g = case g =~ ("^" ++ f ++ "\\.([0-9]+)$") of+ (_::FilePath, _::FilePath, _::FilePath, [ext::FilePath]) -> readMay ext _ -> Nothing
Hledger/Cli/Version.hs view
@@ -7,24 +7,27 @@ progname, version, prognameandversion,+ prognameanddetailedversion, binaryfilename ) where import System.Info (os, arch) import Text.Printf +import Hledger.Data.Types (numberRepresentation) import Hledger.Utils -- package name and version from the cabal file-progname, version, prognameandversion :: String+progname, version, prognameandversion, prognameanddetailedversion :: String progname = "hledger" #ifdef VERSION version = VERSION #else-version = ""+version = "dev build" #endif prognameandversion = progname ++ " " ++ version+prognameanddetailedversion = printf "%s %s, using %s" progname version numberRepresentation -- developer build version strings include PATCHLEVEL (number of -- patches since the last tag). If defined, it must be a number.
+ app/hledger-cli.hs view
@@ -0,0 +1,6 @@+#!/usr/bin/env runhaskell+-- the hledger command-line executable; see Hledger/Cli/Main.hs++module Main (main)+where+import Hledger.Cli.Main (main)
− hledger-cli.hs
@@ -1,6 +0,0 @@-#!/usr/bin/env runhaskell--- the hledger command-line executable; see Hledger/Cli/Main.hs--module Main (main)-where-import Hledger.Cli.Main (main)
hledger.cabal view
@@ -1,5 +1,5 @@ name: hledger-version: 0.23.3+version: 0.24 stability: stable category: Finance, Console synopsis: The main command-line interface for the hledger accounting tool.@@ -23,7 +23,7 @@ -- data-dir: data -- data-files: extra-tmp-files:-extra-source-files:+extra-source-files: tests/suite.hs CHANGES @@ -41,11 +41,12 @@ Description: Build with support for multithreaded execution Default: True + library- cpp-options: -DVERSION="0.23.3"- ghc-options: -W+ cpp-options: -DVERSION="0.24"+ ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures+ ghc-options: -fno-warn-type-defaults -fno-warn-orphans default-language: Haskell2010- -- should be the same as below exposed-modules: Hledger.Cli Hledger.Cli.Main@@ -63,13 +64,13 @@ Hledger.Cli.Print Hledger.Cli.Register Hledger.Cli.Stats- -- should be the same as below build-depends:- hledger-lib == 0.23.3+ hledger-lib == 0.24 ,base >= 4.3 && < 5 -- ,cabal-file-th ,containers ,cmdargs >= 0.10 && < 0.11+ ,csv -- ,data-pprint >= 0.2.1 && < 0.3 ,directory ,filepath@@ -78,8 +79,9 @@ ,mtl ,old-locale ,old-time- ,parsec+ ,parsec >= 3 ,process+ ,regex-tdfa ,regexpr >= 0.5.1 ,safe >= 0.2 -- http://www.yesodweb.com/blog/2014/04/consolidation-progress@@ -101,44 +103,24 @@ if impl(ghc >= 7.4) build-depends: pretty-show >= 1.6.4 --- should depend on the above to avoid double compilation but this is--- still too complicated as of 2011/6/1 because:--- - breaks haddock, http://hackage.haskell.org/trac/hackage/ticket/656--- - library and executable must have different hs-source-dirs--- - the exe may need to list all the lib's dependencies--- - how it works seems ghc version dependent--- leksah is reported to have this working, http://hackage.haskell.org/packages/archive/leksah/0.10.0.4/leksah.cabal+ executable hledger main-is: hledger-cli.hs- -- should be the same as above- other-modules:- Hledger.Cli- Hledger.Cli.Main- Hledger.Cli.Options- Hledger.Cli.Tests- Hledger.Cli.Utils- Hledger.Cli.Version- Hledger.Cli.Add- Hledger.Cli.Accounts- Hledger.Cli.Balance- Hledger.Cli.Balancesheet- Hledger.Cli.Cashflow- Hledger.Cli.Histogram- Hledger.Cli.Incomestatement- Hledger.Cli.Print- Hledger.Cli.Register- Hledger.Cli.Stats- cpp-options: -DVERSION="0.23.3"- ghc-options: -W+ hs-source-dirs: app+ default-language: Haskell2010+ cpp-options: -DVERSION="0.24"+ ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures+ ghc-options: -fno-warn-type-defaults -fno-warn-orphans if flag(threaded) ghc-options: -threaded- -- should be the same as above- default-language: Haskell2010+ -- same as above: build-depends:- hledger-lib == 0.23.3+ hledger-lib == 0.24+ ,hledger == 0.24 ,base >= 4.3 && < 5 ,containers ,cmdargs >= 0.10 && < 0.11+ ,csv -- ,data-pprint >= 0.2.1 && < 0.3 ,directory ,filepath@@ -147,8 +129,9 @@ ,mtl ,old-locale ,old-time- ,parsec+ ,parsec >= 3 ,process+ ,regex-tdfa ,regexpr >= 0.5.1 ,safe >= 0.2 ,shakespeare-text >= 1.0 && < 1.2@@ -162,11 +145,15 @@ if impl(ghc >= 7.4) build-depends: pretty-show >= 1.6.4 + test-suite tests type: exitcode-stdio-1.0- main-is: tests/suite.hs- ghc-options: -Wall+ main-is: suite.hs+ hs-source-dirs: tests default-language: Haskell2010+ ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures+ ghc-options: -fno-warn-type-defaults -fno-warn-orphans+ -- same as above: build-depends: hledger-lib , hledger , base >= 4.3 && < 5@@ -181,8 +168,9 @@ , mtl , old-locale , old-time- , parsec+ , parsec >= 3 , process+ , regex-tdfa , regexpr , safe , shakespeare-text >= 1.0 && < 1.2@@ -197,3 +185,24 @@ , wizards == 1.0.* if impl(ghc >= 7.4) build-depends: pretty-show >= 1.6.4+++-- not a standard cabal bench test, I think+benchmark bench+ type: exitcode-stdio-1.0+ -- hs-source-dirs: + main-is: ../tools/simplebench.hs+ ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures+ ghc-options: -fno-warn-type-defaults -fno-warn-orphans+ default-language: Haskell2010+ build-depends: hledger-lib,+ hledger,+ base >= 4.3 && < 5,+ old-locale,+ time,+ html,+ tabular >= 0.2 && < 0.3,+ process,+ filepath,+ directory+