hledger-lib 0.20.0.1 → 0.21

raw patch · 10 files changed

+157/−23 lines, 10 filesdep +hledger-libdep +test-frameworkdep +test-framework-hunitdep ~cmdargsdep ~regex-compatdep ~regexprPVP ok

version bump matches the API change (PVP)

Dependencies added: hledger-lib, test-framework, test-framework-hunit

Dependency ranges changed: cmdargs, regex-compat, regexpr, safe, split, transformers

API changes (from Hackage documentation)

Files

• Hledger/Data/Amount.hs +1/−0
• Hledger/Data/Commodity.hs +1/−1
• Hledger/Data/Journal.hs +65/−3
• Hledger/Data/Posting.hs +1/−0
• Hledger/Data/Types.hs +4/−3
• Hledger/Read/CsvReader.hs +2/−2
• Hledger/Read/JournalReader.hs +12/−8
• Hledger/Reports.hs +34/−3
• hledger-lib.cabal +31/−3
• tests/suite.hs +6/−0

@@ -81,6 +81,7 @@   divideMixedAmount,   isNegativeMixedAmount,   isZeroMixedAmount,+  isReallyZeroMixedAmount,   isReallyZeroMixedAmountCost,   -- ** rendering   showMixedAmount,

@@ -18,7 +18,7 @@   -- characters than can't be in a non-quoted commodity symbol-nonsimplecommoditychars = "0123456789-.@;\n \"{}" :: String+nonsimplecommoditychars = "0123456789-.@;\n \"{}=" :: String  quoteCommoditySymbolIfNeeded s | any (`elem` nonsimplecommoditychars) s = "\"" ++ s ++ "\""                                | otherwise = s

@@ -49,8 +49,10 @@   tests_Hledger_Data_Journal, ) where+import Control.Monad import Data.List -- import Data.Map (findWithDefault)+import Data.Maybe import Data.Ord import Data.Time.Calendar import Data.Time.LocalTime@@ -352,12 +354,72 @@ -- all transactions balance, canonicalise amount formats, close any open -- timelog entries and so on. journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> JournalContext -> Journal -> Either String Journal-journalFinalise tclock tlocal path txt ctx j@Journal{files=fs} =-    journalBalanceTransactions $+journalFinalise tclock tlocal path txt ctx j@Journal{files=fs} = do+  (journalBalanceTransactions $     journalCanonicaliseAmounts $     journalCloseTimeLogEntries tlocal-    j{files=(path,txt):fs, filereadtime=tclock, jContext=ctx}+    j{files=(path,txt):fs, filereadtime=tclock, jContext=ctx})+  >>= journalCheckBalanceAssertions +-- | Check any balance assertions in the journal and return an error+-- message if any of them fail.+journalCheckBalanceAssertions :: Journal -> Either String Journal+journalCheckBalanceAssertions j = do+  let postingsByAccount = groupBy (\p1 p2 -> paccount p1 == paccount p2) $+                          sortBy (comparing paccount) $+                          journalPostings j+  forM_ postingsByAccount checkBalanceAssertionsForAccount+  Right j++-- Check any balance assertions in this sequence of postings to a single account.+checkBalanceAssertionsForAccount :: [Posting] -> Either String ()+checkBalanceAssertionsForAccount ps+  | null errs = Right ()+  | otherwise = Left $ head errs+  where+    errs = fst $+           foldl' checkBalanceAssertion ([],nullmixedamt) $+           splitAssertions $+           sortBy (comparing postingDate) ps++-- Given a starting balance, accumulated errors, and a non-null sequence of+-- postings to a single account with a balance assertion in the last:+-- check that the final balance matches the balance assertion.+-- If it does, return the new balance, otherwise add an error to the+-- error list. Intended to be called from a fold.+checkBalanceAssertion :: ([String],MixedAmount) -> [Posting] -> ([String],MixedAmount)+checkBalanceAssertion (errs,bal) ps+  | null ps = (errs,bal)+  | isNothing assertion = (errs,bal)+  |+    -- bal' /= assertedbal  -- MixedAmount's Eq instance currently gets confused by different precisions+    not $ isReallyZeroMixedAmount (bal' - assertedbal)+      = (errs++[err], bal')+  | otherwise = (errs,bal')+  where+    p = last ps+    assertion = pbalanceassertion p+    Just assertedbal = assertion+    bal' = sum $ [bal] ++ map pamount ps+    err = printf "Balance assertion failed for account %s on %s\n%safter\n   %s\nexpected balance is %s, actual balance was %s."+                 (paccount p)+                 (show $ postingDate p)+                 (maybe "" (("In\n"++).show) $ ptransaction p)+                 (show p)+                 (showMixedAmount assertedbal)+                 (showMixedAmount bal')++-- Given a sequence of postings to a single account, split it into+-- sub-sequences consisting of ordinary postings followed by a single+-- balance-asserting posting. Postings not followed by a balance+-- assertion are discarded.+splitAssertions :: [Posting] -> [[Posting]]+splitAssertions ps+  | null rest = [[]]+  | otherwise = (ps'++[head rest]):splitAssertions (tail rest)+  where+    (ps',rest) = break (isJust . pbalanceassertion) ps+     -- | Fill in any missing amounts and check that all journal transactions -- balance, or return an error message. This is done after parsing all -- amounts and working out the canonical commodities, since balancing

@@ -71,6 +71,7 @@                 ,pcomment=""                 ,ptype=RegularPosting                 ,ptags=[]+                ,pbalanceassertion=Nothing                 ,ptransaction=Nothing                 } posting = nullposting

@@ -84,14 +84,15 @@       pcomment :: String, -- ^ this posting's non-tag comment lines, as a single non-indented string       ptype :: PostingType,       ptags :: [Tag],-      ptransaction :: Maybe Transaction  -- ^ this posting's parent transaction (co-recursive types).-                                         -- Tying this knot gets tedious, Maybe makes it easier/optional.+      pbalanceassertion :: Maybe MixedAmount,  -- ^ optional: the expected balance in the account after this posting+      ptransaction :: Maybe Transaction    -- ^ this posting's parent transaction (co-recursive types).+                                           -- Tying this knot gets tedious, Maybe makes it easier/optional.     }  -- The equality test for postings ignores the parent transaction's -- identity, to avoid infinite loops. instance Eq Posting where-    (==) (Posting a1 b1 c1 d1 e1 f1 g1 h1 _) (Posting a2 b2 c2 d2 e2 f2 g2 h2 _) =  a1==a2 && b1==b2 && c1==c2 && d1==d2 && e1==e2 && f1==f2 && g1==g2 && h1==h2+    (==) (Posting a1 b1 c1 d1 e1 f1 g1 h1 i1 _) (Posting a2 b2 c2 d2 e2 f2 g2 h2 i2 _) =  a1==a2 && b1==b2 && c1==c2 && d1==d2 && e1==e2 && f1==f2 && g1==g2 && h1==h2 && i1==i2  data Transaction = Transaction {       tdate :: Day,

@@ -557,7 +557,7 @@       ,"the default-currency is: "++fromMaybe "unspecified" mdefaultcurrency       ,"the parse error is:      "++show err       ,"you may need to "-       ++"change your amount, currency or default-currency rules, "+       ++"change your amount or currency rules, "        ++"or "++maybe "add a" (const "change your") mskip++" skip rule"       ]     -- Using costOfMixedAmount here to allow complex costs like "10 GBP @@ 15 USD".@@ -593,7 +593,7 @@    mamount    = getEffectiveAssignment rules record "amount"    mamountin  = getEffectiveAssignment rules record "amount-in"    mamountout = getEffectiveAssignment rules record "amount-out"-   render     = fmap (renderTemplate rules record)+   render     = fmap (strip . renderTemplate rules record)  in   case (render mamount, render mamountin, render mamountout) of     (Just "", Nothing, Nothing) -> error' $ "amount has no value\n"++showRecord record

@@ -52,7 +52,9 @@ import Data.Time.LocalTime import Safe (headDef, lastDef) #ifdef TESTS-import Test.Framework+import Test.HUnit+import Test.Framework.HUnitWrapper+-- import Test.Framework import Text.Parsec.Error #endif import Text.ParserCombinators.Parsec hiding (parse)@@ -508,7 +510,7 @@   account <- modifiedaccountname   let (ptype, account') = (accountNamePostingType account, unbracket account)   amount <- spaceandamountormissing-  _ <- balanceassertion+  massertion <- balanceassertion   _ <- fixedlotprice   many spacenonewline   ctx <- getState@@ -517,7 +519,7 @@   -- oh boy   d  <- maybe (return Nothing) (either (fail.show) (return.Just)) (parseWithCtx ctx date `fmap` dateValueFromTags tags)   d2 <- maybe (return Nothing) (either (fail.show) (return.Just)) (parseWithCtx ctx date `fmap` date2ValueFromTags tags)-  return posting{pdate=d, pdate2=d2, pstatus=status, paccount=account', pamount=amount, pcomment=comment, ptype=ptype, ptags=tags}+  return posting{pdate=d, pdate2=d2, pstatus=status, paccount=account', pamount=amount, pcomment=comment, ptype=ptype, ptags=tags, pbalanceassertion=massertion}  #ifdef TESTS test_postingp = do@@ -559,9 +561,11 @@   -- ,"postingp parses balance assertions and fixed lot prices" ~: do     assertBool (isRight $ parseWithCtx nullctx postingp "  a  1 \"DE123\" =$1 { =2.2 EUR} \n") -    let parse = parseWithCtx nullctx postingp " a\n ;next-line comment\n"-    assertRight parse-    assertEqual "next-line comment\n" (let Right p = parse in pcomment p)+    -- let parse = parseWithCtx nullctx postingp " a\n ;next-line comment\n"+    -- assertRight parse+    -- let Right p = parse+    -- assertEqual "next-line comment\n" (pcomment p)+    -- assertEqual (Just nullmixedamt) (pbalanceassertion p) #endif         -- | Parse an account name, then apply any parent account prefix and/or account aliases currently in effect.@@ -706,14 +710,14 @@             return $ UnitPrice a))          <|> return NoPrice -balanceassertion :: GenParser Char JournalContext (Maybe Amount)+balanceassertion :: GenParser Char JournalContext (Maybe MixedAmount) balanceassertion =     try (do           many spacenonewline           char '='           many spacenonewline           a <- amountp -- XXX should restrict to a simple amount-          return $ Just a)+          return $ Just $ Mixed [a])          <|> return Nothing  -- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices

@@ -34,7 +34,8 @@   TransactionsReport,   TransactionsReportItem,   triDate,-  triBalance,+  triSimpleBalance,+  transactionsReportByCommodity,   journalTransactionsReport,   accountTransactionsReport,   -- * Accounts report@@ -435,8 +436,38 @@                               )  triDate (t,_,_,_,_,_) = tdate t-triBalance (_,_,_,_,_,Mixed a) = case a of [] -> "0"-                                           (Amount{aquantity=q}):_ -> show q+triAmount (_,_,_,_,a,_) = a+triSimpleBalance (_,_,_,_,_,Mixed a) = case a of [] -> "0"+                                                 (Amount{aquantity=q}):_ -> show q++-- Split a transactions report whose items may involve several commodities,+-- into one or more single-commodity transactions reports.+transactionsReportByCommodity :: TransactionsReport -> [TransactionsReport]+transactionsReportByCommodity tr =+  [filterTransactionsReportByCommodity c tr | c <- transactionsReportCommodities tr]+  where+    transactionsReportCommodities (_,items) =+      nub $ sort $ map acommodity $ concatMap (amounts . triAmount) items++-- Remove transaction report items and item amount components that+-- don't involve the specified commodity. Other item fields like the+-- running balance and the transaction are left unchanged.+filterTransactionsReportByCommodity :: Commodity -> TransactionsReport -> TransactionsReport+filterTransactionsReportByCommodity c (label,items) =+  (label, fixTransactionsReportItemBalances $ concat [filterTransactionsReportItemByCommodity c i | i <- items])+  where+    filterTransactionsReportItemByCommodity c (t,t2,s,o,Mixed as,bal)+      | c `elem` cs = [item']+      | otherwise   = []+      where+        cs = map acommodity as+        item' = (t,t2,s,o,Mixed as',bal)+        as' = filter ((==c).acommodity) as+    fixTransactionsReportItemBalances is = reverse $ go nullmixedamt $ reverse is+      where+        go _ [] = []+        go bal ((t,t2,s,o,amt,_):is) = (t,t2,s,o,amt,bal'):go bal' is+          where bal' = bal + amt  -- | Select transactions from the whole journal for a transactions report, -- with no \"current\" account. The end result is similar to

@@ -1,5 +1,5 @@ name:           hledger-lib-version: 0.20.0.1+version: 0.21 category:       Finance synopsis:       Core data types, parsers and utilities for the hledger accounting tool. description:@@ -18,12 +18,12 @@ bug-reports:    http://hledger.org/bugs stability:      beta tested-with:    GHC==7.2.2, GHC==7.4.2, GHC==7.6.1-cabal-version:  >= 1.8+cabal-version:  >= 1.10 build-type:     Simple -- data-dir:       data -- data-files: -- extra-tmp-files:--- extra-source-files:+extra-source-files: tests/suite.hs --   README --   sample.ledger --   sample.timelog@@ -75,10 +75,38 @@                  ,transformers >= 0.2 && < 0.4                  ,utf8-string >= 0.3.5 && < 0.4                  ,HUnit+  default-language: Haskell2010  source-repository head   type:     git   location: https://github.com/simonmichael/hledger++test-suite tests+  type:     exitcode-stdio-1.0+  main-is:  tests/suite.hs+  ghc-options: -Wall+  build-depends: hledger-lib+               , base >= 4.3 && < 5+               , cmdargs+               , containers+               , csv+               , directory+               , filepath+               , HUnit+               , mtl+               , old-locale+               , old-time+               , parsec+               , pretty-show+               , regex-compat+               , regexpr+               , safe+               , split+               , test-framework+               , test-framework-hunit+               , time+               , transformers+  default-language: Haskell2010  -- cf http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html 

@@ -0,0 +1,6 @@+import Hledger (tests_Hledger)+import Test.Framework.Providers.HUnit (hUnitTestToTests)+import Test.Framework.Runners.Console (defaultMain)++main :: IO ()+main = defaultMain $ hUnitTestToTests tests_Hledger