diff --git a/Hledger/Data/Types.hs b/Hledger/Data/Types.hs --- a/Hledger/Data/Types.hs +++ b/Hledger/Data/Types.hs @@ -167,9 +167,9 @@ final_comment_lines :: String, -- ^ any trailing comments from the journal file jContext :: JournalContext, -- ^ the context (parse state) at the end of parsing files :: [(FilePath, String)], -- ^ the file path and raw text of the main and - -- any included journal files. The main file is - -- first followed by any included files in the - -- order encountered. + -- any included journal files. The main file is + -- first followed by any included files in the + -- order encountered (XXX reversed, cf journalAddFile). filereadtime :: ClockTime -- ^ when this journal was last read from its file(s) } deriving (Eq, Typeable) diff --git a/Hledger/Query.hs b/Hledger/Query.hs --- a/Hledger/Query.hs +++ b/Hledger/Query.hs @@ -293,16 +293,20 @@ -- | Remove query terms (or whole sub-expressions) not matching the given -- predicate from this query. XXX Semantics not yet clear. filterQuery :: (Query -> Bool) -> Query -> Query -filterQuery p (And qs) = And $ filter p qs -filterQuery p (Or qs) = Or $ filter p qs --- filterQuery p (Not q) = Not $ filterQuery p q -filterQuery p q = if p q then q else Any +filterQuery p = simplifyQuery . filterQuery' p +filterQuery' :: (Query -> Bool) -> Query -> Query +filterQuery' p (And qs) = And $ map (filterQuery p) qs +filterQuery' p (Or qs) = Or $ map (filterQuery p) qs +-- filterQuery' p (Not q) = Not $ filterQuery p q +filterQuery' p q = if p q then q else Any + tests_filterQuery = [ "filterQuery" ~: do let (q,p) `gives` r = assertEqual "" r (filterQuery p q) (Any, queryIsDepth) `gives` Any (Depth 1, queryIsDepth) `gives` Depth 1 + (And [And [Status True,Depth 1]], not . queryIsDepth) `gives` Status True -- (And [Date nulldatespan, Not (Or [Any, Depth 1])], queryIsDepth) `gives` And [Not (Or [Depth 1])] ] diff --git a/Hledger/Read.hs b/Hledger/Read.hs --- a/Hledger/Read.hs +++ b/Hledger/Read.hs @@ -167,7 +167,7 @@ exists <- doesFileExist f when (not exists) $ do hPrintf stderr "The hledger journal file \"%s\" was not found.\n" f - hPrintf stderr "Please create it first, eg with hledger add, hledger web, or a text editor.\n" + hPrintf stderr "Please create it first, eg with hledger add or a text editor.\n" hPrintf stderr "Or, specify an existing journal file with -f or LEDGER_FILE.\n" exitFailure diff --git a/Hledger/Read/CsvReader.hs b/Hledger/Read/CsvReader.hs --- a/Hledger/Read/CsvReader.hs +++ b/Hledger/Read/CsvReader.hs @@ -26,6 +26,12 @@ module Hledger.Read.CsvReader ( -- * Reader reader, + -- * Misc. + CsvRecord, + nullrules, + rulesFileFor, + parseCsvRulesFile, + transactionFromCsvRecord, -- * Tests tests_Hledger_Read_CsvReader ) @@ -123,7 +129,7 @@ (_:_) -> throw $ userError $ "Parse error: at least one CSV record has less than two fields:\n"++(show $ head badrecords) let rulesfile = fromMaybe (rulesFileFor csvfile) mrulesfile - created <- records `seq` (trace "ensureRulesFile" $ ensureRulesFileExists rulesfile) + created <- records `seq` ensureRulesFileExists rulesfile if created then hPrintf stderr "creating default conversion rules file %s, edit this file for better results\n" rulesfile else hPrintf stderr "using conversion rules file %s\n" rulesfile diff --git a/Hledger/Read/JournalReader.hs b/Hledger/Read/JournalReader.hs --- a/Hledger/Read/JournalReader.hs +++ b/Hledger/Read/JournalReader.hs @@ -79,7 +79,7 @@ -- | Flatten a list of JournalUpdate's into a single equivalent one. combineJournalUpdates :: [JournalUpdate] -> JournalUpdate -combineJournalUpdates us = liftM (foldr (.) id) $ sequence us +combineJournalUpdates us = liftM (foldl' (.) id) $ sequence us -- | Given a JournalUpdate-generating parsec parser, file path and data string, -- parse and post-process a Journal so that it's ready to use, or give an error. @@ -179,7 +179,8 @@ filename <- restofline outerState <- getState outerPos <- getPosition - return $ do filepath <- expandPath outerPos filename + let curdir = takeDirectory (sourceName outerPos) + return $ do filepath <- expandPath curdir filename txt <- readFileOrError outerPos filepath let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n" case runParser journal outerState filepath txt of @@ -191,6 +192,7 @@ journalAddFile :: (FilePath,String) -> Journal -> Journal journalAddFile f j@Journal{files=fs} = j{files=fs++[f]} + -- XXX currently called in reverse order of includes, I can't see why accountdirective :: GenParser Char JournalContext JournalUpdate accountdirective = do diff --git a/Hledger/Reports.hs b/Hledger/Reports.hs --- a/Hledger/Reports.hs +++ b/Hledger/Reports.hs @@ -252,7 +252,8 @@ -- | Select postings from the journal and add running balance and other -- information to make a postings report. Used by eg hledger's register command. postingsReport :: ReportOpts -> Query -> Journal -> PostingsReport -postingsReport opts q j = (totallabel, postingsReportItems ps nullposting depth startbal (+)) +postingsReport opts q j = -- trace ("q: "++show q++"\nq': "++show q') $ + (totallabel, postingsReportItems ps nullposting depth startbal (+)) where ps | interval == NoInterval = displayableps | otherwise = summarisePostingsByInterval interval depth empty reportspan displayableps @@ -285,14 +286,17 @@ tests_postingsReport = [ "postingsReport" ~: do + + -- with the query specified explicitly let (query, journal) `gives` n = (length $ snd $ postingsReport defreportopts query journal) `is` n (Any, nulljournal) `gives` 0 (Any, samplejournal) `gives` 11 -- register --depth just clips account names (Depth 2, samplejournal) `gives` 11 - -- (Depth 2, samplejournal) `gives` 6 - -- (Depth 1, samplejournal) `gives` 4 + (And [Depth 1, Status True, Acct "expenses"], samplejournal) `gives` 2 + (And [And [Depth 1, Status True], Acct "expenses"], samplejournal) `gives` 2 + -- with query and/or command-line options assertEqual "" 11 (length $ snd $ postingsReport defreportopts Any samplejournal) assertEqual "" 9 (length $ snd $ postingsReport defreportopts{monthly_=True} Any samplejournal) assertEqual "" 19 (length $ snd $ postingsReport defreportopts{monthly_=True} (Empty True) samplejournal) @@ -697,12 +701,13 @@ -- | Select accounts, and get their balances at the end of the selected -- period, and misc. display information, for an accounts report. accountsReport :: ReportOpts -> Query -> Journal -> AccountsReport -accountsReport opts query j = (items, total) +accountsReport opts q j = (items, total) where -- don't do depth filtering until the end - q' = filterQuery (not . queryIsDepth) query - l = journalToLedger q' $ journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j - acctnames = filter (query `matchesAccount`) $ journalAccountNames j + q1 = filterQuery (not . queryIsDepth) q + q2 = filterQuery queryIsDepth q + l = journalToLedger q1 $ journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j + acctnames = filter (q2 `matchesAccount`) $ ledgerAccountNames l interestingaccts | no_elide_ opts = acctnames | otherwise = filter (isInteresting opts l) acctnames items = map mkitem interestingaccts @@ -723,18 +728,20 @@ | otherwise = abalance acct where acct = ledgerAccount l a -tests_accountsReport = [ - "accountsReport" ~: do - let (opts,journal) `gives` r = do +tests_accountsReport = + let (opts,journal) `gives` r = do let (eitems, etotal) = r (aitems, atotal) = accountsReport opts (queryFromOpts nulldate opts) journal assertEqual "items" eitems aitems -- assertEqual "" (length eitems) (length aitems) -- mapM (\(e,a) -> assertEqual "" e a) $ zip eitems aitems assertEqual "total" etotal atotal - - -- "accounts report with no args" ~: + in [ + + "accountsReport with no args on null journal" ~: do (defreportopts, nulljournal) `gives` ([], Mixed [nullamt]) + + ,"accountsReport with no args on sample journal" ~: do (defreportopts, samplejournal) `gives` ([ ("assets","assets",0, amount' "$-1.00") @@ -750,7 +757,7 @@ ], Mixed [nullamt]) - -- "accounts report can be limited with --depth=N" ~: + ,"accountsReport with --depth=N" ~: do (defreportopts{depth_=Just 1}, samplejournal) `gives` ([ ("assets", "assets", 0, amount' "$-1.00") @@ -760,7 +767,7 @@ ], Mixed [nullamt]) - -- or with depth:N + ,"accountsReport with depth:N" ~: do (defreportopts{query_="depth:1"}, samplejournal) `gives` ([ ("assets", "assets", 0, amount' "$-1.00") @@ -770,7 +777,7 @@ ], Mixed [nullamt]) - -- with a date span + ,"accountsReport with a date or effective date span" ~: do (defreportopts{query_="date:'in 2009'"}, samplejournal2) `gives` ([], Mixed [nullamt]) @@ -778,6 +785,30 @@ ([ ("assets:bank:checking","assets:bank:checking",0,amount' "$1.00") ,("income:salary","income:salary",0,amount' "$-1.00") + ], + Mixed [nullamt]) + + ,"accountsReport with desc:" ~: do + (defreportopts{query_="desc:income"}, samplejournal) `gives` + ([ + ("assets:bank:checking","assets:bank:checking",0,amount' "$1.00") + ,("income:salary","income:salary",0, amount' "$-1.00") + ], + Mixed [nullamt]) + + ,"accountsReport with not:desc:" ~: do + (defreportopts{query_="not:desc:income"}, samplejournal) `gives` + ([ + ("assets","assets",0, amount' "$-2.00") + ,("assets:bank","bank",1, Mixed [nullamt]) + ,("assets:bank:checking","checking",2,amount' "$-1.00") + ,("assets:bank:saving","saving",2, amount' "$1.00") + ,("assets:cash","cash",1, amount' "$-2.00") + ,("expenses","expenses",0, amount' "$2.00") + ,("expenses:food","food",1, amount' "$1.00") + ,("expenses:supplies","supplies",1, amount' "$1.00") + ,("income:gifts","income:gifts",0, amount' "$-1.00") + ,("liabilities:debts","liabilities:debts",0, amount' "$1.00") ], Mixed [nullamt]) diff --git a/Hledger/Utils.hs b/Hledger/Utils.hs --- a/Hledger/Utils.hs +++ b/Hledger/Utils.hs @@ -26,7 +26,9 @@ -- the rest need to be done in each module I think ) where -import Control.Monad.Error +import Control.Monad (liftM) +import Control.Monad.Error (MonadIO) +import Control.Monad.IO.Class (liftIO) import Data.Char import Data.List import Data.Maybe @@ -35,7 +37,7 @@ import Data.Tree import Debug.Trace import System.Directory (getHomeDirectory) -import System.FilePath(takeDirectory,combine) +import System.FilePath((), isRelative) import Test.HUnit import Text.ParserCombinators.Parsec import Text.Printf @@ -135,8 +137,8 @@ lss = map lines strs h = maximum $ map length lss ypad ls = ls ++ replicate (difforzero h (length ls)) "" - xpad ls = map (padleft w) ls where w | null ls = 0 - | otherwise = maximum $ map length ls + xpad ls = map (padright w) ls where w | null ls = 0 + | otherwise = maximum $ map length ls padded = map (xpad . ypad) lss -- | Compose strings vertically and right-aligned. @@ -401,15 +403,16 @@ applyN :: Int -> (a -> a) -> a -> a applyN n f = (!! n) . iterate f --- | Convert a possibly relative, possibly tilde-containing file path to an absolute one. --- using the current directory from a parsec source position. ~username is not supported. -expandPath :: (MonadIO m) => SourcePos -> FilePath -> m FilePath -expandPath pos fp = liftM mkAbsolute (expandHome fp) +-- | Convert a possibly relative, possibly tilde-containing file path to an absolute one, +-- given the current directory. ~username is not supported. Leave "-" unchanged. +expandPath :: MonadIO m => FilePath -> FilePath -> m FilePath -- general type sig for use in reader parsers +expandPath _ "-" = return "-" +expandPath curdir p = (if isRelative p then (curdir ) else id) `liftM` expandPath' p where - mkAbsolute = combine (takeDirectory (sourceName pos)) - expandHome inname | "~/" `isPrefixOf` inname = do homedir <- liftIO getHomeDirectory - return $ homedir ++ drop 1 inname - | otherwise = return inname + expandPath' ('~':'/':p) = liftIO $ ( p) `fmap` getHomeDirectory + expandPath' ('~':'\\':p) = liftIO $ ( p) `fmap` getHomeDirectory + expandPath' ('~':_) = error' "~USERNAME in paths is not supported" + expandPath' p = return p firstJust ms = case dropWhile (==Nothing) ms of [] -> Nothing diff --git a/hledger-lib.cabal b/hledger-lib.cabal --- a/hledger-lib.cabal +++ b/hledger-lib.cabal @@ -1,5 +1,5 @@ name: hledger-lib -version: 0.18 +version: 0.18.1 category: Finance synopsis: Core data types, parsers and utilities for the hledger accounting tool. description: @@ -71,6 +71,7 @@ ,shakespeare-text >= 1.0 && < 1.1 ,split == 0.1.* ,time + ,transformers >= 0.2 && < 0.4 ,utf8-string >= 0.3.5 && < 0.4 ,HUnit