hledger 0.15.2 → 0.16

raw patch · 9 files changed

+142/−121 lines, 9 filesdep ~hledger-libPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hledger-lib

API changes (from Hackage documentation)

Files

• Hledger/Cli.hs +0/−14
• Hledger/Cli/Add.hs +39/−27
• Hledger/Cli/Balance.hs +8/−9
• Hledger/Cli/Convert.hs +65/−49
• Hledger/Cli/Main.hs +12/−8
• Hledger/Cli/Options.hs +13/−9
• Hledger/Cli/Print.hs +1/−1
• Hledger/Cli/Version.hs +1/−1
• hledger.cabal +3/−3

@@ -249,20 +249,6 @@         ,"                   0"         ] -   ,"balance report elides zero-balance root account(s)" ~: do-      j <- readJournal'-             (unlines-              ["2008/1/1 one"-              ,"  test:a  1"-              ,"  test:b"-              ])-      accountsReportAsText defreportopts (accountsReport defreportopts nullfilterspec j) `is`-        ["                   1  test:a"-        ,"                  -1  test:b"-        ,"--------------------"-        ,"                   0"-        ]-    ]    ,"journalCanonicaliseAmounts" ~:

@@ -51,10 +51,10 @@ add opts j     | f == "-" = return ()     | otherwise = do+  hPrintf stderr "Adding transactions to journal file \"%s\".\n" f   hPutStrLn stderr $-    "Enter one or more transactions, which will be added to your journal file.\n"-    ++"To complete a transaction, enter . when prompted for an account.\n"-    ++"To quit, press control-d or control-c."+    "To complete a transaction, enter . (period) at an account prompt.\n"+    ++"To stop adding transactions, enter . at a date prompt, or control-d/control-c."   today <- getCurrentDay   getAndAddTransactions j opts today         `catch` (\e -> unless (isEOFError e) $ ioError e)@@ -75,10 +75,12 @@                     -> IO (Transaction,Day) getTransaction j opts defaultDate = do   today <- getCurrentDay-  datestr <- runInteractionDefault $ askFor "date" +  datestr <- runInteractionDefault $ askFor "date, or . to end"             (Just $ showDate defaultDate)-            (Just $ \s -> null s || -             isRight (parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s))+            (Just $ \s -> null s+                         || s == "."+                         || isRight (parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s))+  when (datestr == ".") $ ioError $ mkIOError eofErrorType "" Nothing Nothing   description <- runInteractionDefault $ askFor "description" (Just "") Nothing   let historymatches = transactionsSimilarTo j (patterns_ $ reportopts_ opts) description       bestmatch | null historymatches = Nothing@@ -117,9 +119,15 @@                 | otherwise = Nothing                 where Just ps = historicalps       defaultaccount = maybe Nothing (Just . showacctname) bestmatch-  account <- runInteraction j $ askFor (printf "account %d" n) defaultaccount (Just accept)+      ordot | null enteredps || length enteredrealps == 1 = ""+            | otherwise = ", or . to record"+  account <- runInteraction j $ askFor (printf "account %d%s" n ordot) defaultaccount (Just accept)   if account=="."-    then return enteredps+    then+     if null enteredps+      then do hPutStrLn stderr $ "\nPlease enter some postings first."+              getPostings st enteredps+      else return enteredps     else do       let defaultacctused = Just account == defaultaccount           historicalps' = if defaultacctused then historicalps else Nothing@@ -131,10 +139,16 @@                            | n > 1             = Just balancingamountstr                            | otherwise         = Nothing               where-                -- force a decimal point in the output in case there's a-                -- digit group separator that would be mistaken for one-                historicalamountstr = showMixedAmountWithPrecision maxprecisionwithpoint $ pamount $ fromJust bestmatch'-                balancingamountstr  = showMixedAmountWithPrecision maxprecisionwithpoint $ negate $ sum $ map pamount enteredrealps+                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       amountstr <- runInteractionDefault $ askFor (printf "amount  %d" n) defaultamountstr validateamount       let amount  = fromparse $ runParser (someamount <|> return missingamt) ctx     "" amountstr           amount' = fromparse $ runParser (someamount <|> return missingamt) nullctx "" amountstr@@ -191,26 +205,24 @@ journalAddTransaction :: Journal -> CliOpts -> Transaction -> IO Journal journalAddTransaction j@Journal{jtxns=ts} opts t = do   let f = journalFilePath j-  appendToJournalFile f $ showTransaction t+  appendToJournalFileOrStdout f $ showTransaction t   when (debug_ opts) $ do     putStrLn $ printf "\nAdded transaction to %s:" f     putStrLn =<< registerFromString (show t)   return j{jtxns=ts++[t]} --- | Append data to a journal file; or if the file is "-", dump it to stdout.-appendToJournalFile :: FilePath -> String -> IO ()-appendToJournalFile f s =-    if f == "-"-    then putStr $ sep ++ s-    else appendFile f $ sep++s-    where -      -- appendFile means we don't need file locking to be-      -- multi-user-safe, but also that we can't figure out the minimal-      -- number of newlines needed as separator-      sep = "\n\n"-      -- sep | null $ strip t = ""-      --     | otherwise = replicate (2 - min 2 (length lastnls)) '\n'-      --     where lastnls = takeWhile (=='\n') $ reverse t+-- | Append a string, typically one or more transactions, to a journal+-- file, or if the file is "-", dump it to stdout.  Tries to avoid+-- excess whitespace.+appendToJournalFileOrStdout :: FilePath -> String -> IO ()+appendToJournalFileOrStdout f s+  | f == "-"  = putStr s'+  | otherwise = appendFile f s'+  where s' = "\n" ++ ensureOneNewlineTerminated s++-- | Replace a string's 0 or more terminating newlines with exactly one.+ensureOneNewlineTerminated :: String -> String+ensureOneNewlineTerminated = (++"\n") . reverse . dropWhile (=='\n') . reverse  -- | Convert a string of journal data into a register report. registerFromString :: String -> IO String

@@ -82,15 +82,14 @@ that is non-zero. Here, it is displayed because the accounts shown add up to $-1. -Here is a more precise definition of \"interesting\" accounts in ledger's-balance report:--- an account which has just one interesting subaccount branch, and which-  is not at the report's maximum depth, is interesting if the balance is-  different from the subaccount's, and otherwise boring.--- any other account is interesting if it has a non-zero balance, or the -E-  flag is used.+Also, non-interesting accounts may be elided.  Here's an imperfect+description of the ledger balance command's eliding behaviour:+\"Interesting\" accounts are displayed on their own line. An account less+deep than the report's max depth, with just one interesting subaccount,+and the same balance as the subaccount, is non-interesting, and prefixed+to the subaccount's line, unless (hledger's) --no-elide is in effect.+An account with a zero inclusive balance and less than two interesting+subaccounts is not displayed at all, unless --empty is in effect.  -} 

@@ -5,7 +5,9 @@  module Hledger.Cli.Convert where import Control.Monad (when, guard, liftM)+import Data.List import Data.Maybe+import Data.Ord import Data.Time.Format (parseTime) import Safe import System.Directory (doesFileExist)@@ -14,7 +16,7 @@ import System.IO (stderr) import System.Locale (defaultTimeLocale) import Test.HUnit-import Text.CSV (parseCSV, parseCSVFromFile, printCSV, CSV)+import Text.CSV (parseCSV, parseCSVFromFile, CSV) import Text.ParserCombinators.Parsec import Text.Printf (hPrintf) @@ -37,8 +39,8 @@       codeField :: Maybe FieldPosition,       descriptionField :: [FormatString],       amountField :: Maybe FieldPosition,-      inField :: Maybe FieldPosition,-      outField :: Maybe FieldPosition,+      amountInField :: Maybe FieldPosition,+      amountOutField :: Maybe FieldPosition,       currencyField :: Maybe FieldPosition,       baseCurrency :: Maybe String,       accountField :: Maybe FieldPosition,@@ -55,8 +57,8 @@       codeField=Nothing,       descriptionField=[],       amountField=Nothing,-      inField=Nothing,-      outField=Nothing,+      amountInField=Nothing,+      amountOutField=Nothing,       currencyField=Nothing,       baseCurrency=Nothing,       accountField=Nothing,@@ -86,11 +88,11 @@       usingStdin = csvfile == "-"       rulesFileSpecified = isJust $ rules_file_ opts       rulesfile = rulesFileFor opts csvfile-  when (usingStdin && (not rulesFileSpecified)) $ error' "please use --rules to specify a rules file when converting stdin"+  when (usingStdin && (not rulesFileSpecified)) $ error' "please use --rules-file to specify a rules file when converting stdin"   csvparse <- parseCsv csvfile   let records = case csvparse of                   Left e -> error' $ show e-                  Right rs -> reverse $ filter (/= [""]) rs+                  Right rs -> filter (/= [""]) rs   exists <- doesFileExist rulesfile   if (not exists) then do                   hPrintf stderr "creating conversion rules file %s, edit this file for better results\n" rulesfile@@ -104,7 +106,8 @@   let requiredfields = max 2 (maxFieldIndex rules + 1)       badrecords = take 1 $ filter ((< requiredfields).length) records   if null badrecords-   then mapM_ (printTxn (debug_ opts) rules) records+   then do+     mapM_ (putStr . show) $ sortBy (comparing tdate) $ map (transactionFromCsvRecord rules) records    else do      hPrintf stderr (unlines [                       "Warning, at least one CSV record does not contain a field referenced by the"@@ -127,8 +130,8 @@                   ,statusField r                   ,codeField r                   ,amountField r-                  ,inField r-                  ,outField r+                  ,amountInField r+                  ,amountOutField r                   ,currencyField r                   ,accountField r                   ,account2Field r@@ -149,7 +152,7 @@     "date-field 0\n" ++     "description-field 4\n" ++     "amount-field 1\n" ++-    "currency $\n" +++    "base-currency $\n" ++     "\n" ++     "# account-assigning rules\n" ++     "\n" ++@@ -166,14 +169,14 @@ validateRules :: CsvRules -> Maybe String validateRules rules = let     hasAmount = isJust $ amountField rules-    hasIn = isJust $ inField rules-    hasOut = isJust $ outField rules+    hasIn = isJust $ amountInField rules+    hasOut = isJust $ amountOutField rules   in case (hasAmount, hasIn, hasOut) of-    (True, True, _) -> Just "Don't specify in-field when specifying amount-field"-    (True, _, True) -> Just "Don't specify out-field when specifying amount-field"-    (_, False, True) -> Just "Please specify in-field when specifying out-field"-    (_, True, False) -> Just "Please specify out-field when specifying in-field"-    (False, False, False) -> Just "Please specify either amount-field, or in-field and out-field"+    (True, True, _) -> Just "Don't specify amount-in-field when specifying amount-field"+    (True, _, True) -> Just "Don't specify amount-out-field when specifying amount-field"+    (_, False, True) -> Just "Please specify amount-in-field when specifying amount-out-field"+    (_, True, False) -> Just "Please specify amount-out-field when specifying amount-in-field"+    (False, False, False) -> Just "Please specify either amount-field, or amount-in-field and amount-out-field"     _ -> Nothing  -- rules file parser@@ -205,8 +208,8 @@    ,codefield    ,descriptionfield    ,amountfield-   ,infield-   ,outfield+   ,amountinfield+   ,amountoutfield    ,currencyfield    ,accountfield    ,account2field@@ -269,17 +272,17 @@   x <- updateState (\r -> r{amountField=readMay v})   return x -infield = do-  string "in-field"+amountinfield = do+  choice [string "amount-in-field", string "in-field"]   many1 spacenonewline   v <- restofline-  updateState (\r -> r{inField=readMay v})+  updateState (\r -> r{amountInField=readMay v}) -outfield = do-  string "out-field"+amountoutfield = do+  choice [string "amount-out-field", string "out-field"]   many1 spacenonewline   v <- restofline-  updateState (\r -> r{outField=readMay v})+  updateState (\r -> r{amountOutField=readMay v})  currencyfield = do   string "currency-field"@@ -300,7 +303,7 @@   updateState (\r -> r{account2Field=readMay v})  basecurrency = do-  string "currency"+  choice [string "base-currency", string "currency"]   many1 spacenonewline   v <- restofline   updateState (\r -> r{baseCurrency=Just v})@@ -340,11 +343,6 @@   newline   return (matchpat,replpat) -printTxn :: Bool -> CsvRules -> CsvRecord -> IO ()-printTxn debug rules rec = do-  when debug $ hPrintf stderr "record: %s" (printCSV [rec])-  putStr $ show $ transactionFromCsvRecord rules rec- -- csv record conversion formatD :: CsvRecord -> Bool -> Maybe Int -> Maybe Int -> Field -> String formatD record leftJustified min max f = case f of @@ -426,19 +424,37 @@ -- | Convert some date string with unknown format to YYYY/MM/DD. normaliseDate :: Maybe String -- ^ User-supplied date format: this should be tried in preference to all others               -> String -> String-normaliseDate mb_user_format s = maybe "0000/00/00" showDate $-              firstJust $-              (maybe id (\user_format -> (parseTime defaultTimeLocale user_format s :)) mb_user_format) $-              [parseTime defaultTimeLocale "%Y/%m/%e" s-               -- can't parse a month without leading 0, try adding one-              ,parseTime defaultTimeLocale "%Y/%m/%e" (take 5 s ++ "0" ++ drop 5 s)-              ,parseTime defaultTimeLocale "%Y-%m-%e" s-              ,parseTime defaultTimeLocale "%Y-%m-%e" (take 5 s ++ "0" ++ drop 5 s)-              ,parseTime defaultTimeLocale "%m/%e/%Y" s-              ,parseTime defaultTimeLocale "%m/%e/%Y" ('0':s)-              ,parseTime defaultTimeLocale "%m-%e-%Y" s-              ,parseTime defaultTimeLocale "%m-%e-%Y" ('0':s)-              ]+normaliseDate mb_user_format s =+    let parsewith = flip (parseTime defaultTimeLocale) s in+    maybe (error' $ "could not parse \""++s++"\" as a date, consider adding a date-format directive or upgrading")+          showDate $+          firstJust $ (map parsewith $+                       maybe [] (:[]) mb_user_format+                       -- the - modifier requires time-1.2.0.5, released+                       -- in 2011/5, so for now we emulate it for wider+                       -- compatibility.  time < 1.2.0.5 also has a buggy+                       -- %y which we don't do anything about.+                       -- ++ [+                       -- "%Y/%m/%d"+                       -- ,"%Y/%-m/%-d"+                       -- ,"%Y-%m-%d"+                       -- ,"%Y-%-m-%-d"+                       -- ,"%m/%d/%Y"+                       -- ,"%-m/%-d/%Y"+                       -- ,"%m-%d-%Y"+                       -- ,"%-m-%-d-%Y"+                       -- ]+                      )+                      ++ [+                       parseTime defaultTimeLocale "%Y/%m/%e" s+                      ,parseTime defaultTimeLocale "%Y-%m-%e" s+                      ,parseTime defaultTimeLocale "%m/%e/%Y" s+                      ,parseTime defaultTimeLocale "%m-%e-%Y" s+                      ,parseTime defaultTimeLocale "%Y/%m/%e" (take 5 s ++ "0" ++ drop 5 s)+                      ,parseTime defaultTimeLocale "%Y-%m-%e" (take 5 s ++ "0" ++ drop 5 s)+                      ,parseTime defaultTimeLocale "%m/%e/%Y" ('0':s)+                      ,parseTime defaultTimeLocale "%m-%e-%Y" ('0':s)+                      ]  -- | Apply account matching rules to a transaction description to obtain -- the most appropriate account and a new description.@@ -460,13 +476,13 @@ getAmount rules fields = case amountField rules of   Just f  -> maybe "" (atDef "" fields) $ Just f   Nothing ->-    case (c, d) of+    case (i, o) of       (x, "") -> x       ("", x) -> "-"++x-      _ -> ""+      p -> error' $ "using amount-in-field and amount-out-field, found a value in both fields: "++show p     where-      c = maybe "" (atDef "" fields) (inField rules)-      d = maybe "" (atDef "" fields) (outField rules)+      i = maybe "" (atDef "" fields) (amountInField rules)+      o = maybe "" (atDef "" fields) (amountOutField rules)  tests_Hledger_Cli_Convert = TestList (test_parser ++ test_description_parsing) 

@@ -31,7 +31,6 @@ >                  $-2  income >                   $1  liabilities > > l <- myLedger-> > t <- myTimelog  See "Hledger.Data.Ledger" for more examples. @@ -47,6 +46,7 @@ import System.Process import Text.Printf +import Hledger (ensureJournalFile) import Hledger.Cli.Add import Hledger.Cli.Balance import Hledger.Cli.Convert@@ -69,10 +69,11 @@   run' opts addons args     where       run' opts@CliOpts{command_=cmd} addons args-       | "version" `in_` (rawopts_ opts)                 = putStrLn progversion-       | "binary-filename" `in_` (rawopts_ opts)         = putStrLn $ binaryfilename progname+       -- delicate, add tests before changing (eg --version, ADDONCMD --version, INTERNALCMD --version)+       | (null matchedaddon) && "version" `in_` (rawopts_ opts)         = putStrLn progversion+       | (null matchedaddon) && "binary-filename" `in_` (rawopts_ opts) = putStrLn $ binaryfilename progname        | null cmd                                        = putStr $ showModeHelp mainmode'-       | cmd `isPrefixOf` "add"                          = showModeHelpOr addmode      $ withJournalDo opts add+       | cmd `isPrefixOf` "add"                          = showModeHelpOr addmode      $ journalFilePathFromOpts opts >>= ensureJournalFile >> withJournalDo opts add        | cmd `isPrefixOf` "convert"                      = showModeHelpOr convertmode  $ convert opts        | cmd `isPrefixOf` "test"                         = showModeHelpOr testmode     $ runtests opts        | any (cmd `isPrefixOf`) ["accounts","balance"]   = showModeHelpOr accountsmode $ withJournalDo opts balance@@ -80,15 +81,18 @@        | any (cmd `isPrefixOf`) ["postings","register"]  = showModeHelpOr postingsmode $ withJournalDo opts register        | any (cmd `isPrefixOf`) ["activity","histogram"] = showModeHelpOr activitymode $ withJournalDo opts histogram        | cmd `isPrefixOf` "stats"                        = showModeHelpOr statsmode    $ withJournalDo opts stats-       | not (null matchedaddon)                           = system shellcmd >>= exitWith+       | not (null matchedaddon)                           = do+                                                             when (debug_ opts) $ printf "running %s\n" shellcmd+                                                             system shellcmd >>= exitWith        | otherwise                                       = optserror ("command "++cmd++" is not recognized") >> exitFailure        where         mainmode' = mainmode addons         showModeHelpOr mode f | "help" `in_` (rawopts_ opts) = putStr $ showModeHelp mode                               | otherwise = f-        matchedaddon = headDef "" $ filter (cmd `isPrefixOf`) addons-        shellcmd = printf "%s-%s %s" progname matchedaddon (unwords' argswithoutcmd)-        argswithoutcmd = args1 ++ drop 1 args2 where (args1,args2) = break (== cmd) args+        matchedaddon | null cmd  = ""+                     | otherwise = headDef "" $ filter (cmd `isPrefixOf`) addons+        shellcmd = printf "%s-%s %s" progname matchedaddon (unwords' subcmdargs)+        subcmdargs = args1 ++ drop 1 args2 where (args1,args2) = break (== cmd) $ filter (/="--") args  {- tests: 

@@ -318,7 +318,7 @@ getHledgerCliOpts :: [String] -> IO CliOpts getHledgerCliOpts addons = do   args <- getArgs-  toCliOpts (decodeRawOpts $ processValue (mainmode addons) $ moveFileOption args) >>= checkCliOpts+  toCliOpts (decodeRawOpts $ processValue (mainmode addons) $ rearrangeForCmdArgs args) >>= checkCliOpts  -- utils @@ -344,12 +344,12 @@ -- | Convert possibly encoded option values to regular unicode strings. decodeRawOpts = map (\(name,val) -> (name, fromPlatformString val)) --- A workaround related to http://code.google.com/p/ndmitchell/issues/detail?id=457 :--- we'd like to permit options before COMMAND as well as after it. Here we--- make sure at least -f FILE will be accepted in either position.-moveFileOption (fopt@('-':'f':_:_):cmd:rest) = cmd:fopt:rest-moveFileOption ("-f":fval:cmd:rest) = cmd:"-f":fval:rest-moveFileOption as = as+-- A hacky workaround for http://code.google.com/p/ndmitchell/issues/detail?id=470 :+-- we'd like to permit options before COMMAND as well as after it.+-- Here we make sure at least -f FILE will be accepted in either position.+rearrangeForCmdArgs (fopt@('-':'f':_:_):cmd:rest) = cmd:fopt:rest+rearrangeForCmdArgs ("-f":fval:cmd:rest) = cmd:"-f":fval:rest+rearrangeForCmdArgs as = as  optserror = error' . (++ " (run with --help for usage)") @@ -423,11 +423,15 @@     , FormatField True Nothing Nothing Format.Account     ] --- | Get the journal file path from options, an environment variable, or a default+-- | Get the journal file path from options, an environment variable, or a default.+-- If the path contains a literal tilde raise an error to avoid confusion. journalFilePathFromOpts :: CliOpts -> IO String journalFilePathFromOpts opts = do   f <- myJournalPath-  return $ fromMaybe f $ file_ opts+  return $ errorIfContainsTilde $ fromMaybe f $ file_ opts++errorIfContainsTilde s |'~' `elem` s = error' "unsupported literal ~ found in environment variable, please adjust"+                       | otherwise   = s  aliasesFromOpts :: CliOpts -> [(AccountName,AccountName)] aliasesFromOpts = map parseAlias . alias_

@@ -25,5 +25,5 @@ showTransactions opts fspec j = entriesReportAsText opts fspec $ entriesReport opts fspec j  entriesReportAsText :: ReportOpts -> FilterSpec -> EntriesReport -> String-entriesReportAsText opts _ items = concatMap (showTransactionForPrint (effective_ opts)) items+entriesReportAsText _ _ items = concatMap showTransactionUnelided items 

@@ -20,7 +20,7 @@ -- version and PATCHLEVEL are set by the make process  version :: String-version       = "0.15.2"+version       = "0.16.0"  patchlevel :: String #ifdef PATCHLEVEL

@@ -1,5 +1,5 @@ name:           hledger-version: 0.15.2+version: 0.16 category:       Finance synopsis:       The main command-line interface for the hledger accounting tool. description:@@ -57,7 +57,7 @@                   Hledger.Cli.Stats   -- should be the same as below   build-depends:-                  hledger-lib == 0.15.2+                  hledger-lib == 0.16                  ,base >= 3 && < 5                  ,containers                  ,cmdargs >= 0.8   && < 0.9@@ -107,7 +107,7 @@   ghc-options:    -threaded -W   -- should be the same as above   build-depends:-                  hledger-lib == 0.15.2+                  hledger-lib == 0.16                  ,base >= 3 && < 5                  ,containers                  ,cmdargs >= 0.8   && < 0.9