diff --git a/Hledger/Cli.hs b/Hledger/Cli.hs --- a/Hledger/Cli.hs +++ b/Hledger/Cli.hs @@ -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" ~: diff --git a/Hledger/Cli/Add.hs b/Hledger/Cli/Add.hs --- a/Hledger/Cli/Add.hs +++ b/Hledger/Cli/Add.hs @@ -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 diff --git a/Hledger/Cli/Balance.hs b/Hledger/Cli/Balance.hs --- a/Hledger/Cli/Balance.hs +++ b/Hledger/Cli/Balance.hs @@ -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. -} diff --git a/Hledger/Cli/Convert.hs b/Hledger/Cli/Convert.hs --- a/Hledger/Cli/Convert.hs +++ b/Hledger/Cli/Convert.hs @@ -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) diff --git a/Hledger/Cli/Main.hs b/Hledger/Cli/Main.hs --- a/Hledger/Cli/Main.hs +++ b/Hledger/Cli/Main.hs @@ -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: diff --git a/Hledger/Cli/Options.hs b/Hledger/Cli/Options.hs --- a/Hledger/Cli/Options.hs +++ b/Hledger/Cli/Options.hs @@ -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_ diff --git a/Hledger/Cli/Print.hs b/Hledger/Cli/Print.hs --- a/Hledger/Cli/Print.hs +++ b/Hledger/Cli/Print.hs @@ -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 diff --git a/Hledger/Cli/Version.hs b/Hledger/Cli/Version.hs --- a/Hledger/Cli/Version.hs +++ b/Hledger/Cli/Version.hs @@ -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 diff --git a/hledger.cabal b/hledger.cabal --- a/hledger.cabal +++ b/hledger.cabal @@ -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