refactor with DateSpan
This commit is contained in:
		
							parent
							
								
									630e22312b
								
							
						
					
					
						commit
						d25995c1c8
					
				| @ -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. | 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. | 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",""), | We represent these as a triple of strings like ("2008","12",""), | ||||||
| ("","","tomorrow"), ("","last","week"). | ("","","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 | module Ledger.Dates | ||||||
|  | |||||||
| @ -43,11 +43,11 @@ rawLedgerAccountNameTree l = accountNameTreeFrom $ rawLedgerAccountNames l | |||||||
| -- | Remove ledger entries we are not interested in. | -- | Remove ledger entries we are not interested in. | ||||||
| -- Keep only those which fall between the begin and end dates, and match | -- 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. | -- the description pattern, and are cleared or real if those options are active. | ||||||
| filterRawLedger :: Maybe Day -> Maybe Day -> [String] -> Bool -> Bool -> RawLedger -> RawLedger | filterRawLedger :: DateSpan -> [String] -> Bool -> Bool -> RawLedger -> RawLedger | ||||||
| filterRawLedger begin end pats clearedonly realonly =  | filterRawLedger span pats clearedonly realonly =  | ||||||
|     filterRawLedgerTransactionsByRealness realonly . |     filterRawLedgerTransactionsByRealness realonly . | ||||||
|     filterRawLedgerEntriesByClearedStatus clearedonly . |     filterRawLedgerEntriesByClearedStatus clearedonly . | ||||||
|     filterRawLedgerEntriesByDate begin end . |     filterRawLedgerEntriesByDate span . | ||||||
|     filterRawLedgerEntriesByDescription pats |     filterRawLedgerEntriesByDescription pats | ||||||
| 
 | 
 | ||||||
| -- | Keep only entries whose description matches the description patterns. | -- | 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.  | -- | Keep only entries which fall between begin and end dates.  | ||||||
| -- We include entries on the begin date and exclude entries on the end | -- We include entries on the begin date and exclude entries on the end | ||||||
| -- date, like ledger.  An empty date string means no restriction. | -- date, like ledger.  An empty date string means no restriction. | ||||||
| filterRawLedgerEntriesByDate :: Maybe Day -> Maybe Day -> RawLedger -> RawLedger | filterRawLedgerEntriesByDate :: DateSpan -> RawLedger -> RawLedger | ||||||
| filterRawLedgerEntriesByDate begin end (RawLedger ms ps es f) =  | filterRawLedgerEntriesByDate (DateSpan begin end) (RawLedger ms ps es f) =  | ||||||
|     RawLedger ms ps (filter matchdate es) f |     RawLedger ms ps (filter matchdate es) f | ||||||
|     where  |     where  | ||||||
|       matchdate e = (maybe True (edate e>=) begin) && (maybe True (edate e<) end) |       matchdate e = (maybe True (edate e>=) begin) && (maybe True (edate e<) end) | ||||||
|  | |||||||
| @ -14,6 +14,8 @@ import qualified Data.Map as Map | |||||||
| 
 | 
 | ||||||
| type SmartDate = (String,String,String) | type SmartDate = (String,String,String) | ||||||
| 
 | 
 | ||||||
|  | data DateSpan = DateSpan (Maybe Day) (Maybe Day) | ||||||
|  | 
 | ||||||
| type AccountName = String | type AccountName = String | ||||||
| 
 | 
 | ||||||
| data Side = L | R deriving (Eq,Show,Ord)  | data Side = L | R deriving (Eq,Show,Ord)  | ||||||
|  | |||||||
| @ -124,6 +124,8 @@ tildeExpand ('~':'/':xs) = getHomeDirectory >>= return . (++ ('/':xs)) | |||||||
| --                                return (homeDirectory pw ++ path) | --                                return (homeDirectory pw ++ path) | ||||||
| tildeExpand xs           =  return xs | tildeExpand xs           =  return xs | ||||||
| 
 | 
 | ||||||
|  | dateSpanFromOpts opts = DateSpan (beginDateFromOpts opts) (endDateFromOpts opts) | ||||||
|  | 
 | ||||||
| -- | Get the value of the begin date option, if any. | -- | Get the value of the begin date option, if any. | ||||||
| beginDateFromOpts :: [Opt] -> Maybe Day | beginDateFromOpts :: [Opt] -> Maybe Day | ||||||
| beginDateFromOpts opts = | beginDateFromOpts opts = | ||||||
|  | |||||||
							
								
								
									
										2
									
								
								Tests.hs
									
									
									
									
									
								
							
							
						
						
									
										2
									
								
								Tests.hs
									
									
									
									
									
								
							| @ -284,7 +284,7 @@ balancecommand_tests = TestList [ | |||||||
|  , |  , | ||||||
|   "balance report with cost basis" ~: do |   "balance report with cost basis" ~: do | ||||||
|     let l = cacheLedger [] $  |     let l = cacheLedger [] $  | ||||||
|             filterRawLedger Nothing Nothing [] False False $  |             filterRawLedger (DateSpan Nothing Nothing) [] False False $  | ||||||
|             canonicaliseAmounts True $ -- enable cost basis adjustment |             canonicaliseAmounts True $ -- enable cost basis adjustment | ||||||
|             rawledgerfromstring |             rawledgerfromstring | ||||||
|              ("" ++ |              ("" ++ | ||||||
|  | |||||||
							
								
								
									
										6
									
								
								Utils.hs
									
									
									
									
									
								
							
							
						
						
									
										6
									
								
								Utils.hs
									
									
									
									
									
								
							| @ -19,7 +19,7 @@ rawledgerfromstring = fromparse . parsewith ledgerfile | |||||||
| -- | Get a filtered and cached Ledger from the given string, or raise an error. | -- | Get a filtered and cached Ledger from the given string, or raise an error. | ||||||
| ledgerfromstring :: [String] -> String -> Ledger | ledgerfromstring :: [String] -> String -> Ledger | ||||||
| ledgerfromstring args s = | ledgerfromstring args s = | ||||||
|   cacheLedger apats $ filterRawLedger Nothing Nothing dpats False False l |   cacheLedger apats $ filterRawLedger (DateSpan Nothing Nothing) dpats False False l | ||||||
|       where |       where | ||||||
|         (apats,dpats) = parseAccountDescriptionArgs [] args |         (apats,dpats) = parseAccountDescriptionArgs [] args | ||||||
|         l = rawledgerfromstring s |         l = rawledgerfromstring s | ||||||
| @ -35,7 +35,7 @@ rawledgerfromfile f = do | |||||||
| ledgerfromfile :: [String] -> FilePath -> IO Ledger | ledgerfromfile :: [String] -> FilePath -> IO Ledger | ||||||
| ledgerfromfile args f = do | ledgerfromfile args f = do | ||||||
|   l  <- rawledgerfromfile f |   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 |       where | ||||||
|         (apats,dpats) = parseAccountDescriptionArgs [] args |         (apats,dpats) = parseAccountDescriptionArgs [] args | ||||||
|             |             | ||||||
| @ -51,7 +51,7 @@ myrawledger = do | |||||||
| myledger :: IO Ledger | myledger :: IO Ledger | ||||||
| myledger = do | myledger = do | ||||||
|   l <- myrawledger |   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. | -- | Get a named account from your ledger file. | ||||||
| myaccount :: AccountName -> IO Account | myaccount :: AccountName -> IO Account | ||||||
|  | |||||||
| @ -71,10 +71,9 @@ parseLedgerAndDo :: [Opt] -> [String] -> ([Opt] -> [String] -> Ledger -> IO ()) | |||||||
| parseLedgerAndDo opts args cmd = do | parseLedgerAndDo opts args cmd = do | ||||||
|   ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either printParseError runcmd |   ledgerFilePathFromOpts opts >>= parseLedgerFile >>= either printParseError runcmd | ||||||
|     where |     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 |       (apats,dpats) = parseAccountDescriptionArgs opts args | ||||||
|       b = beginDateFromOpts opts |       span = dateSpanFromOpts opts | ||||||
|       e = endDateFromOpts opts |  | ||||||
|       c = Cleared `elem` opts |       c = Cleared `elem` opts | ||||||
|       r = Real `elem` opts |       r = Real `elem` opts | ||||||
|       costbasis = CostBasis `elem` opts |       costbasis = CostBasis `elem` opts | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user