more cleanup, move journal text into Journal
This commit is contained in:
		
							parent
							
								
									4d5d9214b1
								
							
						
					
					
						commit
						50200e38ed
					
				| @ -145,9 +145,9 @@ appendToLedgerFile l s = | |||||||
|     else appendFile f $ sep++s |     else appendFile f $ sep++s | ||||||
|     where  |     where  | ||||||
|       f = filepath $ journal l |       f = filepath $ journal l | ||||||
|       -- we keep looking at the original raw text from when the ledger |       -- XXX we are looking at the original raw text from when the ledger | ||||||
|       -- was first read, but that's good enough for now |       -- was first read, but that's good enough for now | ||||||
|       t = journaltext l |       t = jtext $ journal l | ||||||
|       sep | null $ strip t = "" |       sep | null $ strip t = "" | ||||||
|           | otherwise = replicate (2 - min 2 (length lastnls)) '\n' |           | otherwise = replicate (2 - min 2 (length lastnls)) '\n' | ||||||
|           where lastnls = takeWhile (=='\n') $ reverse t |           where lastnls = takeWhile (=='\n') $ reverse t | ||||||
|  | |||||||
| @ -110,7 +110,7 @@ reloadIfChanged opts _ l = do | |||||||
|    else return l |    else return l | ||||||
| 
 | 
 | ||||||
| -- refilter :: [Opt] -> [String] -> Ledger -> LocalTime -> IO Ledger | -- refilter :: [Opt] -> [String] -> Ledger -> LocalTime -> IO Ledger | ||||||
| -- refilter opts args l t = return $ filterAndCacheLedgerWithOpts opts args t (journaltext l) (journal l) | -- refilter opts args l t = return $ filterAndCacheLedgerWithOpts opts args t (jtext $ journal l) (journal l) | ||||||
| 
 | 
 | ||||||
| server :: [Opt] -> [String] -> Ledger -> IO () | server :: [Opt] -> [String] -> Ledger -> IO () | ||||||
| server opts args l = | server opts args l = | ||||||
|  | |||||||
							
								
								
									
										13
									
								
								Ledger/IO.hs
									
									
									
									
									
								
							
							
						
						
									
										13
									
								
								Ledger/IO.hs
									
									
									
									
									
								
							| @ -64,7 +64,7 @@ readLedger f = do | |||||||
|   t <- getClockTime |   t <- getClockTime | ||||||
|   s <- readFile f |   s <- readFile f | ||||||
|   j <- journalFromString s |   j <- journalFromString s | ||||||
|   return $ cacheLedger' $ nullledger{journaltext=s,journal=j{filepath=f,filereadtime=t}} |   return $ cacheLedger' $ nullledger{journal=j{filepath=f,filereadtime=t,jtext=s}} | ||||||
| 
 | 
 | ||||||
| -- -- | Read a ledger from this file, filtering according to the filter spec., | -- -- | Read a ledger from this file, filtering according to the filter spec., | ||||||
| -- -- | or give an error. | -- -- | or give an error. | ||||||
| @ -82,17 +82,6 @@ journalFromString s = do | |||||||
|   t <- getCurrentLocalTime |   t <- getCurrentLocalTime | ||||||
|   liftM (either error id) $ runErrorT $ parseLedger t "(string)" s |   liftM (either error id) $ runErrorT $ parseLedger t "(string)" s | ||||||
| 
 | 
 | ||||||
| -- -- | Convert a Journal to a canonicalised, cached and filtered Ledger. |  | ||||||
| -- filterAndCacheLedger :: FilterSpec -> String -> Journal -> Ledger |  | ||||||
| -- filterAndCacheLedger _ -- filterspec |  | ||||||
| --                      rawtext |  | ||||||
| --                      j = |  | ||||||
| --     (cacheLedger $ |  | ||||||
| --     -- journalSelectingDate whichdate $ |  | ||||||
| --      j |  | ||||||
| -- --    filterJournalPostings filterspec $ filterJournalTransactions filterspec j |  | ||||||
| --     ){journaltext=rawtext} |  | ||||||
| 
 |  | ||||||
| -- -- | Expand ~ in a file path (does not handle ~name). | -- -- | Expand ~ in a file path (does not handle ~name). | ||||||
| -- tildeExpand :: FilePath -> IO FilePath | -- tildeExpand :: FilePath -> IO FilePath | ||||||
| -- tildeExpand ('~':[])     = getHomeDirectory | -- tildeExpand ('~':[])     = getHomeDirectory | ||||||
|  | |||||||
| @ -39,6 +39,7 @@ nulljournal = Journal { jmodifiertxns = [] | |||||||
|                       , final_comment_lines = [] |                       , final_comment_lines = [] | ||||||
|                       , filepath = "" |                       , filepath = "" | ||||||
|                       , filereadtime = TOD 0 0 |                       , filereadtime = TOD 0 0 | ||||||
|  |                       , jtext = "" | ||||||
|                       } |                       } | ||||||
| 
 | 
 | ||||||
| addTransaction :: Transaction -> Journal -> Journal | addTransaction :: Transaction -> Journal -> Journal | ||||||
| @ -116,25 +117,22 @@ filterJournalPostings FilterSpec{datespan=datespan | |||||||
| 
 | 
 | ||||||
| -- | Keep only ledger transactions whose description matches the description patterns. | -- | Keep only ledger transactions whose description matches the description patterns. | ||||||
| filterJournalTransactionsByDescription :: [String] -> Journal -> Journal | filterJournalTransactionsByDescription :: [String] -> Journal -> Journal | ||||||
| filterJournalTransactionsByDescription pats (Journal ms ps ts tls hs f fp ft) = | filterJournalTransactionsByDescription pats j@Journal{jtxns=ts} = j{jtxns=filter matchdesc ts} | ||||||
|     Journal ms ps (filter matchdesc ts) tls hs f fp ft |  | ||||||
|     where matchdesc = matchpats pats . tdescription |     where matchdesc = matchpats pats . tdescription | ||||||
| 
 | 
 | ||||||
| -- | Keep only ledger transactions which fall between begin and end dates. | -- | Keep only ledger transactions which fall between begin and end dates. | ||||||
| -- We include transactions on the begin date and exclude transactions on the end | -- We include transactions on the begin date and exclude transactions on the end | ||||||
| -- date, like ledger.  An empty date string means no restriction. | -- date, like ledger.  An empty date string means no restriction. | ||||||
| filterJournalTransactionsByDate :: DateSpan -> Journal -> Journal | filterJournalTransactionsByDate :: DateSpan -> Journal -> Journal | ||||||
| filterJournalTransactionsByDate (DateSpan begin end) (Journal ms ps ts tls hs f fp ft) = | filterJournalTransactionsByDate (DateSpan begin end) j@Journal{jtxns=ts} = j{jtxns=filter match ts} | ||||||
|     Journal ms ps (filter matchdate ts) tls hs f fp ft |     where match t = maybe True (tdate t>=) begin && maybe True (tdate t<) end | ||||||
|     where |  | ||||||
|       matchdate t = maybe True (tdate t>=) begin && maybe True (tdate t<) end |  | ||||||
| 
 | 
 | ||||||
| -- | Keep only ledger transactions which have the requested | -- | Keep only ledger transactions which have the requested | ||||||
| -- cleared/uncleared status, if there is one. | -- cleared/uncleared status, if there is one. | ||||||
| filterJournalTransactionsByClearedStatus :: Maybe Bool -> Journal -> Journal | filterJournalTransactionsByClearedStatus :: Maybe Bool -> Journal -> Journal | ||||||
| filterJournalTransactionsByClearedStatus Nothing j = j | filterJournalTransactionsByClearedStatus Nothing j = j | ||||||
| filterJournalTransactionsByClearedStatus (Just val) (Journal ms ps ts tls hs f fp ft) = | filterJournalTransactionsByClearedStatus (Just val) j@Journal{jtxns=ts} = j{jtxns=filter match ts} | ||||||
|     Journal ms ps (filter ((==val).tstatus) ts) tls hs f fp ft |     where match = (==val).tstatus | ||||||
| 
 | 
 | ||||||
| -- | Keep only postings which have the requested cleared/uncleared status, | -- | Keep only postings which have the requested cleared/uncleared status, | ||||||
| -- if there is one. | -- if there is one. | ||||||
| @ -147,15 +145,13 @@ filterJournalPostingsByClearedStatus (Just c) j@Journal{jtxns=ts} = j{jtxns=map | |||||||
| -- no filtering. | -- no filtering. | ||||||
| filterJournalPostingsByRealness :: Bool -> Journal -> Journal | filterJournalPostingsByRealness :: Bool -> Journal -> Journal | ||||||
| filterJournalPostingsByRealness False l = l | filterJournalPostingsByRealness False l = l | ||||||
| filterJournalPostingsByRealness True (Journal mts pts ts tls hs f fp ft) = | filterJournalPostingsByRealness True j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts} | ||||||
|     Journal mts pts (map filterpostings ts) tls hs f fp ft |  | ||||||
|     where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter isReal ps} |     where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter isReal ps} | ||||||
| 
 | 
 | ||||||
| -- | Strip out any postings with zero amount, unless the flag is true. | -- | Strip out any postings with zero amount, unless the flag is true. | ||||||
| filterJournalPostingsByEmpty :: Bool -> Journal -> Journal | filterJournalPostingsByEmpty :: Bool -> Journal -> Journal | ||||||
| filterJournalPostingsByEmpty True l = l | filterJournalPostingsByEmpty True l = l | ||||||
| filterJournalPostingsByEmpty False (Journal mts pts ts tls hs f fp ft) = | filterJournalPostingsByEmpty False j@Journal{jtxns=ts} = j{jtxns=map filterpostings ts} | ||||||
|     Journal mts pts (map filterpostings ts) tls hs f fp ft |  | ||||||
|     where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter (not . isEmptyPosting) ps} |     where filterpostings t@Transaction{tpostings=ps} = t{tpostings=filter (not . isEmptyPosting) ps} | ||||||
| 
 | 
 | ||||||
| -- | Keep only transactions which affect accounts deeper than the specified depth. | -- | Keep only transactions which affect accounts deeper than the specified depth. | ||||||
| @ -168,15 +164,15 @@ filterJournalTransactionsByDepth (Just d) j@Journal{jtxns=ts} = | |||||||
| -- (and any ledger transactions which have no postings as a result). | -- (and any ledger transactions which have no postings as a result). | ||||||
| filterJournalPostingsByDepth :: Maybe Int -> Journal -> Journal | filterJournalPostingsByDepth :: Maybe Int -> Journal -> Journal | ||||||
| filterJournalPostingsByDepth Nothing j = j | filterJournalPostingsByDepth Nothing j = j | ||||||
| filterJournalPostingsByDepth (Just d) (Journal mts pts ts tls hs f fp ft) = | filterJournalPostingsByDepth (Just d) j@Journal{jtxns=ts} = | ||||||
|     Journal mts pts (filter (not . null . tpostings) $ map filtertxns ts) tls hs f fp ft |     j{jtxns=filter (not . null . tpostings) $ map filtertxns ts} | ||||||
|     where filtertxns t@Transaction{tpostings=ps} = |     where filtertxns t@Transaction{tpostings=ps} = | ||||||
|               t{tpostings=filter ((<= d) . accountNameLevel . paccount) ps} |               t{tpostings=filter ((<= d) . accountNameLevel . paccount) ps} | ||||||
| 
 | 
 | ||||||
| -- | Keep only transactions which affect accounts matched by the account patterns. | -- | Keep only transactions which affect accounts matched by the account patterns. | ||||||
| filterJournalTransactionsByAccount :: [String] -> Journal -> Journal | filterJournalTransactionsByAccount :: [String] -> Journal -> Journal | ||||||
| filterJournalTransactionsByAccount apats (Journal ms ps ts tls hs f fp ft) = | filterJournalTransactionsByAccount apats j@Journal{jtxns=ts} = j{jtxns=filter match ts} | ||||||
|     Journal ms ps (filter (any (matchpats apats . paccount) . tpostings) ts) tls hs f fp ft |     where match = any (matchpats apats . paccount) . tpostings | ||||||
| 
 | 
 | ||||||
| -- | Keep only postings which affect accounts matched by the account patterns. | -- | Keep only postings which affect accounts matched by the account patterns. | ||||||
| -- This can leave transactions unbalanced. | -- This can leave transactions unbalanced. | ||||||
| @ -198,7 +194,7 @@ journalSelectingDate EffectiveDate j = | |||||||
| -- Also, amounts are converted to cost basis if that flag is active. | -- Also, amounts are converted to cost basis if that flag is active. | ||||||
| -- XXX refactor | -- XXX refactor | ||||||
| canonicaliseAmounts :: Bool -> Journal -> Journal | canonicaliseAmounts :: Bool -> Journal -> Journal | ||||||
| canonicaliseAmounts costbasis j@(Journal ms ps ts tls hs f fp ft) = Journal ms ps (map fixledgertransaction ts) tls hs f fp ft | canonicaliseAmounts costbasis j@Journal{jtxns=ts} = j{jtxns=map fixledgertransaction ts} | ||||||
|     where |     where | ||||||
|       fixledgertransaction (Transaction d ed s c de co ts pr) = Transaction d ed s c de co (map fixrawposting ts) pr |       fixledgertransaction (Transaction d ed s c de co ts pr) = Transaction d ed s c de co (map fixrawposting ts) pr | ||||||
|           where |           where | ||||||
|  | |||||||
| @ -73,7 +73,6 @@ instance Show Ledger where | |||||||
| 
 | 
 | ||||||
| nullledger :: Ledger | nullledger :: Ledger | ||||||
| nullledger = Ledger{ | nullledger = Ledger{ | ||||||
|       journaltext = "", |  | ||||||
|       journal = nulljournal, |       journal = nulljournal, | ||||||
|       accountnametree = nullaccountnametree, |       accountnametree = nullaccountnametree, | ||||||
|       accountmap = fromList [] |       accountmap = fromList [] | ||||||
|  | |||||||
| @ -121,7 +121,8 @@ data Journal = Journal { | |||||||
|       historical_prices :: [HistoricalPrice], |       historical_prices :: [HistoricalPrice], | ||||||
|       final_comment_lines :: String, |       final_comment_lines :: String, | ||||||
|       filepath :: FilePath, |       filepath :: FilePath, | ||||||
|       filereadtime :: ClockTime |       filereadtime :: ClockTime, | ||||||
|  |       jtext :: String | ||||||
|     } deriving (Eq) |     } deriving (Eq) | ||||||
| 
 | 
 | ||||||
| data Account = Account { | data Account = Account { | ||||||
| @ -131,7 +132,6 @@ data Account = Account { | |||||||
|     } |     } | ||||||
| 
 | 
 | ||||||
| data Ledger = Ledger { | data Ledger = Ledger { | ||||||
|       journaltext :: String, |  | ||||||
|       journal :: Journal, |       journal :: Journal, | ||||||
|       accountnametree :: Tree AccountName, |       accountnametree :: Tree AccountName, | ||||||
|       accountmap :: Map.Map AccountName Account |       accountmap :: Map.Map AccountName Account | ||||||
|  | |||||||
							
								
								
									
										2
									
								
								Tests.hs
									
									
									
									
									
								
							
							
						
						
									
										2
									
								
								Tests.hs
									
									
									
									
									
								
							| @ -1240,6 +1240,7 @@ journal7 = Journal | |||||||
|           "" |           "" | ||||||
|           "" |           "" | ||||||
|           (TOD 0 0) |           (TOD 0 0) | ||||||
|  |           "" | ||||||
| 
 | 
 | ||||||
| ledger7 = cacheLedger journal7 | ledger7 = cacheLedger journal7 | ||||||
| 
 | 
 | ||||||
| @ -1274,5 +1275,6 @@ journalWithAmounts as = | |||||||
|         "" |         "" | ||||||
|         "" |         "" | ||||||
|         (TOD 0 0) |         (TOD 0 0) | ||||||
|  |         "" | ||||||
|     where parse = fromparse . parseWithCtx emptyCtx postingamount . (" "++) |     where parse = fromparse . parseWithCtx emptyCtx postingamount . (" "++) | ||||||
| 
 | 
 | ||||||
|  | |||||||
							
								
								
									
										4
									
								
								Utils.hs
									
									
									
									
									
								
							
							
						
						
									
										4
									
								
								Utils.hs
									
									
									
									
									
								
							| @ -42,8 +42,8 @@ withLedgerDo opts args cmdname cmd = do | |||||||
|     where parseerror e = hPutStrLn stderr e >> exitWith (ExitFailure 1) |     where parseerror e = hPutStrLn stderr e >> exitWith (ExitFailure 1) | ||||||
| 
 | 
 | ||||||
| mkLedger :: [Opt] -> FilePath -> ClockTime -> String -> Journal -> Ledger | mkLedger :: [Opt] -> FilePath -> ClockTime -> String -> Journal -> Ledger | ||||||
| mkLedger opts f tc txt j = nullledger{journaltext=txt,journal=j'} | mkLedger opts f tc txt j = nullledger{journal=j'} | ||||||
|     where j' = (canonicaliseAmounts costbasis j){filepath=f,filereadtime=tc} |     where j' = (canonicaliseAmounts costbasis j){filepath=f,filereadtime=tc,jtext=txt} | ||||||
|           costbasis=CostBasis `elem` opts |           costbasis=CostBasis `elem` opts | ||||||
| 
 | 
 | ||||||
| -- | Get a Ledger from the given string and options, or raise an error. | -- | Get a Ledger from the given string and options, or raise an error. | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user