hledger-lib 0.18 → 0.18.1

raw patch · 8 files changed

+86/−39 lines, 8 filesdep +transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: transformers

API changes (from Hackage documentation)

Files

• Hledger/Data/Types.hs +3/−3
• Hledger/Query.hs +8/−4
• Hledger/Read.hs +1/−1
• Hledger/Read/CsvReader.hs +7/−1
• Hledger/Read/JournalReader.hs +4/−2
• Hledger/Reports.hs +46/−15
• Hledger/Utils.hs +15/−12
• hledger-lib.cabal +2/−1

@@ -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) 

@@ -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])]  ] 

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

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

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

@@ -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]) 

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

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