hledger-lib 0.15.2 → 0.16

raw patch · 6 files changed

+107/−66 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Hledger/Data/Dates.hs +14/−0
• Hledger/Data/Matching.hs +14/−7
• Hledger/Data/Transaction.hs +18/−13
• Hledger/Read.hs +25/−27
• Hledger/Reports.hs +35/−18
• hledger-lib.cabal +1/−1

@@ -116,6 +116,20 @@     where a = if isJust a1 then a1 else a2           b = if isJust b1 then b1 else b2 +-- | Calculate the intersection of two datespans.+spanIntersect (DateSpan b1 e1) (DateSpan b2 e2) = DateSpan b e+    where+      b = latest b1 b2+      e = earliest e1 e2++latest d Nothing = d+latest Nothing d = d+latest (Just d1) (Just d2) = Just $ max d1 d2++earliest d Nothing = d+earliest Nothing d = d+earliest (Just d1) (Just d2) = Just $ min d1 d2+ -- | Parse a period expression to an Interval and overall DateSpan using -- the provided reference date, or return a parse error. parsePeriodExpr :: Day -> String -> Either ParseError (Interval, DateSpan)

@@ -112,10 +112,13 @@     where       maybeprefixedquotedphrases = choice' [prefixedQuotedPattern, quotedPattern, pattern] `sepBy` many1 spacenonewline       prefixedQuotedPattern = do-        not' <- optionMaybe $ string "not:"-        prefix <- choice' $ map string prefixes+        not' <- fromMaybe "" `fmap` (optionMaybe $ string "not:")+        let allowednexts | null not' = prefixes+                         | otherwise = prefixes ++ [""]+        next <- choice' $ map string allowednexts+        let prefix = not' ++ next         p <- quotedPattern-        return $ fromMaybe "" not' ++ prefix ++ stripquotes p+        return $ prefix ++ stripquotes p       quotedPattern = do         p <- between (oneOf "'\"") (oneOf "'\"") $ many $ noneOf "'\""         return $ stripquotes p@@ -216,10 +219,6 @@ postingEffectiveDate :: Posting -> Maybe Day postingEffectiveDate p = maybe Nothing (Just . transactionEffectiveDate) $ ptransaction p -transactionEffectiveDate :: Transaction -> Day-transactionEffectiveDate t = case teffectivedate t of Just d  -> d-                                                      Nothing -> tdate t- -- | Does the match expression match this account ? -- A matching in: clause is also considered a match. matchesAccount :: Matcher -> AccountName -> Bool@@ -313,5 +312,13 @@     assertBool "real:1 on real posting" $ (MatchReal True) `matchesPosting` nullposting{ptype=RegularPosting}     assertBool "real:1 on virtual posting fails" $ not $ (MatchReal True) `matchesPosting` nullposting{ptype=VirtualPosting}     assertBool "real:1 on balanced virtual posting fails" $ not $ (MatchReal True) `matchesPosting` nullposting{ptype=BalancedVirtualPosting}++  ,"words''" ~: do+    assertEqual "1" ["a","b"]        (words'' [] "a b")+    assertEqual "2" ["a b"]          (words'' [] "'a b'")+    assertEqual "3" ["not:a","b"]    (words'' [] "not:a b")+    assertEqual "4" ["not:a b"]    (words'' [] "not:'a b'")+    assertEqual "5" ["not:a b"]    (words'' [] "'not:a b'")+    assertEqual "6" ["not:desc:a b"]    (words'' ["desc:"] "not:desc:'a b'")   ]

@@ -10,6 +10,7 @@ where import Data.List import Data.Maybe+import Data.Time.Calendar import Test.HUnit import Text.Printf import qualified Data.Map as Map@@ -59,27 +60,23 @@ @ -} showTransaction :: Transaction -> String-showTransaction = showTransaction' True False+showTransaction = showTransaction' True  showTransactionUnelided :: Transaction -> String-showTransactionUnelided = showTransaction' False False--showTransactionForPrint :: Bool -> Transaction -> String-showTransactionForPrint effective = showTransaction' False effective+showTransactionUnelided = showTransaction' False -showTransaction' :: Bool -> Bool -> Transaction -> String-showTransaction' elide effective t =+showTransaction' :: Bool -> Transaction -> String+showTransaction' elide t =     unlines $ [description] ++ showpostings (tpostings t) ++ [""]     where       description = concat [date, status, code, desc, comment]-      date | effective = showdate $ fromMaybe (tdate t) $ teffectivedate t-           | otherwise = showdate (tdate t) ++ maybe "" showedate (teffectivedate t)+      date = showdate (tdate t) ++ maybe "" showedate (teffectivedate t)+      showdate = printf "%-10s" . showDate+      showedate = printf "=%s" . showdate       status = if tstatus t then " *" else ""       code = if length (tcode t) > 0 then printf " (%s)" $ tcode t else ""       desc = if null d then "" else " " ++ d where d = tdescription t       comment = if null c then "" else "  ; " ++ c where c = tcomment t-      showdate = printf "%-10s" . showDate-      showedate = printf "=%s" . showdate       showpostings ps           | elide && length ps > 1 && isTransactionBalanced Nothing t -- imprecise balanced check               = map showposting (init ps) ++ [showpostingnoamt (last ps)]@@ -237,10 +234,18 @@             | otherwise = "balanced virtual postings are off by " ++ show (costOfMixedAmount bvsum)       sep = if not (null rmsg) && not (null bvmsg) then "; " else "" --- | Convert the primary date to either the actual or effective date.+transactionActualDate :: Transaction -> Day+transactionActualDate = tdate++-- Get a transaction's effective date, defaulting to the actual date.+transactionEffectiveDate :: Transaction -> Day+transactionEffectiveDate t = fromMaybe (tdate t) $ teffectivedate t++-- | Once we no longer need both, set the main transaction date to either+-- the actual or effective date. A bit hacky. journalTransactionWithDate :: WhichDate -> Transaction -> Transaction journalTransactionWithDate ActualDate t = t-journalTransactionWithDate EffectiveDate t = txnTieKnot t{tdate=fromMaybe (tdate t) (teffectivedate t)}+journalTransactionWithDate EffectiveDate t = txnTieKnot t{tdate=transactionEffectiveDate t}  -- | Ensure a transaction's postings refer back to it. txnTieKnot :: Transaction -> Transaction

@@ -11,12 +11,12 @@        journalFromPathAndString,        ledgeraccountname,        myJournalPath,-       myTimelogPath,        myJournal,-       myTimelog,        someamount,        journalenvvar,-       journaldefaultfilename+       journaldefaultfilename,+       requireJournalFile,+       ensureJournalFile, ) where import Control.Monad.Error@@ -25,6 +25,7 @@ import Safe (headDef) import System.Directory (doesFileExist, getHomeDirectory) import System.Environment (getEnv)+import System.Exit (exitFailure) import System.FilePath ((</>)) import System.IO (IOMode(..), withFile, stderr) import Test.HUnit@@ -36,15 +37,13 @@ import Hledger.Read.JournalReader as JournalReader import Hledger.Read.TimelogReader as TimelogReader import Hledger.Utils-import Prelude hiding (getContents)-import Hledger.Utils.UTF8 (getContents, hGetContents)+import Prelude hiding (getContents, writeFile)+import Hledger.Utils.UTF8 (getContents, hGetContents, writeFile)   journalenvvar           = "LEDGER_FILE" journalenvvar2          = "LEDGER"-timelogenvvar           = "TIMELOG" journaldefaultfilename  = ".hledger.journal"-timelogdefaultfilename = ".hledger.timelog"  -- Here are the available readers. The first is the default, used for unknown data formats. readers :: [Reader]@@ -91,23 +90,34 @@ readJournalFile :: Maybe String -> FilePath -> IO (Either String Journal) readJournalFile format "-" = getContents >>= journalFromPathAndString format "(stdin)" readJournalFile format f = do-  ensureJournalFile f+  requireJournalFile f   withFile f ReadMode $ \h -> hGetContents h >>= journalFromPathAndString format f --- | Ensure there is a journal at the given file path, creating an empty one if needed.+-- | If the specified journal file does not exist, give a helpful error and quit.+requireJournalFile :: FilePath -> IO ()+requireJournalFile f = do+  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 "Or, specify an existing journal file with -f or LEDGER_FILE.\n"+    exitFailure++-- | Ensure there is a journal file at the given path, creating an empty one if needed. ensureJournalFile :: FilePath -> IO () ensureJournalFile f = do   exists <- doesFileExist f   when (not exists) $ do-    hPrintf stderr "No journal file \"%s\", creating it.\n" f-    hPrintf stderr "Edit this file or use \"hledger add\" or \"hledger web\" to add transactions.\n"-    emptyJournal >>= writeFile f+    hPrintf stderr "Creating hledger journal file \"%s\".\n" f+    -- note Hledger.Utils.UTF8.* do no line ending conversion on windows,+    -- we currently require unix line endings on all platforms.+    newJournalContent >>= writeFile f  -- | Give the content for a new auto-created journal file.-emptyJournal :: IO String-emptyJournal = do+newJournalContent :: IO String+newJournalContent = do   d <- getCurrentDay-  return $ printf "; journal created %s by hledger\n\n" (show d)+  return $ printf "; journal created %s by hledger\n" (show d)  -- | Read a Journal from this string, using the specified data format or -- trying all known formats, or give an error string.@@ -129,22 +139,10 @@       defaultJournalPath = do                   home <- getHomeDirectory `catch` (\_ -> return "")                   return $ home </> journaldefaultfilename-  --- | Get the user's default timelog file path.-myTimelogPath :: IO String-myTimelogPath =-    getEnv timelogenvvar `catch`-               (\_ -> do-                  home <- getHomeDirectory-                  return $ home </> timelogdefaultfilename)  -- | Read the user's default journal file, or give an error. myJournal :: IO Journal myJournal = myJournalPath >>= readJournalFile Nothing >>= either error' return---- | Read the user's default timelog file, or give an error.-myTimelog :: IO Journal-myTimelog = myTimelogPath >>= readJournalFile Nothing >>= either error' return  tests_Hledger_Read = TestList   [

@@ -146,10 +146,14 @@                                     | uncleared_ = Just False                                     | otherwise  = Nothing --- | Detect which date we will report on, based on --effective.+-- | Report which date we will report on based on --effective. whichDateFromOpts :: ReportOpts -> WhichDate whichDateFromOpts ReportOpts{..} = if effective_ then EffectiveDate else ActualDate +-- | Select a Transaction date accessor based on --effective.+transactionDateFn :: ReportOpts -> (Transaction -> Day)+transactionDateFn ReportOpts{..} = if effective_ then transactionEffectiveDate else transactionActualDate+ -- | Convert this journal's transactions' primary date to either the -- actual or effective date, as per options. journalSelectingDateFromOpts :: ReportOpts -> Journal -> Journal@@ -197,9 +201,10 @@  -- | Select transactions for an entries report. entriesReport :: ReportOpts -> FilterSpec -> Journal -> EntriesReport-entriesReport opts fspec j = sortBy (comparing tdate) $ jtxns $ filterJournalTransactions fspec j'+entriesReport opts fspec j = sortBy (comparing f) $ jtxns $ filterJournalTransactions fspec j'     where-      j' = journalSelectingDateFromOpts opts $ journalSelectingAmountFromOpts opts j+      f = transactionDateFn opts+      j' = journalSelectingAmountFromOpts opts j  ------------------------------------------------------------------------------- @@ -219,17 +224,28 @@ postingsReport opts fspec j = (totallabel, postingsReportItems ps nullposting startbal (+))     where       ps | interval == NoInterval = displayableps-         | otherwise              = summarisePostingsByInterval interval depth empty filterspan displayableps-      (precedingps, displayableps, _) = postingsMatchingDisplayExpr (display_ opts)+         | otherwise              = summarisePostingsByInterval interval depth empty reportspan displayableps+      j' =                                journalSelectingDateFromOpts opts+                                        $ journalSelectingAmountFromOpts opts+                                        j+      (precedingps, displayableps, _) =   postingsMatchingDisplayExpr (display_ opts)                                         $ depthClipPostings depth                                         $ journalPostings                                         $ filterJournalPostings fspec{depth=Nothing}-                                        $ journalSelectingDateFromOpts opts-                                        $ journalSelectingAmountFromOpts opts-                                        j+                                        j'+      (interval, depth, empty, displayexpr) = (intervalFromOpts opts, depth_ opts, empty_ opts, display_ opts)+      journalspan = journalDateSpan j'+      -- requestedspan should be the intersection of any span specified+      -- with period options and any span specified with display option.+      -- The latter is not easily available, fake it for now.+      requestedspan = periodspan `spanIntersect` displayspan+      periodspan = datespan fspec+      displayspan = postingsDateSpan ps+          where (_,ps,_) = postingsMatchingDisplayExpr displayexpr $ journalPostings j'+      matchedspan = postingsDateSpan displayableps+      reportspan | empty     = requestedspan `orDatesFrom` journalspan+                 | otherwise = requestedspan `spanIntersect` matchedspan       startbal = sumPostings precedingps-      filterspan = datespan fspec-      (interval, depth, empty) = (intervalFromOpts opts, depth_ opts, empty_ opts)  totallabel = "Total" balancelabel = "Balance"@@ -304,13 +320,10 @@ -- are one per account per interval and aggregated to the specified depth -- if any. summarisePostingsByInterval :: Interval -> Maybe Int -> Bool -> DateSpan -> [Posting] -> [Posting]-summarisePostingsByInterval interval depth empty filterspan ps = concatMap summarisespan $ splitSpan interval reportspan+summarisePostingsByInterval interval depth empty reportspan ps = concatMap summarisespan $ splitSpan interval reportspan     where       summarisespan s = summarisePostingsInDateSpan s depth empty (postingsinspan s)       postingsinspan s = filter (isPostingInDateSpan s) ps-      dataspan = postingsDateSpan ps-      reportspan | empty = filterspan `orDatesFrom` dataspan-                 | otherwise = dataspan  -- | Given a date span (representing a reporting interval) and a list of -- postings within it: aggregate the postings so there is only one per@@ -526,6 +539,7 @@ isInteresting opts l a | flat_ opts = isInterestingFlat opts l a                        | otherwise = isInterestingIndented opts l a +-- | Determine whether an account should get its own line in the --flat balance report. isInterestingFlat :: ReportOpts -> Ledger -> AccountName -> Bool isInterestingFlat opts l a = notempty || emptyflag     where@@ -533,16 +547,19 @@       notempty = not $ isZeroMixedAmount $ exclusiveBalance acct       emptyflag = empty_ opts +-- | Determine whether an account should get its own line in the indented+-- balance report.  Cf Balance module doc. isInterestingIndented :: ReportOpts -> Ledger -> AccountName -> Bool isInterestingIndented opts l a-    | numinterestingsubs==1 && not atmaxdepth = notlikesub-    | otherwise = notzero || emptyflag+    | numinterestingsubs == 1 && samebalanceassub && not atmaxdepth = False+    | numinterestingsubs < 2 && zerobalance && not emptyflag = False+    | otherwise = True     where       atmaxdepth = isJust d && Just (accountNameLevel a) == d where d = depth_ opts       emptyflag = empty_ opts       acct = ledgerAccount l a-      notzero = not $ isZeroMixedAmount inclbalance where inclbalance = abalance acct-      notlikesub = not $ isZeroMixedAmount exclbalance where exclbalance = sumPostings $ apostings acct+      zerobalance = isZeroMixedAmount inclbalance where inclbalance = abalance acct+      samebalanceassub = isZeroMixedAmount exclbalance where exclbalance = sumPostings $ apostings acct       numinterestingsubs = length $ filter isInterestingTree subtrees           where             isInterestingTree = treeany (isInteresting opts l . aname)

@@ -1,5 +1,5 @@ name:           hledger-lib-version: 0.15.2+version: 0.16 category:       Finance synopsis:       Core data types, parsers and utilities for the hledger accounting tool. description: