From d25995c1c84b03747b48e0fa3c6d4857ea644411 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 27 Nov 2008 04:31:01 +0000 Subject: [PATCH] refactor with DateSpan --- Ledger/Dates.hs | 6 ++++++ Ledger/RawLedger.hs | 10 +++++----- Ledger/Types.hs | 2 ++ Options.hs | 2 ++ Tests.hs | 2 +- Utils.hs | 6 +++--- hledger.hs | 5 ++--- 7 files changed, 21 insertions(+), 12 deletions(-) diff --git a/Ledger/Dates.hs b/Ledger/Dates.hs index 35198ddf5..4d6e690db 100644 --- a/Ledger/Dates.hs +++ b/Ledger/Dates.hs @@ -1,10 +1,16 @@ {-| +For date and time values, we use the standard Day and UTCTime types. + A 'SmartDate' is a date which may be partially-specified or relative. Eg 2008/12/31, but also 2008/12, 12/31, tomorrow, last week, next year. We represent these as a triple of strings like ("2008","12",""), ("","","tomorrow"), ("","last","week"). +A 'DateSpan' is the span of time between two specific calendar dates, or +possibly an open-ended span where one or both dates are missing. We use +this term since "period" and "interval" are ambiguous. + -} module Ledger.Dates diff --git a/Ledger/RawLedger.hs b/Ledger/RawLedger.hs index 89003b819..9b4350094 100644 --- a/Ledger/RawLedger.hs +++ b/Ledger/RawLedger.hs @@ -43,11 +43,11 @@ rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l -- | Remove ledger entries we are not interested in. -- Keep only those which fall between the begin and end dates, and match -- the description pattern, and are cleared or real if those options are active. -filterRawLedger :: Maybe Day -> Maybe Day -> [String] -> Bool -> Bool -> RawLedger -> RawLedger -filterRawLedger begin end pats clearedonly realonly = +filterRawLedger :: DateSpan -> [String] -> Bool -> Bool -> RawLedger -> RawLedger +filterRawLedger span pats clearedonly realonly = filterRawLedgerTransactionsByRealness realonly . filterRawLedgerEntriesByClearedStatus clearedonly . - filterRawLedgerEntriesByDate begin end . + filterRawLedgerEntriesByDate span . filterRawLedgerEntriesByDescription pats -- | Keep only entries whose description matches the description patterns. @@ -59,8 +59,8 @@ filterRawLedgerEntriesByDescription pats (RawLedger ms ps es f) = -- | Keep only entries which fall between begin and end dates. -- We include entries on the begin date and exclude entries on the end -- date, like ledger. An empty date string means no restriction. -filterRawLedgerEntriesByDate :: Maybe Day -> Maybe Day -> RawLedger -> RawLedger -filterRawLedgerEntriesByDate begin end (RawLedger ms ps es f) = +filterRawLedgerEntriesByDate :: DateSpan -> RawLedger -> RawLedger +filterRawLedgerEntriesByDate (DateSpan begin end) (RawLedger ms ps es f) = RawLedger ms ps (filter matchdate es) f where matchdate e = (maybe True (edate e>=) begin) && (maybe True (edate e<) end) diff --git a/Ledger/Types.hs b/Ledger/Types.hs index 311aa5c3b..a59edc541 100644 --- a/Ledger/Types.hs +++ b/Ledger/Types.hs @@ -14,6 +14,8 @@ import qualified Data.Map as Map type SmartDate = (String,String,String) +data DateSpan = DateSpan (Maybe Day) (Maybe Day) + type AccountName = String data Side = L | R deriving (Eq,Show,Ord) diff --git a/Options.hs b/Options.hs index 4dc1bb35b..04bfe6e48 100644 --- a/Options.hs +++ b/Options.hs @@ -124,6 +124,8 @@ tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs)) -- return (homeDirectory pw ++ path) tildeExpand xs = return xs +dateSpanFromOpts opts = DateSpan (beginDateFromOpts opts) (endDateFromOpts opts) + -- | Get the value of the begin date option, if any. beginDateFromOpts :: [Opt] -> Maybe Day beginDateFromOpts opts = diff --git a/Tests.hs b/Tests.hs index c80225805..668c78cff 100644 --- a/Tests.hs +++ b/Tests.hs @@ -284,7 +284,7 @@ balancecommand_tests = TestList [ , "balance report with cost basis" ~: do let l = cacheLedger [] $ - filterRawLedger Nothing Nothing [] False False $ + filterRawLedger (DateSpan Nothing Nothing) [] False False $ canonicaliseAmounts True $ -- enable cost basis adjustment rawledgerfromstring ("" ++ diff --git a/Utils.hs b/Utils.hs index 98b0db9e9..3d4de914c 100644 --- a/Utils.hs +++ b/Utils.hs @@ -19,7 +19,7 @@ rawledgerfromstring = fromparse . parsewith ledgerfile -- | Get a filtered and cached Ledger from the given string, or raise an error. ledgerfromstring :: [String] -> String -> Ledger ledgerfromstring args s = - cacheLedger apats $ filterRawLedger Nothing Nothing dpats False False l + cacheLedger apats $ filterRawLedger (DateSpan Nothing Nothing) dpats False False l where (apats,dpats) = parseAccountDescriptionArgs [] args l = rawledgerfromstring s @@ -35,7 +35,7 @@ rawledgerfromfile f = do ledgerfromfile :: [String] -> FilePath -> IO Ledger ledgerfromfile args f = do l <- rawledgerfromfile f - return $ cacheLedger apats $ filterRawLedger Nothing Nothing dpats False False l + return $ cacheLedger apats $ filterRawLedger (DateSpan Nothing Nothing) dpats False False l where (apats,dpats) = parseAccountDescriptionArgs [] args @@ -51,7 +51,7 @@ myrawledger = do myledger :: IO Ledger myledger = do l <- myrawledger - return $ cacheLedger [] $ filterRawLedger Nothing Nothing [] False False l + return $ cacheLedger [] $ filterRawLedger (DateSpan Nothing Nothing) [] False False l -- | Get a named account from your ledger file. myaccount :: AccountName -> IO Account diff --git a/hledger.hs b/hledger.hs index 740c53df5..abf144948 100644 --- a/hledger.hs +++ b/hledger.hs @@ -71,10 +71,9 @@ parseLedgerAndDo :: [Opt] -> [String] -> ([Opt] -> [String] -> Ledger -> IO ()) parseLedgerAndDo opts args cmd = do ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either printParseError runcmd where - runcmd = cmd opts args . cacheLedger apats . filterRawLedger b e dpats c r . canonicaliseAmounts costbasis + runcmd = cmd opts args . cacheLedger apats . filterRawLedger span dpats c r . canonicaliseAmounts costbasis (apats,dpats) = parseAccountDescriptionArgs opts args - b = beginDateFromOpts opts - e = endDateFromOpts opts + span = dateSpanFromOpts opts c = Cleared `elem` opts r = Real `elem` opts costbasis = CostBasis `elem` opts