hledger 0.22.2 → 0.23

raw patch · 16 files changed

+1149/−925 lines, 16 filesdep +shakespearedep +wizardsdep ~hledger-libdep ~shakespeare-textPVP ok

version bump matches the API change (PVP)

Dependencies added: shakespeare, wizards

Dependency ranges changed: hledger-lib, shakespeare-text

API changes (from Hackage documentation)

Files

• CHANGES +76/−0
• Hledger/Cli.hs +6/−1
• Hledger/Cli/Accounts.hs +62/−0
• Hledger/Cli/Add.hs +323/−264
• Hledger/Cli/Balance.hs +50/−27
• Hledger/Cli/Balancesheet.hs +18/−2
• Hledger/Cli/Cashflow.hs +17/−2
• Hledger/Cli/Histogram.hs +15/−3
• Hledger/Cli/Incomestatement.hs +18/−2
• Hledger/Cli/Main.hs +154/−39
• Hledger/Cli/Options.hs +263/−512
• Hledger/Cli/Print.hs +61/−48
• Hledger/Cli/Register.hs +18/−1
• Hledger/Cli/Stats.hs +17/−2
• Hledger/Cli/Tests.hs +24/−10
• hledger.cabal +27/−12

@@ -1,7 +1,83 @@+0.23 (2014/5/1)++Journal format:+- A # (hash) in column 0 is now also supported for starting a top-level journal comment, like Ledger.+- The "too many missing amounts" error now reminds about the 2-space rule.+- Fix: . (period) is no longer parsed as a valid amount.+- Fix: default commodity directives no longer limit the maximum display precision (#169).+- Fix: + before an amount is no longer parsed as part of the commodity (#181).++CLI:+- Command-line help cleanups, layout improvements.+- Descriptions are shown for known add-ons in the command list.+- Command aliases have been simplified.+- Add-ons can now have any of these file extensions:+  none, hs, lhs, pl, py, rb, rkt, sh, bat, com, exe.+- Add-ons are displayed without their file extensions when possible.+- Add-ons with the same name as a built-in command or alias are ignored.+- Fix: add-on detection and invocation now works on windows.+- Fix: add-ons with digits in the name are now found.+- Fix: add-on arguments containing a single quote now work.+- Fix: when -- is used to hide add-on options from the main program,+  it is no longer passed through as an add-on argument.++Queries:+- The currency/commodity query prefix (sym:) has been renamed to cur:.+- Currency/commodity queries are applied more strongly in register and+  balance reports, filtering out unwanted currencies entirely. Eg+  hledger balance cur:'\$' now reports only the dollar amounts even if+  there are multi-currency transactions or postings.+- Amount queries like amt:N, amt:<N and amt:>N, where N is not 0, now do an unsigned+  comparison of the amount and N. That is, they compare the absolute magnitude.+  To do a signed comparison instead, write N with its sign (eg amt:+N, amt:<+N, amt:>-N).+- Fix: amount queries no longer give false positives on multi-commodity amounts.++accounts:+- An accounts command has been added, similar to Ledger's, for listing account names+  in flat or hierarchical mode.++add:+- Tab completion now works at all prompts, and will insert the default if the input area is empty.+- Account and amount defaults are more robust and useful.+- Transactions may also be completed by the enter key, when there are no more default postings.+- Input prompts are displayed in a different colour when supported.++balance:+- Balance reports in flat mode now always show exclusive (subaccount-excluding) balances.+- Balance reports in flat mode with --depth now aggregate deeper accounts at the depth limit instead of excluding them.+- Multicolumn reports in flat mode now support --drop.+- Multicolumn balance reports can now show the account hierarchy with --tree.+- Multicolumn report start/end dates are adjusted to encompass the displayed+  report periods, so the first and last periods are "full" and comparable to the others.+- Fix: zero-balance leaf accounts below a non-zero-balance parent are no longer always shown (#170).+- Fix: multicolumn reports now support --date2 (cf #174).++balancesheet, cashflow, incomestatement:+- These commands now support --flat and --drop.++print:+- Tag queries (tag:) will now match a transaction if any of its postings match.++register:+- The --display option has been dropped. To see an accurate running total which+  includes the prior starting balance, use --historical/-H (like balance). +- With a report interval, report start/end dates are adjusted to encompass the displayed+  periods, so the first and last periods are "full" and comparable to the others.+- Fix: --date2 now works with report intervals (fixes #174).++Miscellaneous:+- Default report dates now derive from the secondary dates when --date2 is in effect.+- Default report dates now notice any posting dates outside the transaction dates' span.+- Debug output improvements.+- New add-on example: extra/hledger-rewrite.hs, adds postings to matched entries.+- Compatible with GHC 7.2 (#155) - GHC 7.8, shakespeare 2++ 0.22.2 (2014/4/16)  - display years before 1000 with four digits, not three - avoid pretty-show to build with GHC < 7.4 - allow text 1.1, drop data-pprint to build with GHC 7.8.x+  0.22.1 (2014/1/6) and older: see http://hledger.org/release-notes or doc/CHANGES.md.

@@ -8,6 +8,7 @@ -}  module Hledger.Cli (+                     module Hledger.Cli.Accounts,                      module Hledger.Cli.Add,                      module Hledger.Cli.Balance,                      module Hledger.Cli.Balancesheet,@@ -20,13 +21,17 @@                      module Hledger.Cli.Options,                      module Hledger.Cli.Utils,                      module Hledger.Cli.Version,-                     tests_Hledger_Cli+                     tests_Hledger_Cli,+                     module Hledger,+                     module System.Console.CmdArgs.Explicit               ) where import Data.Time.Calendar+import System.Console.CmdArgs.Explicit import Test.HUnit  import Hledger+import Hledger.Cli.Accounts import Hledger.Cli.Add import Hledger.Cli.Balance import Hledger.Cli.Balancesheet

@@ -0,0 +1,62 @@+{-|++The @accounts@ command lists account names:++- in flat mode (default), it lists the full names of accounts posted to by matched postings,+  clipped to the specified depth, possibly with leading components dropped.++- in tree mode, it shows the indented short names of accounts posted to by matched postings,+  and their parents, to the specified depth.++-}++module Hledger.Cli.Accounts (+  accountsmode+ ,accounts+ ,tests_Hledger_Cli_Accounts+) where++import Data.List+import System.Console.CmdArgs.Explicit as C+import Test.HUnit++import Hledger+import Prelude hiding (putStrLn)+import Hledger.Utils.UTF8IOCompat (putStrLn)+import Hledger.Cli.Options+++-- | Command line options for this command.+accountsmode = (defCommandMode $ ["accounts"] ++ aliases) {+  modeHelp = "show account names" `withAliases` aliases+ ,modeHelpSuffix = [+    "This command lists the accounts referenced by matched postings (and in tree mode, their parents as well). The accounts can be depth-clipped (--depth N) or have their leading parts trimmed (--drop N)."+   ]+ ,modeGroupFlags = C.Group {+     groupUnnamed = [+      flagNone ["tree"] (\opts -> setboolopt "tree" opts) "show short account names, as a tree"+     ,flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show full account names, as a list (default)"+     ,flagReq  ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "flat mode: omit N leading account name parts"+     ]+    ,groupHidden = []+    ,groupNamed = [generalflagsgroup1]+    }+ }+  where aliases = []++-- | The accounts command.+accounts :: CliOpts -> Journal -> IO ()+accounts CliOpts{reportopts_=ropts} j = do+  d <- getCurrentDay+  let q = queryFromOpts d ropts+      nodepthq = dbg "nodepthq" $ filterQuery (not . queryIsDepth) q+      depth    = dbg "depth" $ queryDepth $ filterQuery queryIsDepth q+      ps = dbg "ps" $ journalPostings $ filterJournalPostings nodepthq j+      as = dbg "as" $ nub $ filter (not . null) $ map (clipAccountName depth) $ sort $ map paccount ps+      as' | tree_ ropts = expandAccountNames as+          | otherwise   = as+      render a | tree_ ropts = replicate (2 * (accountNameLevel a - 1)) ' ' ++ accountLeafName a+               | otherwise   = accountNameDrop (drop_ ropts) a+  mapM_ (putStrLn . render) as'++tests_Hledger_Cli_Accounts = TestList []

@@ -1,265 +1,348 @@-{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-}-{-| -+{-| A history-aware add command to help with data entry.--Note: this might not be sensible, but add has some aspirations of being-both user-friendly and pipeable/scriptable and for this reason-informational messages are mostly written to stderr rather than stdout.+|-} --}+{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-unused-do-bind #-}+{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, RecordWildCards, TypeOperators, FlexibleContexts #-}  module Hledger.Cli.Add where+ import Control.Exception as E import Control.Monad import Control.Monad.Trans (liftIO) import Data.Char (toUpper, toLower) import Data.List import Data.Maybe+import Data.Time.Calendar (Day) import Data.Typeable (Typeable)-import Safe (headDef, tailDef, headMay)-import System.Console.Haskeline (InputT, runInputT, defaultSettings, setComplete, getInputLine)+import Safe (headDef, headMay)+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.Haskeline import System.IO ( stderr, hPutStr, hPutStrLn )-import System.IO.Error-import Text.ParserCombinators.Parsec+import Text.ParserCombinators.Parsec hiding (Line) import Text.Printf-import qualified Data.Set as Set  import Hledger-import Prelude hiding (putStr, putStrLn, appendFile)-import Hledger.Utils.UTF8IOCompat (putStr, putStrLn, appendFile) import Hledger.Cli.Options import Hledger.Cli.Register (postingsReportAsText)  +addmode = (defCommandMode ["add"]) {+  modeHelp = "prompt for transactions and add them to the journal"+ ,modeHelpSuffix = ["Defaults come from previous similar transactions; use query patterns to restrict these."]+ ,modeGroupFlags = Group {+     groupUnnamed = [+      flagNone ["no-new-accounts"]  (\opts -> setboolopt "no-new-accounts" opts) "don't allow creating new accounts"+     ]+    ,groupHidden = []+    ,groupNamed = [generalflagsgroup2]+    }+ }++-- | State used while entering transactions.+data EntryState = EntryState {+   esOpts               :: CliOpts           -- ^ command line options+  ,esArgs               :: [String]          -- ^ command line arguments remaining to be used as defaults+  ,esToday              :: Day               -- ^ today's date+  ,esDefDate            :: Day               -- ^ the default date for next transaction+  ,esJournal            :: Journal           -- ^ the journal we are adding to+  ,esSimilarTransaction :: Maybe Transaction -- ^ the most similar historical txn+  ,esPostings           :: [Posting]         -- ^ postings entered so far in the current txn+  } deriving (Show,Typeable)++defEntryState = EntryState {+   esOpts               = defcliopts+  ,esArgs               = []+  ,esToday              = nulldate+  ,esDefDate            = nulldate+  ,esJournal            = nulljournal+  ,esSimilarTransaction = Nothing+  ,esPostings           = []+}++data RestartTransactionException = RestartTransactionException deriving (Typeable,Show)+instance Exception RestartTransactionException++-- data ShowHelpException = ShowHelpException deriving (Typeable,Show)+-- instance Exception ShowHelpException+ -- | Read multiple transactions from the console, prompting for each -- field, and append them to the journal file.  If the journal came -- from stdin, this command has no effect. add :: CliOpts -> Journal -> IO () add opts j-    | f == "-" = return ()+    | journalFilePath j == "-" = return ()     | otherwise = do-  hPutStr stderr $ unlines [-     "Adding transactions to journal file "++f-    ,"Provide field values at the prompts, or press enter to accept defaults."-    ,"Use readline keys to edit, use tab key to complete account names."-    ,"A code (in parentheses) may be entered following transaction dates."-    ,"A comment may be entered following descriptions or amounts."+        hPrintf stderr "Adding transactions to journal file %s\n" (journalFilePath j)+        showHelp+        today <- getCurrentDay+        let es = defEntryState{esOpts=opts+                              ,esArgs=map stripquotes $ listofstringopt "args" $ rawopts_ opts+                              ,esToday=today+                              ,esDefDate=today+                              ,esJournal=j+                              }+        getAndAddTransactions es `E.catch` (\(_::UnexpectedEOF) -> putStr "")++showHelp = hPutStr stderr $ unlines [+     "Any command line arguments will be used as defaults."+    ,"Use tab key to complete, readline keys to edit, enter to accept defaults."+    ,"An optional (CODE) may follow transaction dates."+    ,"An optional ; COMMENT may follow descriptions or amounts."     ,"If you make a mistake, enter < at any prompt to restart the transaction."-    ,"To complete a transaction, enter . when prompted."-    ,"To quit, press control-d or control-c."+    ,"To end a transaction, enter . when prompted."+    ,"To quit, enter . at a date prompt or press control-d or control-c."     ]-  today <- showDate `fmap` getCurrentDay-  let args                = words' $ query_ $ reportopts_ opts-      (defdate, moredefs) = headTailDef today args-  getAndAddTransactionsLoop j opts defdate moredefs-        `E.catch` (\e -> unless (isEOFError e) $ ioError e)-      where f = journalFilePath j --- | Loop reading transactions from the console, prompting for,--- validating, displaying and appending each one to the journal file,--- until end of input or ctrl-c (then raise an EOF exception).--- If provided, command-line arguments are used as defaults for the--- first transaction; otherwise defaults come from the most similar--- recent transaction in the journal.-getAndAddTransactionsLoop :: Journal -> CliOpts -> String -> [String] -> IO ()-getAndAddTransactionsLoop j opts defdate moredefs = do-  hPrintf stderr "\nStarting a new transaction.\n"-  t <- getTransaction j opts defdate moredefs-  j' <- journalAddTransaction j opts t-  hPrintf stderr "Added to the journal.\n"-  let defdate' = showDate $ tdate t-  getAndAddTransactionsLoop j' opts defdate' []---- | Read a single transaction from the console, with history-aware prompting,--- allowing the user to restart and confirm at the end.--- A default date, and zero or more defaults for subsequent fields, are provided.-getTransaction :: Journal -> CliOpts -> String -> [String] -> IO Transaction-getTransaction j opts defdate moredefs = do-  mt <- getTransactionOrRestart j opts defdate moredefs-  let restart = do-        hPrintf stderr "\nRestarting this transaction.\n"-        getTransaction j opts defdate moredefs+-- | Loop reading transactions from the console, prompting, validating+-- and appending each one to the journal file, until end of input or+-- ctrl-c (then raise an EOF exception).  If provided, command-line+-- arguments are used as defaults; otherwise defaults come from the+-- most similar recent transaction in the journal.+getAndAddTransactions :: EntryState -> IO ()+getAndAddTransactions es@EntryState{..} = (do+  mt <- runInputT (setComplete noCompletion defaultSettings) (run $ haskeline $ confirmedTransactionWizard es)   case mt of-    Nothing -> restart-    Just t  -> do-      hPrintf stderr "\nTransaction entered:\n%s" (show t)-      yn <- runInteractionDefault $ askFor "Accept this transaction" (Just "y") (Just $ \s -> map toLower s `elem` ["<","y","yes","n","no"])-      case headMay $ map toLower yn of-        Just 'y' -> return t-        _        -> restart---- | Read a single transaction from the console, with history-aware prompting,--- or return nothing indicating that the user wants to restart entering this transaction.--- A default date, and zero or more defaults for subsequent fields, are provided.-getTransactionOrRestart :: Journal -> CliOpts -> String -> [String] -> IO (Maybe Transaction)-getTransactionOrRestart j opts defdate moredefs = do-  let dateandcodep = do {d <- smartdate; c <- optionMaybe code; many spacenonewline; eof; return (d, fromMaybe "" c)}-  datecodestr <- runInteractionDefault $ askFor "date"-            (Just defdate)-            (Just $ \s -> null s-                         || s == "."-                         || isRight (parseWithCtx nullctx dateandcodep $ lowercase s))-  when (datecodestr == ".") $ ioError $ mkIOError eofErrorType "" Nothing Nothing-  today <- getCurrentDay-  let (sdate,code) = fromparse $ parseWithCtx nullctx dateandcodep datecodestr-      defday = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) defdate-      datestr = showDate $ fixSmartDate defday sdate--  let (defdesc, moredefs') = headTailDef "" moredefs-  desc <- runInteractionDefault $ askFor "description" (Just defdesc) Nothing-  if desc == "<"-   then return Nothing-   else do-    let (description,comment) = (strip a, strip $ dropWhile (==';') b) where (a,b) = break (==';') desc-    getPostingsForTransactionWithHistory j opts datestr code description comment moredefs'--data RestartEntryException = RestartEntryException deriving (Typeable,Show)-instance Exception RestartEntryException+    Nothing -> fail "urk ?"+    Just t -> do+      j <- if debug_ esOpts > 0+           then do hPrintf stderr "Skipping journal add due to debug mode.\n"+                   return esJournal+           else do j' <- journalAddTransaction esJournal esOpts t+                   hPrintf stderr "Saved.\n"+                   return j'+      hPrintf stderr "Starting the next transaction (. or ctrl-D/ctrl-C to quit)\n"+      getAndAddTransactions es{esJournal=j, esDefDate=tdate t}+  )+  `E.catch` (\(_::RestartTransactionException) ->+                 hPrintf stderr "Restarting this transaction.\n" >> getAndAddTransactions es) --- | Information used as the basis for suggested account names, amounts etc. in add prompt.-data PostingsState = PostingsState {-   psJournal                 :: Journal-  ,psAccept                  :: AccountName -> Bool-  ,psSuggestHistoricalAmount :: Bool-  ,psHistory                 :: Maybe [Posting]-  }+-- confirmedTransactionWizard :: (ArbitraryIO :<: b, OutputLn :<: b, Line :<: b) => EntryState -> Wizard b Transaction+-- confirmedTransactionWizard :: EntryState -> Wizard Haskeline Transaction+confirmedTransactionWizard es@EntryState{..} = do+  t <- transactionWizard es+  -- 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 $ +        maybeRestartTransaction $+        line $ green $ printf "Save this transaction to the journal ?%s: " (showDefault def)+  if y then return t else throw RestartTransactionException --- | Loop reading postings from the console, until a valid balanced--- set of postings has been entered, then return the final transaction,--- or nothing indicating that the user wants to restart entering this transaction.-getPostingsForTransactionWithHistory :: Journal -> CliOpts -> String -> String -> String -> String -> [String] -> IO (Maybe Transaction)-getPostingsForTransactionWithHistory j opts datestr code description comment defargs = do-  today <- getCurrentDay-  let historymatches = transactionsSimilarTo j (queryFromOpts today $ reportopts_ opts) description-      bestmatch | not (null defargs) || null historymatches = Nothing-                | otherwise = Just $ snd $ head historymatches-      bestmatchpostings = maybe Nothing (Just . tpostings) bestmatch-      date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr-      accept x = x == "." || (not . null) x &&-        if no_new_accounts_ opts-            then x `elem` existingaccts-            else True-      existingaccts = journalAccountNames j-      getvalidpostings = do-        ps <- getPostingsLoop (PostingsState j accept True bestmatchpostings) [] defargs+transactionWizard es@EntryState{..} = do+  (date,code)    <- dateAndCodeWizard es+  let es1@EntryState{esArgs=args1} = es{esArgs=drop 1 esArgs, esDefDate=date}+  (desc,comment) <- descriptionAndCommentWizard es1+  let mbaset = similarTransaction es1 desc+  when (isJust mbaset) $ liftIO $ hPrintf stderr "Using this similar transaction for defaults:\n%s" (show $ fromJust mbaset)+  let es2 = es1{esArgs=drop 1 args1, esSimilarTransaction=mbaset}+      balancedPostingsWizard = do+        ps <- postingsWizard es2{esPostings=[]}         let t = nulltransaction{tdate=date                                ,tstatus=False                                ,tcode=code-                               ,tdescription=description+                               ,tdescription=desc                                ,tcomment=comment                                ,tpostings=ps                                }-        either retry (return . Just) $ balanceTransaction Nothing t -- imprecise balancing+        case balanceTransaction Nothing t of -- imprecise balancing (?)+          Right t' -> return t'+          Left err -> liftIO (hPutStrLn stderr $ "\n" ++ (capitalize err) ++ "please re-enter.") >> balancedPostingsWizard+  balancedPostingsWizard++-- Identify the closest recent match for this description in past transactions.+similarTransaction :: EntryState -> String -> Maybe Transaction+similarTransaction EntryState{..} desc =+  let q = queryFromOptsOnly esToday $ reportopts_ esOpts+      historymatches = transactionsSimilarTo esJournal q desc+      bestmatch | null historymatches = Nothing+                | otherwise           = Just $ snd $ head historymatches+  in bestmatch++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) $ +   withCompletion (dateCompleter def) $+   defaultTo' def $ nonEmpty $ +   maybeExit $+   maybeRestartTransaction $+   -- maybeShowHelp $+   line $ green $ printf "Date%s: " (showDefault def)+    where+      parseSmartDateAndCode refdate s = either (const Nothing) (\(d,c) -> return (fixSmartDate refdate d, c)) edc           where-            retry msg = liftIO (hPutStrLn stderr $ "\n" ++ (capitalize msg) ++ "please re-enter.") >> getvalidpostings+            edc = parseWithCtx nullctx dateandcodep $ lowercase s+            dateandcodep = do+                d <- smartdate+                c <- optionMaybe codep+                many spacenonewline+                eof+                return (d, fromMaybe "" c)+      -- defday = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) defdate+      -- datestr = showDate $ fixSmartDate defday smtdate -  when (isJust bestmatch) $ liftIO $ hPrintf stderr "\nUsing this existing transaction for defaults:\n%s" (show $ fromJust bestmatch)-  getvalidpostings `E.catch` \(_::RestartEntryException) -> return Nothing+descriptionAndCommentWizard EntryState{..} = do+  let def = headDef "" esArgs+  s <- withCompletion (descriptionCompleter esJournal def) $+       defaultTo' def $ nonEmpty $ +       maybeRestartTransaction $+       line $ green $ printf "Description%s: " (showDefault def)+  let (desc,comment) = (strip a, strip $ dropWhile (==';') b) where (a,b) = break (==';') s+  return (desc,comment) --- | Read postings from the command line until . is entered, generating--- useful defaults based on historical context and postings entered so far.-getPostingsLoop :: PostingsState -> [Posting] -> [String] -> IO [Posting]-getPostingsLoop st enteredps defargs = do-  let bestmatch | isNothing historicalps = Nothing-                | n <= length ps = Just $ ps !! (n-1)-                | otherwise = Nothing-                where Just ps = historicalps-      bestmatchacct = maybe Nothing (Just . showacctname) bestmatch-      defacct  = maybe bestmatchacct Just $ headMay defargs-      defargs' = tailDef [] defargs-      ordot | null enteredps || length enteredrealps == 1 = "" :: String-            | otherwise = " (or . to complete this transaction)"-  account <- runInteraction j $ askFor (printf "account %d%s" n ordot) defacct (Just accept)-  when (account=="<") $ throwIO RestartEntryException-  if account=="."-    then-     if null enteredps-      then do hPutStrLn stderr $ "\nPlease enter some postings first."-              getPostingsLoop st enteredps defargs-      else return enteredps-    else do-      let defacctused = Just account == defacct-          historicalps' = if defacctused then historicalps else Nothing-          bestmatch' | isNothing historicalps' = Nothing-                     | n <= length ps = Just $ ps !! (n-1)-                     | otherwise = Nothing-                     where Just ps = historicalps'-          defamountstr | isJust commandlineamt                  = commandlineamt-                       | isJust bestmatch' && suggesthistorical = Just historicalamountstr-                       | n > 1                                  = Just balancingamountstr-                       | otherwise                              = Nothing-              where-                commandlineamt      = headMay defargs'-                historicalamountstr = showMixedAmountWithPrecision p $ pamount $ fromJust bestmatch'-                balancingamountstr  = showMixedAmountWithPrecision p $ negate $ sum $ map pamount enteredrealps-                -- what should this be ?-                -- 1 maxprecision (show all decimal places or none) ?-                -- 2 maxprecisionwithpoint (show all decimal places or .0 - avoids some but not all confusion with thousands separators) ?-                -- 3 canonical precision for this commodity in the journal ?-                -- 4 maximum precision entered so far in this transaction ?-                -- 5 3 or 4, whichever would show the most decimal places ?-                -- I think 1 or 4, whichever would show the most decimal places-                p = maxprecisionwithpoint-          defargs'' = tailDef [] defargs'-      amt <- runInteractionDefault $ askFor (printf "amount  %d" n) defamountstr validateamount-      when (amt=="<") $ throwIO RestartEntryException-      let (amountstr,comment) = (strip a, strip $ dropWhile (==';') b) where (a,b) = break (==';') amt-      let a  = fromparse $ runParser (amountp <|> return missingamt) ctx     "" amountstr-          a' = fromparse $ runParser (amountp <|> return missingamt) nullctx "" amountstr-          wasdefamtused = Just (showAmount a) == defamountstr-          defcommodityadded | acommodity a == acommodity a' = Nothing-                                | otherwise                     = Just $ acommodity a-          p = nullposting{paccount=stripbrackets account-                         ,pamount=mixed a-                         ,pcomment=comment-                         ,ptype=postingtype account-                         }-          st' = if wasdefamtused-                 then st-                 else st{psHistory=historicalps', psSuggestHistoricalAmount=False}-      when (isJust defcommodityadded) $-           liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (fromJust defcommodityadded)-      getPostingsLoop st' (enteredps ++ [p]) defargs''+postingsWizard es@EntryState{..} = do+  mp <- postingWizard es+  case mp of Nothing -> return esPostings+             Just p  -> postingsWizard es{esArgs=drop 2 esArgs, esPostings=esPostings++[p]}++postingWizard es@EntryState{..} = do+  acct <- accountWizard es+  if acct `elem` [".",""]+  then case (esPostings, postingsBalanced esPostings) of+         ([],_)    -> liftIO (hPutStrLn stderr "Please enter some postings first.") >> postingWizard es+         (_,False) -> liftIO (hPutStrLn stderr "Please enter more postings to balance the transaction.") >> postingWizard es+         (_,True)  -> return Nothing -- no more postings, end of transaction+  else do+    let es1 = es{esArgs=drop 1 esArgs}+    (amt,comment)  <- amountAndCommentWizard es1+    return $ Just nullposting{paccount=stripbrackets acct+                             ,pamount=mixed amt+                             ,pcomment=comment+                             ,ptype=accountNamePostingType acct+                             }++postingsBalanced :: [Posting] -> Bool+postingsBalanced ps = isRight $ balanceTransaction Nothing nulltransaction{tpostings=ps}++accountWizard EntryState{..} = do+  let pnum = length esPostings + 1+      historicalp = maybe Nothing (Just . (!! (pnum-1)) . (++ (repeat nullposting)) . tpostings) esSimilarTransaction+      historicalacct = case historicalp of Just p  -> showAccountName Nothing (ptype p) (paccount p)+                                           Nothing -> ""+      def = headDef historicalacct esArgs+      endmsg | canfinish && null def = " (or . or enter to finish this transaction)"+             | canfinish             = " (or . to finish this transaction)"+             | otherwise             = ""+  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 $ +   maybeRestartTransaction $+   line $ green $ printf "Account %d%s%s: " pnum (endmsg::String) (showDefault def)     where-      j = psJournal st-      historicalps = psHistory st-      ctx = jContext j-      accept = psAccept st-      suggesthistorical = psSuggestHistoricalAmount st-      n = length enteredps + 1-      enteredrealps = filter isReal enteredps-      showacctname p = showAccountName Nothing (ptype p) $ paccount p-      postingtype ('[':_) = BalancedVirtualPosting-      postingtype ('(':_) = VirtualPosting-      postingtype _ = RegularPosting-      validateamount = Just $ \s -> (null s && not (null enteredrealps))-                                    || s == "<"-                                    || (isRight (runParser (amountp >> many spacenonewline >> optional (char ';' >> many anyChar) >> eof) ctx "" s)-                                        && s /= ".")+      canfinish = not (null esPostings) && postingsBalanced esPostings+      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+      dbg = id -- strace+      validateAccount s | no_new_accounts_ esOpts && not (s `elem` journalAccountNames esJournal) = Nothing+                        | otherwise = Just s --- | Prompt for and read a string value, optionally with a default value--- and a validator. A validator causes the prompt to repeat until the--- input is valid. May also raise an EOF exception if control-d or control-c is pressed.-askFor :: String -> Maybe String -> Maybe (String -> Bool) -> InputT IO String-askFor prompt def validator = do-  l <- fmap (maybe eofErr id)-            $ getInputLine $ prompt ++ " ? " ++ maybe "" showdef def ++ ": "-  let input = if null l then fromMaybe l def else l-  case validator of-    Just valid -> if valid input-                   then return input-                   else askFor prompt def validator-    Nothing -> return input+amountAndCommentWizard EntryState{..} = do+  let pnum = length esPostings + 1+      (mhistoricalp,followedhistoricalsofar) =+          case esSimilarTransaction of+            Nothing                        -> (Nothing,False)+            Just Transaction{tpostings=ps} -> (if length ps >= pnum then Just (ps !! (pnum-1)) else Nothing+                                              ,all (\(a,b) -> pamount a == pamount b) $ zip esPostings ps)+      def = case (esArgs, mhistoricalp, followedhistoricalsofar) of+              (d:_,_,_)                                             -> d+              (_,Just hp,True)                                      -> showamt $ pamount hp+              _  | pnum > 1 && not (isZeroMixedAmount balancingamt) -> showamt balancingamt+              _                                                     -> ""+  retryMsg "A valid hledger amount is required. Eg: 1, $2, 3 EUR, \"4 red apples\"." $+   parser parseAmountAndComment $ +   withCompletion (amountCompleter def) $+   defaultTo' def $ nonEmpty $ +   maybeRestartTransaction $+   line $ green $ printf "Amount  %d%s: " pnum (showDefault def)+    where  +      parseAmountAndComment = either (const Nothing) Just . parseWithCtx (jContext esJournal) amountandcommentp+      amountandcommentp = do+        a <- amountp+        many spacenonewline+        c <- fromMaybe "" `fmap` optionMaybe (char ';' >> many anyChar)+        -- eof+        return (a,c)+      balancingamt = negate $ sum $ map pamount realps where realps = filter isReal esPostings+      showamt = showMixedAmountWithPrecision+                  -- what should this be ?+                  -- 1 maxprecision (show all decimal places or none) ?+                  -- 2 maxprecisionwithpoint (show all decimal places or .0 - avoids some but not all confusion with thousands separators) ?+                  -- 3 canonical precision for this commodity in the journal ?+                  -- 4 maximum precision entered so far in this transaction ?+                  -- 5 3 or 4, whichever would show the most decimal places ?+                  -- I think 1 or 4, whichever would show the most decimal places+                  maxprecisionwithpoint+  --+  -- let -- (amt,comment) = (strip a, strip $ dropWhile (==';') b) where (a,b) = break (==';') amtcmt+      -- a           = fromparse $ runParser (amountp <|> return missingamt) (jContext esJournal) "" amt+  --     awithoutctx = fromparse $ runParser (amountp <|> return missingamt) nullctx              "" amt+  --     defamtaccepted = Just (showAmount a) == mdefamt+  --     es2 = if defamtaccepted then es1 else es1{esHistoricalPostings=Nothing}+  --     mdefaultcommodityapplied = if acommodity a == acommodity awithoutctx then Nothing else Just $ acommodity a+  -- when (isJust mdefaultcommodityapplied) $+  --      liftIO $ hPutStrLn stderr $ printf "using default commodity (%s)" (fromJust mdefaultcommodityapplied)++maybeExit = parser (\s -> if s=="." then throw UnexpectedEOF else Just s)++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 $ +--                        parser (\s -> if s=="?" then Nothing else Just s) wizard++-- Completion helpers++dateCompleter :: String -> CompletionFunc IO+dateCompleter = completer ["today","tomorrow","yesterday"]++descriptionCompleter :: Journal -> String -> CompletionFunc IO+descriptionCompleter j = completer (journalDescriptions j)++accountCompleter :: Journal -> String -> CompletionFunc IO+accountCompleter j = completer (journalAccountNamesUsed j)++amountCompleter :: String -> CompletionFunc IO+amountCompleter = completer []++-- | Generate a haskeline completion function from the given+-- completions and default, that case insensitively completes with+-- prefix matches, or infix matches above a minimum length, or+-- completes the null string with the default.+completer :: [String] -> String -> CompletionFunc IO+completer completions def = completeWord Nothing "" completionsFor     where-        showdef "" = ""-        showdef s = "[" ++ s ++ "]"-        eofErr = E.throw $ mkIOError eofErrorType "end of input" Nothing Nothing+      simpleCompletion' s = (simpleCompletion s){isFinished=False}+      completionsFor "" = return [simpleCompletion' def]+      completionsFor i  = return (map simpleCompletion' ciprefixmatches)+          where+            ciprefixmatches = [c | c <- completions, i `isPrefixOf` c]+            -- mixed-case completions require haskeline > 0.7.1.2+            -- ciprefixmatches = [c | c <- completions, lowercase i `isPrefixOf` lowercase c] --- | Append this transaction to the journal's file, and to the journal's--- transaction list.+--------------------------------------------------------------------------------++-- utilities++defaultTo' = flip defaultTo++withCompletion f = withSettings (setComplete f defaultSettings)++green s = "\ESC[1;32m\STX"++s++"\ESC[0m\STX"++showDefault "" = ""+showDefault s = " [" ++ s ++ "]"++-- | Append this transaction to the journal's file and transaction list. journalAddTransaction :: Journal -> CliOpts -> Transaction -> IO Journal journalAddTransaction j@Journal{jtxns=ts} opts t = do   let f = journalFilePath j@@ -292,6 +375,28 @@         ropts = defreportopts{empty_=True}         opts = defcliopts{reportopts_=ropts} +capitalize :: String -> String+capitalize "" = ""+capitalize (c:cs) = toUpper c : cs++-- Find the most similar and recent transactions matching the given transaction description and report query.+-- Transactions are listed with their "relevancy" score, most relevant first.+transactionsSimilarTo :: Journal -> Query -> String -> [(Double,Transaction)]+transactionsSimilarTo j q desc =+    sortBy compareRelevanceAndRecency+               $ filter ((> threshold).fst)+               [(compareDescriptions desc $ tdescription t, t) | t <- ts]+    where+      compareRelevanceAndRecency (n1,t1) (n2,t2) = compare (n2,tdate t2) (n1,tdate t1)+      ts = filter (q `matchesTransaction`) $ jtxns j+      threshold = 0++compareDescriptions :: [Char] -> [Char] -> Double+compareDescriptions s t = compareStrings s' t'+    where s' = simplify s+          t' = simplify t+          simplify = filter (not . (`elem` "0123456789"))+ -- | Return a similarity measure, from 0 to 1, for two strings. -- This is Simon White's letter pairs algorithm from -- http://www.catalysoft.com/articles/StrikeAMatch.html@@ -307,54 +412,8 @@       u = length pairs1 + length pairs2       pairs1 = wordLetterPairs $ uppercase s1       pairs2 = wordLetterPairs $ uppercase s2+ wordLetterPairs = concatMap letterPairs . words+ letterPairs (a:b:rest) = [a,b] : letterPairs (b:rest) letterPairs _ = []--compareDescriptions :: [Char] -> [Char] -> Double-compareDescriptions s t = compareStrings s' t'-    where s' = simplify s-          t' = simplify t-          simplify = filter (not . (`elem` "0123456789"))--transactionsSimilarTo :: Journal -> Query -> String -> [(Double,Transaction)]-transactionsSimilarTo j q s =-    sortBy compareRelevanceAndRecency-               $ filter ((> threshold).fst)-               [(compareDescriptions s $ tdescription t, t) | t <- ts]-    where-      compareRelevanceAndRecency (n1,t1) (n2,t2) = compare (n2,tdate t2) (n1,tdate t1)-      ts = filter (q `matchesTransaction`) $ jtxns j-      threshold = 0--runInteraction :: Journal -> InputT IO a -> IO a-runInteraction j m = do-    let cc = completionCache j-    runInputT (setComplete (accountCompletion cc) defaultSettings) m--runInteractionDefault :: InputT IO a -> IO a-runInteractionDefault m = do-    runInputT (setComplete noCompletion defaultSettings) m---- A precomputed list of all accounts previously entered into the journal.-type CompletionCache = [AccountName]--completionCache :: Journal -> CompletionCache-completionCache j = -- Only keep unique account names.-                    Set.toList $ Set.fromList-                        [paccount p | t <- jtxns j, p <- tpostings t]--accountCompletion :: CompletionCache -> CompletionFunc IO-accountCompletion cc = completeWord Nothing-                        "" -- don't break words on whitespace, since account names-                           -- can contain spaces.-                        $ \s -> return $ map simpleCompletion-                                        $ filter (s `isPrefixOf`) cc--capitalize :: String -> String-capitalize "" = ""-capitalize (c:cs) = toUpper c : cs--headTailDef :: a -> [a] -> (a,[a])-headTailDef defhead as = (headDef defhead as, tailDef [] as)-

@@ -233,7 +233,8 @@ -}  module Hledger.Cli.Balance (-  balance+  balancemode+ ,balance  ,balanceReportAsText  ,periodBalanceReportAsText  ,cumulativeBalanceReportAsText@@ -243,18 +244,41 @@  import Data.List import Data.Maybe+-- import System.Console.CmdArgs+import System.Console.CmdArgs.Explicit as C+-- import System.Console.CmdArgs.Text import Test.HUnit-import Text.Tabular+import Text.Tabular as T import Text.Tabular.AsciiArt  import Hledger import Prelude hiding (putStr) import Hledger.Utils.UTF8IOCompat (putStr)-import Hledger.Data.FormatStrings+import Hledger.Data.OutputFormat import Hledger.Cli.Options  --- | Print a balance report.+-- | Command line options for this command.+balancemode = (defCommandMode $ ["balance"] ++ aliases) { -- also accept but don't show the common bal alias+  modeHelp = "show accounts and balances" `withAliases` aliases+ ,modeGroupFlags = C.Group {+     groupUnnamed = [+      flagNone ["tree"] (\opts -> setboolopt "tree" opts) "show accounts as a tree (default in simple reports)"+     ,flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show accounts as a list (default in multicolumn)"+     ,flagReq  ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "flat mode: omit N leading account name parts"+     ,flagReq  ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "tree mode: use this custom line format"+     ,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "tree mode: don't squash boring parent accounts"+     ,flagNone ["no-total"] (\opts -> setboolopt "no-total" opts) "don't show the final total"+     ,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"+     ]+    ,groupHidden = []+    ,groupNamed = [generalflagsgroup1]+    }+ }+  where aliases = ["bal"]++-- | The balance command, prints a balance report. balance :: CliOpts -> Journal -> IO () balance CliOpts{reportopts_=ropts} j = do   d <- getCurrentDay@@ -263,11 +287,10 @@          Left err -> [err]          Right _ ->           case (intervalFromOpts ropts, balancetype_ ropts) of-            (NoInterval,_)        -> balanceReportAsText           ropts $ balanceReport ropts (queryFromOpts d ropts) j-            (_,PeriodBalance)     -> periodBalanceReportAsText     ropts $ periodBalanceReport                 ropts (queryFromOpts d ropts) j-            (_,CumulativeBalance) -> cumulativeBalanceReportAsText ropts $ cumulativeOrHistoricalBalanceReport ropts (queryFromOpts d ropts) j-            (_,HistoricalBalance) -> historicalBalanceReportAsText ropts $ cumulativeOrHistoricalBalanceReport ropts (queryFromOpts d ropts) j-+            (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  -- | Render an old-style single-column balance report as plain text.@@ -309,8 +332,8 @@     b         USD -1  ; Account 'b' has two amounts. The account name is printed on the last line. -} -- | Render one balance report line item as plain text suitable for console output.-balanceReportItemAsText :: ReportOpts -> [FormatString] -> BalanceReportItem -> [String]-balanceReportItemAsText opts format (_, accountName, depth, Mixed amounts) =+balanceReportItemAsText :: ReportOpts -> [OutputFormat] -> BalanceReportItem -> [String]+balanceReportItemAsText opts format ((_, accountName, depth), Mixed amounts) =     -- '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@@ -325,7 +348,7 @@       multiline [a]    = [formatBalanceReportItem opts (Just accountName) depth a format]       multiline (a:as) = (formatBalanceReportItem opts Nothing depth a format) : multiline as -formatBalanceReportItem :: ReportOpts -> Maybe AccountName -> Int -> Amount -> [FormatString] -> String+formatBalanceReportItem :: ReportOpts -> Maybe AccountName -> Int -> Amount -> [OutputFormat] -> String formatBalanceReportItem _ _ _ _ [] = "" formatBalanceReportItem opts accountName depth amount (fmt:fmts) =   s ++ (formatBalanceReportItem opts accountName depth amount fmts)@@ -353,8 +376,8 @@     ((" "++) . showDateSpan)     showMixedAmountWithoutPrice     $ Table-      (Group NoLine $ map (Header . padright acctswidth) accts)-      (Group NoLine $ map Header colspans)+      (T.Group NoLine $ map (Header . padright acctswidth) accts)+      (T.Group NoLine $ map Header colspans)       (map snd items')     +----+     totalrow@@ -363,9 +386,9 @@     items' | empty_ opts = items            | otherwise   = items -- dbg "2" $ filter (any (not . isZeroMixedAmount) . snd) $ dbg "1" items     accts = map renderacct items'-    renderacct ((a,a',_i),_)-      | flat_ opts = a-      | otherwise  = a' -- replicate i ' ' ++ +    renderacct ((a,a',i),_)+      | tree_ opts = replicate ((i-1)*2) ' ' ++ a'+      | otherwise  = accountNameDrop (drop_ opts) a     acctswidth = maximum $ map length $ accts     totalrow | no_total_ opts = row "" []              | otherwise      = row "" coltotals@@ -378,15 +401,15 @@    render id ((" "++) . maybe "" (showDate . prevday) . spanEnd) showMixedAmountWithoutPrice $     addtotalrow $       Table-       (Group NoLine $ map (Header . padright acctswidth) accts)-       (Group NoLine $ map Header colspans)+       (T.Group NoLine $ map (Header . padright acctswidth) accts)+       (T.Group NoLine $ map Header colspans)        (map snd items)   where     trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init)     accts = map renderacct items-    renderacct ((a,a',_),_)-      | flat_ opts = a-      | otherwise  = a' -- replicate i ' ' ++ +    renderacct ((a,a',i),_)+      | tree_ opts = replicate ((i-1)*2) ' ' ++ a'+      | otherwise  = accountNameDrop (drop_ opts) a     acctswidth = maximum $ map length $ accts     addtotalrow | no_total_ opts = id                 | otherwise      = (+----+ row "" coltotals)@@ -399,15 +422,15 @@    render id ((" "++) . maybe "" (showDate . prevday) . spanEnd) showMixedAmountWithoutPrice $     addtotalrow $       Table-       (Group NoLine $ map (Header . padright acctswidth) accts)-       (Group NoLine $ map Header colspans)+       (T.Group NoLine $ map (Header . padright acctswidth) accts)+       (T.Group NoLine $ map Header colspans)        (map snd items)   where     trimborder = ("":) . (++[""]) . drop 1 . init . map (drop 1 . init)     accts = map renderacct items-    renderacct ((a,a',_),_)-      | flat_ opts = a-      | otherwise  = a' -- replicate i ' ' ++ +    renderacct ((a,a',i),_)+      | tree_ opts = replicate ((i-1)*2) ' ' ++ a'+      | otherwise  = accountNameDrop (drop_ opts) a     acctswidth = maximum $ map length $ accts     addtotalrow | no_total_ opts = id                 | otherwise      = (+----+ row "" coltotals)

@@ -6,11 +6,13 @@ -}  module Hledger.Cli.Balancesheet (-  balancesheet+  balancesheetmode+ ,balancesheet  ,tests_Hledger_Cli_Balancesheet ) where  import qualified Data.Text.Lazy.IO as LT+import System.Console.CmdArgs.Explicit import Test.HUnit import Text.Shakespeare.Text @@ -19,6 +21,20 @@ import Hledger.Cli.Balance  +balancesheetmode :: Mode RawOpts+balancesheetmode = (defCommandMode $ ["balancesheet"]++aliases) {+  modeHelp = "show a balance sheet" `withAliases` aliases+ ,modeGroupFlags = Group {+     groupUnnamed = [+      flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show accounts as a list"+     ,flagReq  ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "flat mode: omit N leading account name parts"+     ]+    ,groupHidden = []+    ,groupNamed = [generalflagsgroup1]+    }+ }+  where aliases = ["bs"]+ -- | Print a simple balance sheet. balancesheet :: CliOpts -> Journal -> IO () balancesheet CliOpts{reportopts_=ropts} j = do@@ -34,7 +50,6 @@ #{unlines $ balanceReportAsText ropts assetreport} Liabilities: #{unlines $ balanceReportAsText ropts liabilityreport}- Total: -------------------- #{padleft 20 $ showMixedAmountWithoutPrice total}@@ -45,6 +60,7 @@   where p = case period_ of Nothing -> Nothing                             Just (i, DateSpan _ e) -> Just (i, DateSpan Nothing e) +tests_Hledger_Cli_Balancesheet :: Test tests_Hledger_Cli_Balancesheet = TestList  [  ]

@@ -9,11 +9,13 @@ -}  module Hledger.Cli.Cashflow (-  cashflow+  cashflowmode+ ,cashflow  ,tests_Hledger_Cli_Cashflow ) where  import qualified Data.Text.Lazy.IO as LT+import System.Console.CmdArgs.Explicit import Test.HUnit import Text.Shakespeare.Text @@ -22,6 +24,19 @@ import Hledger.Cli.Balance  +cashflowmode :: Mode RawOpts+cashflowmode = (defCommandMode ["cashflow","cf"]) {+  modeHelp = "show a cashflow statement" `withAliases` ["cf"]+ ,modeGroupFlags = Group {+     groupUnnamed = [+      flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show accounts as a list"+     ,flagReq  ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "flat mode: omit N leading account name parts"+     ]+    ,groupHidden = []+    ,groupNamed = [generalflagsgroup1]+    }+ }+ -- | Print a simple cashflow statement. cashflow :: CliOpts -> Journal -> IO () cashflow CliOpts{reportopts_=ropts} j = do@@ -37,12 +52,12 @@  Cash flows: #{unlines $ balanceReportAsText ropts cashreport}- Total: -------------------- #{padleft 20 $ showMixedAmountWithoutPrice total} |] +tests_Hledger_Cli_Cashflow :: Test tests_Hledger_Cli_Cashflow = TestList  [  ]

@@ -1,6 +1,6 @@ {-|  -Print a histogram report.+Print a histogram report. (The "activity" command).  -} @@ -9,6 +9,7 @@ import Data.List import Data.Maybe import Data.Ord+import System.Console.CmdArgs.Explicit import Text.Printf  import Hledger.Cli.Options@@ -19,6 +20,17 @@ import Hledger.Utils.UTF8IOCompat (putStr)  +activitymode = (defCommandMode $ ["activity"] ++ aliases) {+  modeHelp = "show an ascii barchart of posting counts per interval (default: daily)" `withAliases` aliases+ ,modeHelpSuffix = []+ ,modeGroupFlags = Group {+     groupUnnamed = []+    ,groupHidden = []+    ,groupNamed = [generalflagsgroup1]+    }+ }+  where aliases = []+ barchar = '*'  -- | Print a histogram of some statistic per reporting interval, such as@@ -34,7 +46,7 @@       i = intervalFromOpts opts       interval | i == NoInterval = Days 1                | otherwise = i-      span = queryDateSpan (date2_ opts) q `orDatesFrom` journalDateSpan j+      span = queryDateSpan (date2_ opts) q `spanDefaultsFrom` journalDateSpan (date2_ opts) j       spans = filter (DateSpan Nothing Nothing /=) $ splitSpan interval span       spanps = [(s, filter (isPostingInDateSpan s) ps) | s <- spans]       -- same as Register@@ -45,6 +57,6 @@           | queryEmpty q = id           | otherwise = filter (not . isZeroMixedAmount . pamount) -printDayWith f (DateSpan b _, ts) = printf "%s %s\n" (show $ fromJust b) (f ts)+printDayWith f (DateSpan b _, ps) = printf "%s %s\n" (show $ fromJust b) (f ps)  countBar ps = replicate (length ps) barchar

@@ -6,11 +6,13 @@ -}  module Hledger.Cli.Incomestatement (-  incomestatement+  incomestatementmode+ ,incomestatement  ,tests_Hledger_Cli_Incomestatement ) where  import qualified Data.Text.Lazy.IO as LT+import System.Console.CmdArgs.Explicit import Test.HUnit import Text.Shakespeare.Text @@ -18,6 +20,21 @@ import Hledger.Cli.Options import Hledger.Cli.Balance ++incomestatementmode :: Mode RawOpts+incomestatementmode = (defCommandMode $ ["incomestatement"]++aliases) {+  modeHelp = "show an income statement" `withAliases` aliases+ ,modeGroupFlags = Group {+     groupUnnamed = [+      flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show accounts as a list"+     ,flagReq  ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "flat mode: omit N leading account name parts"+     ]+    ,groupHidden = []+    ,groupNamed = [generalflagsgroup1]+    }+ }+  where aliases = ["is"]+ -- | Print a simple income statement. incomestatement :: CliOpts -> Journal -> IO () incomestatement CliOpts{reportopts_=ropts} j = do@@ -32,7 +49,6 @@ #{unlines $ balanceReportAsText ropts incomereport} Expenses: #{unlines $ balanceReportAsText ropts expensereport}- Total: -------------------- #{padleft 20 $ showMixedAmountWithoutPrice total}

@@ -38,18 +38,20 @@  module Hledger.Cli.Main where -import Control.Monad+-- import Control.Monad+import Data.Char (isDigit) import Data.List import Safe-import System.Console.CmdArgs.Explicit (modeHelp)--- import System.Console.CmdArgs.Helper+import System.Console.CmdArgs.Explicit as C import System.Environment import System.Exit+import System.FilePath import System.Process import Text.Printf  import Hledger (ensureJournalFileExists) import Hledger.Cli.Add+import Hledger.Cli.Accounts import Hledger.Cli.Balance import Hledger.Cli.Balancesheet import Hledger.Cli.Cashflow@@ -62,10 +64,119 @@ import Hledger.Cli.Tests import Hledger.Cli.Utils import Hledger.Cli.Version+import Hledger.Data.Dates (getCurrentDay)+import Hledger.Data.RawOptions (RawOpts, optserror)+import Hledger.Reports.ReportOptions (dateSpanFromOpts, intervalFromOpts, queryFromOpts) import Hledger.Utils-import Hledger.Reports-import Hledger.Data.Dates ++-- | The overall cmdargs mode describing command-line options for hledger.+mainmode addons = defMode {+  modeNames = [progname]+ ,modeHelp = unlines []+ ,modeHelpSuffix = [""]+ ,modeArgs = ([], Just $ argsFlag "[ARGS]")+ ,modeGroupModes = Group {+    -- modes (commands) in named groups:+    groupNamed = [+      ("Data entry commands", [+        addmode+       ])+     ,("\nReporting commands", [+        printmode+       ,accountsmode+       ,balancemode+       ,registermode+       ,incomestatementmode+       ,balancesheetmode+       ,cashflowmode+       ,activitymode+       ,statsmode+       ])+     ]+     ++ case addons of [] -> []+                       cs -> [("\nAdd-on commands", map defAddonCommandMode cs)]+    -- modes in the unnamed group, shown first without a heading:+   ,groupUnnamed = [+     ]+    -- modes handled but not shown+   ,groupHidden = [+        testmode+       ,oldconvertmode+     ]+   }+ ,modeGroupFlags = Group {+     -- flags in named groups:+     groupNamed = [generalflagsgroup3]+     -- 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+    }+ }++oldconvertmode = (defCommandMode ["convert"]) {+  modeValue = [("command","convert")]+ ,modeHelp = "convert is no longer needed, just use -f FILE.csv"+ ,modeArgs = ([], Just $ argsFlag "[CSVFILE]")+ ,modeGroupFlags = Group {+     groupUnnamed = []+    ,groupHidden = helpflags+    ,groupNamed = []+    }+ }++builtinCommands :: [Mode RawOpts]+builtinCommands =+  let gs = modeGroupModes $ mainmode []+  in concatMap snd (groupNamed gs) ++ groupUnnamed gs ++ groupHidden gs++builtinCommandNames :: [String]+builtinCommandNames = concatMap modeNames builtinCommands++-- | Parse hledger CLI options from these command line arguments and+-- add-on command names, or raise any error.+argsToCliOpts :: [String] -> [String] -> IO CliOpts+argsToCliOpts args addons = do+  let+    args'        = moveFlagsAfterCommand args+    cmdargsopts  = processValue (mainmode addons) args'+    cmdargsopts' = decodeRawOpts cmdargsopts+  rawOptsToCliOpts cmdargsopts' >>= checkCliOpts++-- | A hacky workaround for cmdargs not accepting flags before the+-- subcommand name: try to detect and move such flags after the+-- command.  This allows the user to put them in either position.+-- The order of options is not preserved, but this should be ok.+--+-- Since we're not parsing flags as precisely as cmdargs here, this is+-- imperfect. We make a decent effort to:+-- - move all no-argument help and input flags+-- - move all required-argument help and input flags along with their values, space-separated or not+-- - not confuse things further or cause misleading errors.+moveFlagsAfterCommand :: [String] -> [String]+moveFlagsAfterCommand args = move args+  where+    move (f:a:as)           | isMovableNoArgFlag f           = (move $ a:as) ++ [f]+    move (f:v:a:as)         | isMovableReqArgFlag f          = (move $ a:as) ++ [f,v]+    move (fv:a:as)          | isMovableReqArgFlagAndValue fv = (move $ a:as) ++ [fv]+    move ("--debug":v:a:as) | not (null v) && all isDigit v  = (move $ a:as) ++ ["--debug",v]+    move ("--debug":a:as)                                    = (move $ a:as) ++ ["--debug"]+    move (fv@('-':'-':'d':'e':'b':'u':'g':'=':_):a:as)       = (move $ a:as) ++ [fv]+    move as = as++    isMovableNoArgFlag a  = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` noargflagstomove+    isMovableReqArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` reqargflagstomove+    isMovableReqArgFlagAndValue ('-':'-':a:as) = case break (== '=') (a:as) of (f:fs,_) -> (f:fs) `elem` reqargflagstomove+                                                                               _        -> False+    isMovableReqArgFlagAndValue ('-':f:_:_) = [f] `elem` reqargflagstomove+    isMovableReqArgFlagAndValue _ = False++    noargflagstomove  = concatMap flagNames $ filter ((==FlagNone).flagInfo) flagstomove+    reqargflagstomove = concatMap flagNames $ filter ((==FlagReq ).flagInfo) flagstomove+    flagstomove = inputflags ++ helpflags++-- | Let's go. main :: IO () main = do @@ -86,59 +197,63 @@     isNullCommand        = null rawcmd     (argsbeforecmd, argsaftercmd') = break (==rawcmd) args     argsaftercmd         = drop 1 argsaftercmd'-  when (debugLevel > 0) $ do-    printf "running: %s\n" prognameandversion-    printf "raw args: %s\n" (show args)-    printf "raw args rearranged for cmdargs: %s\n" (show args')-    printf "raw command might be: %s\n" (show rawcmd)-    printf "raw args before command: %s\n" (show argsbeforecmd)-    printf "raw args after command: %s\n" (show argsaftercmd)+    dbgM :: Show a => String -> a -> IO ()+    dbgM = dbgAtM 2 -  -- search PATH for add-ons-  addons <- getHledgerAddonCommands+  dbgM "running" prognameandversion+  dbgM "raw args" args+  dbgM "raw args rearranged for cmdargs" args'+  dbgM "raw command is probably" rawcmd+  dbgM "raw args before command" argsbeforecmd+  dbgM "raw args after command" argsaftercmd +  -- Search PATH for add-ons, excluding any that match built-in names.+  -- The precise addon names (including file extension) are used for command+  -- parsing, and the display names are used for displaying the commands list.+  (addonPreciseNames', addonDisplayNames') <- hledgerAddons+  let addonPreciseNames = filter (not . (`elem` builtinCommandNames) . dropExtension) addonPreciseNames'+  let addonDisplayNames = filter (not . (`elem` builtinCommandNames)) addonDisplayNames'+   -- parse arguments with cmdargs-  opts <- argsToCliOpts args addons+  opts <- argsToCliOpts args addonPreciseNames    -- select an action and run it.   let     cmd                  = command_ opts -- the full matched internal or external command name, if any-    isInternalCommand    = not (null cmd) && not (cmd `elem` addons) -- probably-    isExternalCommand    = not (null cmd) && cmd `elem` addons -- probably+    isInternalCommand    = cmd `elem` builtinCommandNames -- not (null cmd) && not (cmd `elem` addons)+    isExternalCommand    = not (null cmd) && cmd `elem` addonPreciseNames -- probably     isBadCommand         = not (null rawcmd) && null cmd     hasHelp args         = any (`elem` args) ["--help","-h","-?"]     hasVersion           = ("--version" `elem`)-    mainmode'            = mainmode addons-    generalHelp          = putStr $ showModeHelp mainmode'+    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-  when (debug_ opts > 0) $ do-    putStrLn $ "processed opts:\n" ++ ppShow opts-    putStrLn $ "command matched: " ++ show cmd-    putStrLn $ "isNullCommand: " ++ show isNullCommand-    putStrLn $ "isInternalCommand: " ++ show isInternalCommand-    putStrLn $ "isExternalCommand: " ++ show isExternalCommand-    putStrLn $ "isBadCommand: " ++ show isBadCommand-    d <- getCurrentDay-    putStrLn $ "date span from opts: " ++ (show $ dateSpanFromOpts d $ reportopts_ opts)-    putStrLn $ "interval from opts: " ++ (show $ intervalFromOpts $ reportopts_ opts)-    putStrLn $ "query from opts & args: " ++ (show $ queryFromOpts d $ reportopts_ opts)+  dbgM "processed opts" opts+  dbgM "command matched" cmd+  dbgM "isNullCommand" isNullCommand+  dbgM "isInternalCommand" isInternalCommand+  dbgM "isExternalCommand" isExternalCommand+  dbgM "isBadCommand" isBadCommand+  d <- getCurrentDay+  dbgM "date span from opts" (dateSpanFromOpts d $ reportopts_ opts)+  dbgM "interval from opts" (intervalFromOpts $ reportopts_ opts)+  dbgM "query from opts & args" (queryFromOpts d $ reportopts_ opts)   let-    dbg s = if debug_ opts > 0 then trace s else id     runHledgerCommand       -- high priority flags and situations. --help should be highest priority.-      | hasHelp argsbeforecmd    = dbg "--help before command, showing general help" generalHelp+      | hasHelp argsbeforecmd    = dbgM "" "--help before command, showing general help" >> generalHelp       | not (hasHelp argsaftercmd) && (hasVersion argsbeforecmd || (hasVersion argsaftercmd && isInternalCommand))                                  = version       -- \| (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            = dbg "no command, showing general help" generalHelp+      | isNullCommand            = dbgM "" "no command, showing general help" >> generalHelp       | isBadCommand             = badCommandError        -- internal commands       | cmd == "activity"        = withJournalDo opts histogram       `orShowHelp` activitymode       | cmd == "add"             = (journalFilePathFromOpts opts >>= ensureJournalFileExists >> withJournalDo opts add) `orShowHelp` addmode+      | cmd == "accounts"        = withJournalDo opts accounts        `orShowHelp` accountsmode       | cmd == "balance"         = withJournalDo opts balance         `orShowHelp` balancemode       | cmd == "balancesheet"    = withJournalDo opts balancesheet    `orShowHelp` balancesheetmode       | cmd == "cashflow"        = withJournalDo opts cashflow        `orShowHelp` cashflowmode@@ -150,15 +265,15 @@        -- an external command       | isExternalCommand = do-          let shellcmd = printf "%s-%s %s" progname cmd (unwords' argsaftercmd)-          when (debug_ opts > 0) $ do-            printf "external command selected: %s\n" cmd-            printf "external command arguments: %s\n" (show argsaftercmd)-            printf "running shell command: %s\n" (show shellcmd)+          let externalargs = filter (not.(=="--")) argsaftercmd+          let shellcmd = printf "%s-%s %s" progname cmd (unwords' externalargs) :: String+          dbgM "external command selected" cmd+          dbgM "external command arguments" (map quoteIfNeeded externalargs)+          dbgM "running shell command" shellcmd           system shellcmd >>= exitWith        -- deprecated commands-      | cmd == "convert"         = error' (modeHelp convertmode) >> exitFailure+      | cmd == "convert"         = error' (modeHelp oldconvertmode) >> exitFailure        -- shouldn't reach here       | otherwise                = optserror ("could not understand the arguments "++show args) >> exitFailure

@@ -1,165 +1,131 @@-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables, DeriveDataTypeable #-}+{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-} {-| -Command-line options for the hledger program, and related utilities.+Common cmdargs modes and flags, a command-line options type, and+related utilities used by hledger commands.  -}  module Hledger.Cli.Options ( -  -- * cmdargs modes & flags-  -- | These tell cmdargs how to parse the command line arguments.-  -- There's one mode for each internal subcommand, plus a main mode.-  mainmode,-  activitymode,-  addmode,-  balancemode,-  balancesheetmode,-  cashflowmode,-  incomestatementmode,-  printmode,-  registermode,-  statsmode,-  testmode,-  convertmode,-  defCommandMode,-  argsFlag,+  -- * cmdargs flags & modes   helpflags,   inputflags,   reportflags,   generalflagsgroup1,   generalflagsgroup2,   generalflagsgroup3,+  defMode,+  defCommandMode,+  defAddonCommandMode,+  argsFlag,+  showModeHelp,+  withAliases,   -  -- * raw options-  -- | To allow the cmdargs modes to be reused and extended by other-  -- packages (eg, add-ons which want to mimic the standard hledger-  -- options), we parse the command-line arguments to a simple-  -- association list, not a fixed ADT.-  RawOpts,-  inRawOpts,-  boolopt,-  intopt,-  maybeintopt,-  stringopt,-  maybestringopt,-  listofstringopt,-  setopt,-  setboolopt,-   -- * CLI options-  -- | Raw options are converted to a more convenient,-  -- package-specific options structure. This is the \"opts\" used-  -- throughout hledger CLI code.   CliOpts(..),   defcliopts,+  getCliOpts,+  decodeRawOpts,+  rawOptsToCliOpts,+  checkCliOpts, +  -- possibly these should move into argsToCliOpts   -- * CLI option accessors-  -- | Some options require more processing. Possibly these should be merged into argsToCliOpts.+  -- | These do the extra processing required for some options.   aliasesFromOpts,-  formatFromOpts,   journalFilePathFromOpts,   rulesFilePathFromOpts,+  -- | For register:   OutputWidth(..),   Width(..),   defaultWidth,   defaultWidthWithFlag,   widthFromOpts,+  -- | For balance:+  formatFromOpts, -  -- * utilities-  getHledgerAddonCommands,-  argsToCliOpts,-  moveFlagsAfterCommand,-  decodeRawOpts,-  checkCliOpts,-  rawOptsToCliOpts,-  optserror,-  showModeHelp,-  debugArgs,-  getCliOpts,+  -- * Other utils+  hledgerAddons, -  -- * tests+  -- * Tests   tests_Hledger_Cli_Options  )  where    import qualified Control.Exception as C--- import Control.Monad (filterM) import Control.Monad (when)-import Data.Char (isDigit) import Data.List-import Data.List.Split import Data.Maybe-import Data.Time.Calendar import Safe import System.Console.CmdArgs import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Text import System.Directory import System.Environment-import System.Exit+import System.Exit (exitSuccess)+import System.FilePath import Test.HUnit import Text.ParserCombinators.Parsec as P-import Text.Printf  import Hledger-import Hledger.Data.FormatStrings as Format+import Hledger.Data.OutputFormat as OutputFormat import Hledger.Cli.Version --- --- 1. cmdargs mode and flag (option) definitions for the hledger CLI,--- can be reused by other packages as well.--- --- | Our cmdargs modes parse arguments into an association list for better reuse.-type RawOpts = [(String,String)]---- common flags and flag groups+-- common cmdargs flags  -- | Common help flags: --help, --debug, --version...+helpflags :: [Flag RawOpts] helpflags = [-  flagNone ["help","h","?"] (setboolopt "help") "Display general help or (with --help after COMMAND) command help."+  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 (optional argument sets debug level)"- ,flagNone ["version"] (setboolopt "version") "Print version information"+ ,flagOpt "1" ["debug"] (\s opts -> Right $ setopt "debug" s opts) "N" "show debug output (increase N for more)"+ ,flagNone ["version"] (setboolopt "version") "show version information"  ]  -- | 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 journal file; - means stdin"- ,flagReq ["rules-file"]  (\s opts -> Right $ setopt "rules-file" s opts) "RULESFILE" "conversion rules for CSV (default: FILE.rules)"- ,flagReq ["alias"]  (\s opts -> Right $ setopt "alias" s opts)  "ACCT=ALIAS" "convert ACCT's name to ALIAS"+  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"  ] --- | Common report-related flags: --period, --cost, --display etc.+-- | Common report-related flags: --period, --cost, etc.+reportflags :: [Flag RawOpts] reportflags = [-  flagReq  ["begin","b"]     (\s opts -> Right $ setopt "begin" s opts) "DATE" "report on transactions on or after this date"- ,flagReq  ["end","e"]       (\s opts -> Right $ setopt "end" s opts) "DATE" "report on transactions before this date"- ,flagReq  ["period","p"]    (\s opts -> Right $ setopt "period" s opts) "PERIODEXP" "report on transactions during the specified period and/or with the specified reporting interval"- ,flagNone ["daily","D"]     (\opts -> setboolopt "daily" opts) "report by day"- ,flagNone ["weekly","W"]    (\opts -> setboolopt "weekly" opts) "report by week"- ,flagNone ["monthly","M"]   (\opts -> setboolopt "monthly" opts) "report by month"- ,flagNone ["quarterly","Q"] (\opts -> setboolopt "quarterly" opts) "report by quarter"- ,flagNone ["yearly","Y"]    (\opts -> setboolopt "yearly" opts) "report by year"- ,flagNone ["cleared","C"]   (\opts -> setboolopt "cleared" opts) "report only on cleared transactions"- ,flagNone ["uncleared","U"] (\opts -> setboolopt "uncleared" opts) "report only on uncleared transactions"- ,flagNone ["cost","B"]      (\opts -> setboolopt "cost" opts) "report cost of commodities"- ,flagReq  ["depth"]         (\s opts -> Right $ setopt "depth" s opts) "N" "hide accounts/transactions deeper than this"- ,flagReq  ["display","d"]   (\s opts -> Right $ setopt "display" s opts) "DISPLAYEXP" "show only transactions matching the expression, which is 'dOP[DATE]' where OP is <, <=, =, >=, >"- ,flagNone ["date2","aux-date","effective"]     (\opts -> setboolopt "date2" opts) "use transactions' secondary dates, if any"- ,flagNone ["empty","E"]     (\opts -> setboolopt "empty" opts) "show empty/zero things which are normally elided"- ,flagNone ["real","R"]      (\opts -> setboolopt "real" opts) "report only on real (non-virtual) transactions"+  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"+ ,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 ["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"+ ,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"  ] +argsFlag :: FlagHelp -> Arg RawOpts argsFlag desc = flagArg (\s opts -> Right $ setopt "args" s opts) desc +generalflagstitle :: String generalflagstitle = "\nGeneral flags"++generalflagsgroup1, generalflagsgroup2, generalflagsgroup3 :: (String, [Flag RawOpts]) generalflagsgroup1 = (generalflagstitle, inputflags ++ reportflags ++ helpflags) generalflagsgroup2 = (generalflagstitle, inputflags ++ helpflags) generalflagsgroup3 = (generalflagstitle, helpflags) --- cmdargs modes+-- cmdargs mode constructors  -- | A basic mode template. defMode :: Mode RawOpts@@ -174,7 +140,7 @@  ,modeGroupFlags = Group {      groupNamed = []     ,groupUnnamed = [-        flagNone ["help","h","?"] (setboolopt "help") "Display command help."+        flagNone ["help","h","?"] (setboolopt "help") "Show command help."         ]     ,groupHidden = []     }@@ -183,6 +149,7 @@  }  -- | A basic subcommand mode with the given command name(s).+defCommandMode :: [Name] -> Mode RawOpts defCommandMode names = defMode {    modeNames=names   ,modeValue=[("command", headDef "" names)]@@ -190,9 +157,10 @@   }  -- | A basic subcommand mode suitable for an add-on command.+defAddonCommandMode :: Name -> Mode RawOpts defAddonCommandMode addon = defMode {    modeNames = [addon]-  ,modeHelp = printf "run %s-%s" progname addon+  ,modeHelp = fromMaybe "" $ lookup (stripAddonExtension addon) standardAddonsHelp   ,modeValue=[("command",addon)]   ,modeGroupFlags = Group {       groupUnnamed = []@@ -202,64 +170,45 @@   ,modeArgs = ([], Just $ argsFlag "[ARGS]")   } +-- | Built-in descriptions for some of the known external addons,+-- since we don't currently have any way to ask them.+standardAddonsHelp :: [(String,String)]+standardAddonsHelp = [+   ("chart", "generate simple balance pie charts")+  ,("interest", "generate interest transaction entries")+  ,("irr", "calculate internal rate of return")+  ,("vty", "start the curses-style interface")+  ,("web", "start the web interface")+  ,("accounts", "list account names")+  ,("balance-csv", "output a balance report as CSV")+  ,("equity", "show a transaction entry zeroing all accounts")+  ,("print-unique", "print only transactions with unique descriptions")+  ,("register-csv", "output a register report as CSV")+  ,("rewrite", "add specified postings to matched transaction entries")+  ,("addon",  "dummy add-on command for testing")+  ,("addon2", "dummy add-on command for testing")+  ,("addon3", "dummy add-on command for testing")+  ,("addon4", "dummy add-on command for testing")+  ,("addon5", "dummy add-on command for testing")+  ,("addon6", "dummy add-on command for testing")+  ,("addon7", "dummy add-on command for testing")+  ,("addon8", "dummy add-on command for testing")+  ,("addon9", "dummy add-on command for testing")+  ]++-- | Get a mode's help message as a nicely wrapped string.+showModeHelp :: Mode a -> String+showModeHelp = (showText defaultWrap :: [Text] -> String) . +               (helpText [] HelpFormatDefault :: Mode a -> [Text])+ -- | Add command aliases to the command's help string. withAliases :: String -> [String] -> String s `withAliases` []     = s-s `withAliases` (a:[]) = s ++ " (alias: " ++ a ++ ")"-s `withAliases` as     = s ++ " (aliases: " ++ intercalate ", " as ++ ")"+s `withAliases` as = s ++ " (" ++ intercalate ", " as ++ ")"+-- s `withAliases` (a:[]) = s ++ " (alias: " ++ a ++ ")"+-- s `withAliases` as     = s ++ " (aliases: " ++ intercalate ", " as ++ ")"  --- | The top-level cmdargs mode for hledger.-mainmode addons = defMode {-  modeNames = [progname]- ,modeHelp = unlines [-      "run the specified hledger command. Commands:"-     ]- ,modeHelpSuffix = [""]- ,modeArgs = ([], Just $ argsFlag "[ARGS]")- ,modeGroupModes = Group {-    -- modes (commands) in named groups:-    groupNamed = [-      ("Adding data", [-        addmode-       ])-     ,("\nBasic reports", [-        printmode-       ,balancemode-       ,registermode-       -- ,transactionsmode-       ])-     ,("\nMore reports", [-        activitymode-       ,incomestatementmode-       ,balancesheetmode-       ,cashflowmode-       ,statsmode-       ])-     ,("\nMiscellaneous", [-        testmode-       ])-     ]-     ++ case addons of [] -> []-                       cs -> [("\nAdd-on commands found", map defAddonCommandMode cs)]-    -- modes in the unnamed group, shown first without a heading:-   ,groupUnnamed = [-     ]-    -- modes handled but not shown-   ,groupHidden = [-        convertmode-     ]-   }- ,modeGroupFlags = Group {-     -- flags in named groups:-     groupNamed = [generalflagsgroup3]-     -- 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-    }- }- -- help_postscript = [ --   -- "DATES can be Y/M/D or smart dates like \"last month\"." --   -- ,"PATTERNS are regular"@@ -268,151 +217,13 @@ --   -- ,"When using both, not: comes last." --  ] --- visible subcommand modes -addmode = (defCommandMode ["add"]) {-  modeHelp = "prompt for new transaction entries and add them to the journal"- ,modeHelpSuffix = ["Defaults come from previous similar transactions; use query patterns to restrict these."]- ,modeGroupFlags = Group {-     groupUnnamed = [-      flagNone ["no-new-accounts"]  (\opts -> setboolopt "no-new-accounts" opts) "don't allow creating new accounts"-     ]-    ,groupHidden = []-    ,groupNamed = [generalflagsgroup2]-    }- }--balancemode = (defCommandMode $ ["balance"] ++ aliases) {-  modeHelp = "show matched accounts and their balances" `withAliases` aliases- ,modeGroupFlags = Group {-     groupUnnamed = [-      flagNone ["cumulative"] (\opts -> setboolopt "cumulative" opts) "with a reporting interval, show accumulated totals starting from 0"-     ,flagNone ["historical","H"] (\opts -> setboolopt "historical" opts) "with a reporting interval, show accurate historical ending balances"-     ,flagNone ["flat"] (\opts -> setboolopt "flat" opts) "show full account names, unindented"-     ,flagReq  ["drop"] (\s opts -> Right $ setopt "drop" s opts) "N" "with --flat, omit this many leading account name components"-     ,flagReq  ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format"-     ,flagNone ["no-elide"] (\opts -> setboolopt "no-elide" opts) "no eliding at all, stronger than --empty"-     ,flagNone ["no-total"] (\opts -> setboolopt "no-total" opts) "don't show the final total"-     ]-    ,groupHidden = []-    ,groupNamed = [generalflagsgroup1]-    }- }-  where aliases = ["b","bal"]--printmode = (defCommandMode $ ["print"] ++ aliases) {-  modeHelp = "show matched journal entries" `withAliases` aliases- ,modeGroupFlags = Group {-     groupUnnamed = []-    ,groupHidden = []-    ,groupNamed = [generalflagsgroup1]-    }- }-  where aliases = ["p"]--registermode = (defCommandMode $ ["register"] ++ aliases) {-  modeHelp = "show matched postings and running total" `withAliases` aliases- ,modeGroupFlags = Group {-     groupUnnamed = [-      flagOpt (show defaultWidthWithFlag) ["width","w"] (\s opts -> Right $ setopt "width" s opts) "N" "increase or set the output width (default: 80)"-     ,flagNone ["average","A"] (\opts -> setboolopt "average" opts) "show the running average instead of the running total"-     ,flagNone ["related","r"] (\opts -> setboolopt "related" opts) "show the other postings in the transactions of those that would have been shown"-     ]-    ,groupHidden = []-    ,groupNamed = [generalflagsgroup1]-    }- }-  where aliases = ["r","reg"]---- transactionsmode = (defCommandMode ["transactions"]) {---   modeHelp = "show matched transactions and balance in some account(s)"---  ,modeGroupFlags = Group {---      groupUnnamed = []---     ,groupHidden = []---     ,groupNamed = [generalflagsgroup1]---     }---  }--activitymode = (defCommandMode ["activity"]) {-  modeHelp = "show a barchart of transactions per interval"- ,modeHelpSuffix = ["The default interval is daily."]- ,modeGroupFlags = Group {-     groupUnnamed = []-    ,groupHidden = []-    ,groupNamed = [generalflagsgroup1]-    }- }--incomestatementmode = (defCommandMode $ ["incomestatement"]++aliases) {-  modeHelp = "show a simple income statement" `withAliases` aliases- ,modeGroupFlags = Group {-     groupUnnamed = []-    ,groupHidden = []-    ,groupNamed = [generalflagsgroup1]-    }- }-  where aliases = ["is","pl"]--balancesheetmode = (defCommandMode $ ["balancesheet"]++aliases) {-  modeHelp = "show a simple balance sheet" `withAliases` aliases- ,modeGroupFlags = Group {-     groupUnnamed = []-    ,groupHidden = []-    ,groupNamed = [generalflagsgroup1]-    }- }-  where aliases = ["bs"]--cashflowmode = (defCommandMode ["cashflow","cf"]) {-  modeHelp = "show a simple cashflow statement" `withAliases` ["cf"]- ,modeGroupFlags = Group {-     groupUnnamed = []-    ,groupHidden = []-    ,groupNamed = [generalflagsgroup1]-    }- }--statsmode = (defCommandMode $ ["stats"] ++ aliases) {-  modeHelp = "show quick statistics for a journal" `withAliases` aliases- ,modeGroupFlags = Group {-     groupUnnamed = []-    ,groupHidden = []-    ,groupNamed = [generalflagsgroup1]-    }- }-  where aliases = ["s"]--testmode = (defCommandMode ["test"]) {-  modeHelp = "run self-tests, or just the ones matching REGEXPS"- ,modeArgs = ([], Just $ argsFlag "[REGEXPS]")- ,modeGroupFlags = Group {-     groupUnnamed = []-    ,groupHidden = []-    ,groupNamed = [generalflagsgroup3]-    }- }---- hidden commands--convertmode = (defCommandMode ["convert"]) {-  modeValue = [("command","convert")]- ,modeHelp = "convert is no longer needed, just use -f FILE.csv"- ,modeArgs = ([], Just $ argsFlag "[CSVFILE]")- ,modeGroupFlags = Group {-     groupUnnamed = []-    ,groupHidden = helpflags-    ,groupNamed = []-    }- }------- 2. A package-specific data structure holding options used in this--- package and above, parsed from RawOpts.  This represents the--- command-line options that were provided, with all parsing--- completed, but before adding defaults or derived values (XXX add)---+-- CliOpts --- | Command line options. Used in the @hledger@ package and above.+-- | Command line options, used in the @hledger@ package and above.+-- This is the \"opts\" used throughout hledger CLI code.+-- representing the options that arguments that were provided at+-- startup on the command-line. data CliOpts = CliOpts {      rawopts_         :: RawOpts     ,command_         :: String@@ -425,6 +236,9 @@     ,reportopts_      :: ReportOpts  } deriving (Show, Data, Typeable) +instance Default CliOpts where def = defcliopts++defcliopts :: CliOpts defcliopts = CliOpts     def     def@@ -436,14 +250,16 @@     def     def -instance Default CliOpts where def = defcliopts+-- | Convert possibly encoded option values to regular unicode strings.+decodeRawOpts :: RawOpts -> RawOpts+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 -- today's date. Parsing failures will raise an error. rawOptsToCliOpts :: RawOpts -> IO CliOpts rawOptsToCliOpts rawopts = do-  d <- getCurrentDay+  ropts <- rawOptsToReportOpts rawopts   return defcliopts {               rawopts_         = rawopts              ,command_         = stringopt "command" rawopts@@ -453,80 +269,9 @@              ,debug_           = intopt "debug" rawopts              ,no_new_accounts_ = boolopt "no-new-accounts" rawopts -- add              ,width_           = maybestringopt "width" rawopts    -- register-             ,reportopts_ = defreportopts {-                             begin_     = maybesmartdateopt d "begin" rawopts-                            ,end_       = maybesmartdateopt d "end" rawopts-                            ,period_    = maybeperiodopt d rawopts-                            ,cleared_   = boolopt "cleared" rawopts-                            ,uncleared_ = boolopt "uncleared" rawopts-                            ,cost_      = boolopt "cost" rawopts-                            ,depth_     = maybeintopt "depth" rawopts-                            ,display_   = maybedisplayopt d rawopts-                            ,date2_     = boolopt "date2" rawopts-                            ,empty_     = boolopt "empty" rawopts-                            ,no_elide_  = boolopt "no-elide" rawopts-                            ,real_      = boolopt "real" rawopts-                            ,balancetype_ = balancetypeopt rawopts -- balance-                            ,flat_      = boolopt "flat" rawopts -- balance-                            ,drop_      = intopt "drop" rawopts -- balance-                            ,no_total_  = boolopt "no-total" rawopts -- balance-                            ,daily_     = boolopt "daily" rawopts-                            ,weekly_    = boolopt "weekly" rawopts-                            ,monthly_   = boolopt "monthly" rawopts-                            ,quarterly_ = boolopt "quarterly" rawopts-                            ,yearly_    = boolopt "yearly" rawopts-                            ,format_    = maybestringopt "format" rawopts-                            ,average_   = boolopt "average" rawopts  -- register-                            ,related_   = boolopt "related" rawopts  -- register-                            ,query_     = unwords $ listofstringopt "args" rawopts-                            }+             ,reportopts_      = ropts              }---- | Parse hledger CLI options from these command line arguments and--- add-on command names, or raise any error.-argsToCliOpts :: [String] -> [String] -> IO CliOpts-argsToCliOpts args addons = do-  let-    args'        = moveFlagsAfterCommand args-    cmdargsopts  = System.Console.CmdArgs.Explicit.processValue (mainmode addons) args'-    cmdargsopts' = decodeRawOpts cmdargsopts-  rawOptsToCliOpts cmdargsopts' >>= checkCliOpts---- | A hacky workaround for cmdargs not accepting flags before the--- subcommand name: try to detect and move such flags after the--- command.  This allows the user to put them in either position.--- The order of options is not preserved, but this should be ok.------ Since we're not parsing flags as precisely as cmdargs here, this is--- imperfect. We make a decent effort to:--- - move all no-argument help and input flags--- - move all required-argument help and input flags along with their values, space-separated or not--- - not confuse things further or cause misleading errors.-moveFlagsAfterCommand :: [String] -> [String]-moveFlagsAfterCommand args = move args-  where-    move (f:a:as)           | isMovableNoArgFlag f           = (move $ a:as) ++ [f]-    move (f:v:a:as)         | isMovableReqArgFlag f          = (move $ a:as) ++ [f,v]-    move (fv:a:as)          | isMovableReqArgFlagAndValue fv = (move $ a:as) ++ [fv]-    move ("--debug":v:a:as) | not (null v) && all isDigit v  = (move $ a:as) ++ ["--debug",v]-    move ("--debug":a:as)                                    = (move $ a:as) ++ ["--debug"]-    move (fv@('-':'-':'d':'e':'b':'u':'g':'=':_):a:as)       = (move $ a:as) ++ [fv]-    move as = as--    isMovableNoArgFlag a  = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` noargflagstomove-    isMovableReqArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` reqargflagstomove-    isMovableReqArgFlagAndValue ('-':'-':a:as) = case break (== '=') (a:as) of (f:fs,_) -> (f:fs) `elem` reqargflagstomove-                                                                               _        -> False-    isMovableReqArgFlagAndValue ('-':f:_:_) = [f] `elem` reqargflagstomove-    isMovableReqArgFlagAndValue _ = False--    noargflagstomove  = concatMap flagNames $ filter ((==FlagNone).flagInfo) flagstomove-    reqargflagstomove = concatMap flagNames $ filter ((==FlagReq ).flagInfo) flagstomove-    flagstomove = inputflags ++ helpflags---- | Convert possibly encoded option values to regular unicode strings.-decodeRawOpts = map (\(name,val) -> (name, fromSystemString val))-+   -- | 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@@ -538,115 +283,79 @@     Right _ -> return ()   return opts ------ utils------- | Get the unique suffixes (without hledger-) of hledger-* executables--- found in the current user's PATH, or the empty list if there is any--- problem.-getHledgerAddonCommands :: IO [String]-getHledgerAddonCommands = map (drop (length progname + 1)) `fmap` getHledgerExesInPath---- | Get the unique names of hledger-*{,.hs} executables found in the current--- user's PATH, or the empty list if there is any problem.-getHledgerExesInPath :: IO [String]-getHledgerExesInPath = do-  pathdirs <- splitOn ":" `fmap` getEnvSafe "PATH"-  pathfiles <- concat `fmap` mapM getDirectoryContentsSafe pathdirs-  let hledgernamed = nub $ sort $ filter isHledgerNamed pathfiles-  -- hledgerexes <- filterM isExecutable hledgernamed-  return hledgernamed---- isExecutable f = getPermissions f >>= (return . executable)--isHledgerNamed = isRight . parsewith (do-        string progname-        char '-'-        many1 (letter <|> char '-')-        optional $ (string ".hs" <|> string ".lhs")-        eof-        )--getEnvSafe v = getEnv v `C.catch` (\(_::C.IOException) -> return "")-getDirectoryContentsSafe d = getDirectoryContents d `C.catch` (\(_::C.IOException) -> return [])---- | Raise an error, showing the specified message plus a hint about --help.-optserror = error' . (++ " (run with --help for usage)")--setopt name val = (++ [(name,singleQuoteIfNeeded val)])--setboolopt name = (++ [(name,"")])---- | Is the named option present ?-inRawOpts :: String -> RawOpts -> Bool-inRawOpts name = isJust . lookup name--boolopt = inRawOpts--maybestringopt name = maybe Nothing (Just . stripquotes) . lookup name--stringopt name = fromMaybe "" . maybestringopt name--listofstringopt name rawopts = [v | (k,v) <- rawopts, k==name]--maybeintopt :: String -> RawOpts -> Maybe Int-maybeintopt name rawopts =-    let ms = maybestringopt name rawopts in-    case ms of Nothing -> Nothing-               Just s -> Just $ readDef (optserror $ "could not parse "++name++" number: "++s) s--intopt name = fromMaybe 0 . maybeintopt name+-- Currently only used by some extras/ scripts:+-- | Parse hledger CLI options from the command line using the given+-- cmdargs mode, and either return them or, if a help flag is present,+-- print the mode help and exit the program.+getCliOpts :: Mode RawOpts -> IO CliOpts+getCliOpts mode = do+  args <- getArgs+  let rawopts = decodeRawOpts $ processValue mode args+  opts <- rawOptsToCliOpts rawopts >>= checkCliOpts+  debugArgs args opts+  -- if any (`elem` args) ["--help","-h","-?"]+  when ("help" `inRawOpts` rawopts_ opts) $+    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+        putStrLn $ "processed opts:\n" ++ show opts+        d <- getCurrentDay+        putStrLn $ "search query: " ++ (show $ queryFromOpts d $ reportopts_ opts) -maybesmartdateopt :: Day -> String -> RawOpts -> Maybe Day-maybesmartdateopt d name rawopts =-        case maybestringopt name rawopts of-          Nothing -> Nothing-          Just s -> either-                    (\e -> optserror $ "could not parse "++name++" date: "++show e)-                    Just-                    $ fixSmartDateStrEither' d s+-- CliOpts accessors -maybedisplayopt :: Day -> RawOpts -> Maybe DisplayExp-maybedisplayopt d rawopts =-    maybe Nothing (Just . regexReplaceBy "\\[.+?\\]" fixbracketeddatestr) $ maybestringopt "display" rawopts+-- | Get the account name aliases from options, if any.+aliasesFromOpts :: CliOpts -> [(AccountName,AccountName)]+aliasesFromOpts = map parseAlias . alias_     where-      fixbracketeddatestr "" = ""-      fixbracketeddatestr s = "[" ++ fixSmartDateStr d (init $ tail s) ++ "]"+      -- similar to ledgerAlias+      parseAlias :: String -> (AccountName,AccountName)+      parseAlias s = (accountNameWithoutPostingType $ strip orig+                     ,accountNameWithoutPostingType $ strip alias')+          where+            (orig, alias) = break (=='=') s+            alias' = case alias of ('=':rest) -> rest+                                   _ -> orig -maybeperiodopt :: Day -> RawOpts -> Maybe (Interval,DateSpan)-maybeperiodopt d rawopts =-    case maybestringopt "period" rawopts of-      Nothing -> Nothing-      Just s -> either-                (\e -> optserror $ "could not parse period option: "++show e)-                Just-                $ parsePeriodExpr d s+-- | Get the (tilde-expanded, absolute) journal file path from+-- 1. options, 2. an environment variable, or 3. the default.+journalFilePathFromOpts :: CliOpts -> IO String+journalFilePathFromOpts opts = do+  f <- defaultJournalPath+  d <- getCurrentDirectory+  expandPath d $ fromMaybe f $ file_ opts -balancetypeopt :: RawOpts -> BalanceType-balancetypeopt rawopts-    | length [o | o <- ["cumulative","historical"], isset o] > 1-                         = optserror "please specify at most one of --cumulative and --historical"-    | isset "cumulative" = CumulativeBalance-    | isset "historical" = HistoricalBalance-    | otherwise          = PeriodBalance-    where-      isset = flip boolopt rawopts+-- | Get the (tilde-expanded) rules file path from options, if any.+rulesFilePathFromOpts :: CliOpts -> IO (Maybe FilePath)+rulesFilePathFromOpts opts = do+  d <- getCurrentDirectory+  maybe (return Nothing) (fmap Just . expandPath d) $ rules_file_ opts +-- for balance, currently:+ -- | Parse the format option if provided, possibly returning an error, -- otherwise get the default value.-formatFromOpts :: ReportOpts -> Either String [FormatString]-formatFromOpts = maybe (Right defaultBalanceFormatString) parseFormatString . format_+formatFromOpts :: ReportOpts -> Either String [OutputFormat]+formatFromOpts = maybe (Right defaultBalanceFormat) parseStringFormat . format_  -- | Default line format for balance report: "%20(total)  %2(depth_spacer)%-(account)"-defaultBalanceFormatString :: [FormatString]-defaultBalanceFormatString = [+defaultBalanceFormat :: [OutputFormat]+defaultBalanceFormat = [       FormatField False (Just 20) Nothing TotalField     , FormatLiteral "  "     , FormatField True (Just 2) Nothing DepthSpacerField     , FormatField True Nothing Nothing AccountField     ] +-- for register:+ -- | Output width configuration (for register). data OutputWidth =     TotalWidth Width    -- ^ specify the overall width @@ -660,9 +369,11 @@   deriving Show  -- | Default width of hledger console output.-defaultWidth         = 80+defaultWidth :: Int+defaultWidth = 80  -- | Width of hledger console output when the -w flag is used with no value.+defaultWidthWithFlag :: Int defaultWidthWithFlag = 120  -- | Parse the width option if provided, possibly returning an error,@@ -688,69 +399,109 @@ widthp = (string "auto" >> return Auto)     <|> (Width . read) `fmap` many1 digit --- | Get the account name aliases from options, if any.-aliasesFromOpts :: CliOpts -> [(AccountName,AccountName)]-aliasesFromOpts = map parseAlias . alias_-    where-      -- similar to ledgerAlias-      parseAlias :: String -> (AccountName,AccountName)-      parseAlias s = (accountNameWithoutPostingType $ strip orig-                     ,accountNameWithoutPostingType $ strip alias')-          where-            (orig, alias) = break (=='=') s-            alias' = case alias of ('=':rest) -> rest-                                   _ -> orig+-- Other utils --- | Get the (tilde-expanded, absolute) journal file path from--- 1. options, 2. an environment variable, or 3. the default.-journalFilePathFromOpts :: CliOpts -> IO String-journalFilePathFromOpts opts = do-  f <- defaultJournalPath-  d <- getCurrentDirectory-  expandPath d $ fromMaybe f $ file_ opts+-- | Get the sorted unique precise names and display names of hledger+-- add-ons found in the current user's PATH. The precise names are the+-- add-on's filename with the "hledger-" prefix removed. The display+-- names have the file extension removed also, except when it's needed+-- for disambiguation.+--+-- -- Also when there are exactly two similar names, one with the .hs or+-- -- .lhs extension and the other with the .exe extension or no+-- -- extension - presumably source and compiled versions of a haskell+-- -- script - we exclude the source version.+--+-- This function can return add-on names which shadow built-in command+-- names, but hledger will ignore these.+--+hledgerAddons :: IO ([String],[String])+hledgerAddons = do+  exes <- hledgerExecutablesInPath+  let precisenames = -- concatMap dropRedundant $+                     -- groupBy (\a b -> dropExtension a == dropExtension b) $+                     map stripprefix exes+  let displaynames = concatMap stripext $+                     groupBy (\a b -> dropExtension a == dropExtension b) $+                     precisenames+  return (precisenames, displaynames)+  where+    stripprefix = drop (length progname + 1)+    -- dropRedundant [f,f2] | takeExtension f `elem` ["",".exe"] && takeExtension f2 `elem` [".hs",".lhs"] = [f]+    -- dropRedundant fs = fs+    stripext [f] = [dropExtension f]+    stripext fs  = fs --- | Get the (tilde-expanded) rules file path from options, if any.-rulesFilePathFromOpts :: CliOpts -> IO (Maybe FilePath)-rulesFilePathFromOpts opts = do-  d <- getCurrentDirectory-  maybe (return Nothing) (fmap Just . expandPath d) $ rules_file_ opts+-- | Get the sorted unique filenames of all hledger-* executables in+-- the current user's PATH. Currently these are: files in any of the+-- PATH directories, named hledger-*, with either no extension (and no+-- periods in the name) or one of the addonExtensions.  Limitations:+-- we do not currently check that the file is really a file (not eg a+-- directory) or whether it has execute permission.+hledgerExecutablesInPath :: IO [String]+hledgerExecutablesInPath = do+  pathdirs <- regexSplit "[:;]" `fmap` getEnvSafe "PATH"+  pathfiles <- concat `fmap` mapM getDirectoryContentsSafe pathdirs+  return $ nub $ sort $ filter isHledgerExeName pathfiles+  -- XXX should exclude directories and files without execute permission.+  -- These will do a stat for each hledger-*, probably ok.+  -- But they need paths, not just filenames+  -- hledgerexes  <- filterM doesFileExist hledgernamed+  -- hledgerexes' <- filterM isExecutable hledgerexes+  -- return hledgerexes --- | Get a mode's help message as a nicely wrapped string.-showModeHelp :: Mode a -> String-showModeHelp =-  (showText defaultWrap :: [Text] -> String)-  .-  (helpText [] HelpFormatDefault :: Mode a -> [Text])+-- isExecutable f = getPermissions f >>= (return . executable) --- not used:+isHledgerExeName :: String -> Bool+isHledgerExeName = isRight . parsewith hledgerexenamep+    where+      hledgerexenamep = do+        string progname+        char '-'+        many1 (noneOf ".")+        optional (string "." >> choice' (map string addonExtensions))+        eof --- | 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-    putStrLn $ "processed opts:\n" ++ show opts-    d <- getCurrentDay-    putStrLn $ "search query: " ++ (show $ queryFromOpts d $ reportopts_ opts)+stripAddonExtension :: String -> String+stripAddonExtension = regexReplace re "" where re = "\\.(" ++ intercalate "|" addonExtensions ++ ")$" +addonExtensions :: [String]+addonExtensions =+  ["bat"+  ,"com"+  ,"exe"+  ,"hs"+  ,"lhs"+  ,"pl"+  ,"py"+  ,"rb"+  ,"rkt"+  ,"sh"+  -- ,""+  ]++getEnvSafe :: String -> IO String+getEnvSafe v = getEnv v `C.catch` (\(_::C.IOException) -> return "")++getDirectoryContentsSafe :: FilePath -> IO [String]+getDirectoryContentsSafe d =+    (filter (not . (`elem` [".",".."])) `fmap` getDirectoryContents d) `C.catch` (\(_::C.IOException) -> return [])+ -- not used:+-- -- | 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+--     putStrLn $ "processed opts:\n" ++ show opts+--     d <- getCurrentDay+--     putStrLn $ "search query: " ++ (show $ queryFromOpts d $ reportopts_ opts) --- | Parse hledger CLI options from the command line using the given--- cmdargs mode, and either return them or, if a help flag is present,--- print the mode help and exit the program.-getCliOpts :: Mode RawOpts -> IO CliOpts-getCliOpts mode = do-  args <- getArgs-  let rawopts = decodeRawOpts $ processValue mode args-  opts <- rawOptsToCliOpts rawopts >>= checkCliOpts-  debugArgs args opts-  -- if any (`elem` args) ["--help","-h","-?"]-  when ("help" `inRawOpts` rawopts_ opts) $-    putStr (showModeHelp mode) >> exitSuccess-  return opts+-- tests +tests_Hledger_Cli_Options :: Test tests_Hledger_Cli_Options = TestList  [  ]

@@ -5,11 +5,14 @@ -}  module Hledger.Cli.Print (-  print'- ,showTransactions+  printmode+ ,print'  ,tests_Hledger_Cli_Print-) where+)+where+ import Data.List+import System.Console.CmdArgs.Explicit import Test.HUnit  import Hledger@@ -17,57 +20,67 @@ import Hledger.Utils.UTF8IOCompat (putStr) import Hledger.Cli.Options ++printmode = (defCommandMode $ ["print"] ++ aliases) {+  modeHelp = "show transaction entries" `withAliases` aliases+ ,modeGroupFlags = Group {+     groupUnnamed = []+    ,groupHidden = []+    ,groupNamed = [generalflagsgroup1]+    }+ }+  where aliases = []+ -- | Print journal transactions in standard format. print' :: CliOpts -> Journal -> IO () print' CliOpts{reportopts_=ropts} j = do   d <- getCurrentDay-  putStr $ showTransactions ropts (queryFromOpts d ropts) j--showTransactions :: ReportOpts -> Query -> Journal -> String-showTransactions opts q j = entriesReportAsText opts q $ entriesReport opts q j+  let q = queryFromOpts d ropts+  putStr $ entriesReportAsText ropts q $ entriesReport ropts q j -tests_showTransactions = [-  "showTransactions" ~: do+entriesReportAsText :: ReportOpts -> Query -> EntriesReport -> String+entriesReportAsText _ _ items = concatMap showTransactionUnelided items -   -- "print expenses" ~:-   do -    let opts = defreportopts{query_="expenses"}-    d <- getCurrentDay-    showTransactions opts (queryFromOpts d opts) samplejournal `is` unlines-     ["2008/06/03 * eat & shop"-     ,"    expenses:food                $1"-     ,"    expenses:supplies            $1"-     ,"    assets:cash                 $-2"-     ,""-     ]+-- XXX+-- tests_showTransactions = [+--   "showTransactions" ~: do -  -- , "print report with depth arg" ~:-   do -    let opts = defreportopts{depth_=Just 2}-    d <- getCurrentDay-    showTransactions opts (queryFromOpts d opts) samplejournal `is` unlines-      ["2008/01/01 income"-      ,"    assets:bank:checking            $1"-      ,"    income:salary                  $-1"-      ,""-      ,"2008/06/01 gift"-      ,"    assets:bank:checking            $1"-      ,"    income:gifts                   $-1"-      ,""-      ,"2008/06/03 * eat & shop"-      ,"    expenses:food                $1"-      ,"    expenses:supplies            $1"-      ,"    assets:cash                 $-2"-      ,""-      ,"2008/12/31 * pay off"-      ,"    liabilities:debts               $1"-      ,"    assets:bank:checking           $-1"-      ,""-      ]- ]+--    -- "print expenses" ~:+--    do +--     let opts = defreportopts{query_="expenses"}+--     d <- getCurrentDay+--     showTransactions opts (queryFromOpts d opts) samplejournal `is` unlines+--      ["2008/06/03 * eat & shop"+--      ,"    expenses:food                $1"+--      ,"    expenses:supplies            $1"+--      ,"    assets:cash                 $-2"+--      ,""+--      ] -entriesReportAsText :: ReportOpts -> Query -> EntriesReport -> String-entriesReportAsText _ _ items = concatMap showTransactionUnelided items+--   -- , "print report with depth arg" ~:+--    do +--     let opts = defreportopts{depth_=Just 2}+--     d <- getCurrentDay+--     showTransactions opts (queryFromOpts d opts) samplejournal `is` unlines+--       ["2008/01/01 income"+--       ,"    assets:bank:checking            $1"+--       ,"    income:salary                  $-1"+--       ,""+--       ,"2008/06/01 gift"+--       ,"    assets:bank:checking            $1"+--       ,"    income:gifts                   $-1"+--       ,""+--       ,"2008/06/03 * eat & shop"+--       ,"    expenses:food                $1"+--       ,"    expenses:supplies            $1"+--       ,"    assets:cash                 $-2"+--       ,""+--       ,"2008/12/31 * pay off"+--       ,"    liabilities:debts               $1"+--       ,"    assets:bank:checking           $-1"+--       ,""+--       ]+--  ] -tests_Hledger_Cli_Print = TestList-  tests_showTransactions+tests_Hledger_Cli_Print = TestList []+  -- tests_showTransactions

@@ -5,7 +5,8 @@ -}  module Hledger.Cli.Register (-  register+  registermode+ ,register  ,postingsReportAsText  -- ,showPostingWithBalanceForVty  ,tests_Hledger_Cli_Register@@ -13,6 +14,7 @@  import Data.List import Data.Maybe+import System.Console.CmdArgs.Explicit import Test.HUnit import Text.Printf @@ -21,6 +23,21 @@ import Hledger.Utils.UTF8IOCompat (putStr) import Hledger.Cli.Options ++registermode = (defCommandMode $ ["register"] ++ aliases) {+  modeHelp = "show postings and running total" `withAliases` aliases+ ,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 ["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)"+     ]+    ,groupHidden = []+    ,groupNamed = [generalflagsgroup1]+    }+ }+  where aliases = ["reg"]  -- | Print a (posting) register report. register :: CliOpts -> Journal -> IO ()

@@ -4,12 +4,17 @@  -} -module Hledger.Cli.Stats+module Hledger.Cli.Stats (+  statsmode+ ,stats+) where+ import Data.List import Data.Maybe import Data.Ord import Data.Time.Calendar+import System.Console.CmdArgs.Explicit import Text.Printf import qualified Data.Map as Map @@ -19,6 +24,16 @@ import Hledger.Utils.UTF8IOCompat (putStr)  +statsmode = (defCommandMode $ ["stats"] ++ aliases) {+  modeHelp = "show some journal statistics" `withAliases` aliases+ ,modeGroupFlags = Group {+     groupUnnamed = []+    ,groupHidden = []+    ,groupNamed = [generalflagsgroup1]+    }+ }+  where aliases = []+ -- like Register.summarisePostings -- | Print various statistics for the journal. stats :: CliOpts -> Journal -> IO ()@@ -26,7 +41,7 @@   d <- getCurrentDay   let q = queryFromOpts d reportopts_       l = ledgerFromJournal q j-      reportspan = (ledgerDateSpan l) `orDatesFrom` (queryDateSpan False q)+      reportspan = (ledgerDateSpan l) `spanDefaultsFrom` (queryDateSpan False q)       intervalspans = splitSpan (intervalFromOpts reportopts_) reportspan       showstats = showLedgerStats l d       s = intercalate "\n" $ map showstats intervalspans

@@ -6,8 +6,12 @@  -} -module Hledger.Cli.Tests+module Hledger.Cli.Tests (+  testmode+ ,test'+) where+ import Control.Monad import System.Exit import Test.HUnit@@ -34,22 +38,32 @@    then exitFailure    else exitWith ExitSuccess +testmode = (defCommandMode ["test"]) {+  modeHelp = "run built-in self-tests"+ ,modeArgs = ([], Just $ argsFlag "[REGEXPS]")+ ,modeGroupFlags = Group {+     groupUnnamed = []+    ,groupHidden = []+    ,groupNamed = [generalflagsgroup3]+    }+ }+ -- | Run all or just the matched unit tests and return their HUnit result counts. runTests :: CliOpts -> IO Counts runTests = liftM (fst . flip (,) 0) . runTestTT . flatTests --- | Run all or just the matched unit tests until the first failure or--- error, returning the name of the problem test if any.-runTestsTillFailure :: CliOpts -> IO (Maybe String)-runTestsTillFailure _ = undefined -- do-  -- let ts = flatTests opts-  --     results = liftM (fst . flip (,) 0) $ runTestTT $-  --     firstproblem = find (\counts -> )+-- -- | Run all or just the matched unit tests until the first failure or+-- -- error, returning the name of the problem test if any.+-- runTestsTillFailure :: CliOpts -> IO (Maybe String)+-- runTestsTillFailure _ = undefined -- do+--   -- let ts = flatTests opts+--   --     results = liftM (fst . flip (,) 0) $ runTestTT $+--   --     firstproblem = find (\counts -> )  -- | All or pattern-matched tests, as a flat list to show simple names. flatTests opts = TestList $ filter (matchesAccount (queryFromOpts nulldate $ reportopts_ opts) . testName) $ flattenTests tests_Hledger_Cli --- | All or pattern-matched tests, in the original suites to show hierarchical names.-hierarchicalTests opts = filterTests (matchesAccount (queryFromOpts nulldate $ reportopts_ opts) . testName) tests_Hledger_Cli+-- -- | All or pattern-matched tests, in the original suites to show hierarchical names.+-- hierarchicalTests opts = filterTests (matchesAccount (queryFromOpts nulldate $ reportopts_ opts) . testName) tests_Hledger_Cli  #endif

@@ -1,8 +1,7 @@ name:           hledger--- also in cpp-options below-version: 0.22.2-stability:      beta-category:       Finance+version:        0.23+stability:      stable+category:       Finance, Console synopsis:       The main command-line interface for the hledger accounting tool. description:                 hledger is a library and set of user tools for working@@ -18,7 +17,7 @@ maintainer:     Simon Michael <simon@joyful.com> homepage:       http://hledger.org bug-reports:    http://hledger.org/bugs-tested-with:    GHC==7.2.2, GHC==7.4.2, GHC==7.6.3, GHC==7.8+tested-with:    GHC==7.2.2, GHC==7.4.2, GHC==7.6.3, GHC==7.8.2 cabal-version:  >= 1.10 build-type:     Simple -- data-dir:       data@@ -43,7 +42,7 @@     Default:       True  library-  cpp-options:    -DVERSION="0.22.2"+  cpp-options:    -DVERSION="0.23"   ghc-options:    -W   default-language: Haskell2010   -- should be the same as below@@ -55,6 +54,7 @@                   Hledger.Cli.Utils                   Hledger.Cli.Version                   Hledger.Cli.Add+                  Hledger.Cli.Accounts                   Hledger.Cli.Balance                   Hledger.Cli.Balancesheet                   Hledger.Cli.Cashflow@@ -65,7 +65,7 @@                   Hledger.Cli.Stats   -- should be the same as below   build-depends:-                  hledger-lib == 0.22.2+                  hledger-lib == 0.23                  ,base >= 4.3 && < 5                  -- ,cabal-file-th                  ,containers@@ -82,12 +82,22 @@                  ,process                  ,regexpr >= 0.5.1                  ,safe >= 0.2-                 ,shakespeare-text == 1.0.*+-- http://www.yesodweb.com/blog/2014/04/consolidation-progress+-- in order to support both the old and new versions of shakespeare,+-- you just need to ensure that you have both the shakespeare and+-- deprecated packages listed in your cabal file. In other words, if+-- previously you depended on hamlet, now you should depend on hamlet+-- and shakespeare. When you're ready to drop backwards compatibility,+-- simply put a lower bound of >= 2.0 on shakespeare and remove the+-- deprecated packages.+                 ,shakespeare-text >= 1.0 && < 1.2+                 ,shakespeare      >= 1.0 && < 2.1                  ,split >= 0.1 && < 0.3                  ,text >= 0.11 && < 1.2                  ,tabular >= 0.2 && < 0.3                  ,time                  ,utf8-string >= 0.3.5 && < 0.4+                 ,wizards == 1.0.*   if impl(ghc >= 7.4)     build-depends: pretty-show >= 1.6.4 @@ -109,6 +119,7 @@                   Hledger.Cli.Utils                   Hledger.Cli.Version                   Hledger.Cli.Add+                  Hledger.Cli.Accounts                   Hledger.Cli.Balance                   Hledger.Cli.Balancesheet                   Hledger.Cli.Cashflow@@ -117,14 +128,14 @@                   Hledger.Cli.Print                   Hledger.Cli.Register                   Hledger.Cli.Stats-  cpp-options:    -DVERSION="0.22.2"+  cpp-options:    -DVERSION="0.23"   ghc-options:    -W   if flag(threaded)        ghc-options:   -threaded  -- should be the same as above   default-language: Haskell2010   build-depends:-                  hledger-lib == 0.22.2+                  hledger-lib == 0.23                  ,base >= 4.3 && < 5                  ,containers                  ,cmdargs >= 0.10 && < 0.11@@ -140,12 +151,14 @@                  ,process                  ,regexpr >= 0.5.1                  ,safe >= 0.2-                 ,shakespeare-text == 1.0.*+                 ,shakespeare-text >= 1.0 && < 1.2+                 ,shakespeare      >= 1.0 && < 2.1                  ,split >= 0.1 && < 0.3                  ,tabular >= 0.2 && < 0.3                  ,text >= 0.11 && < 1.2                  ,time                  ,utf8-string >= 0.3.5 && < 0.4+                 ,wizards == 1.0.*   if impl(ghc >= 7.4)     build-depends: pretty-show >= 1.6.4 @@ -172,7 +185,8 @@                , process                , regexpr                , safe-               , shakespeare-text+               , shakespeare-text >= 1.0 && < 1.2+               , shakespeare      >= 1.0 && < 2.1                , split                ,tabular >= 0.2 && < 0.3                , test-framework@@ -180,5 +194,6 @@                , text                , time                , transformers+               , wizards == 1.0.*   if impl(ghc >= 7.4)     build-depends: pretty-show >= 1.6.4