packages feed

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 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+