refactor with DateSpan

This commit is contained in:
Simon Michael 2008-11-27 04:31:01 +00:00
parent 630e22312b
commit d25995c1c8
7 changed files with 21 additions and 12 deletions

View File

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

View File

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

View File

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

View File

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

View File

@ -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
("" ++

View File

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

View File

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