refactor: more ledger cleanup
This commit is contained in:
		
							parent
							
								
									5982460782
								
							
						
					
					
						commit
						a3e5e7ce93
					
				| @ -120,7 +120,7 @@ balance opts args l = do | ||||
| showBalanceReport :: [Opt] -> FilterSpec -> Ledger -> String | ||||
| showBalanceReport opts filterspec l = acctsstr ++ totalstr | ||||
|     where | ||||
|       l' = filterLedger filterspec l | ||||
|       l' = filterAndCacheLedger filterspec l | ||||
|       acctsstr = unlines $ map showacct interestingaccts | ||||
|           where | ||||
|             showacct = showInterestingAccount l' interestingaccts | ||||
|  | ||||
| @ -19,7 +19,7 @@ import System.IO.UTF8 | ||||
| stats :: [Opt] -> [String] -> Ledger -> IO () | ||||
| stats opts args l = do | ||||
|   today <- getCurrentDay | ||||
|   putStr $ showStats opts args (filterLedger nullfilterspec l) today | ||||
|   putStr $ showStats opts args (filterAndCacheLedger nullfilterspec l) today | ||||
| 
 | ||||
| showStats :: [Opt] -> [String] -> Ledger -> Day -> String | ||||
| showStats _ _ l today = | ||||
|  | ||||
| @ -657,7 +657,7 @@ tests = TestList [ | ||||
| --     "next january" `gives` "2009/01/01" | ||||
| 
 | ||||
|   ,"subAccounts" ~: do | ||||
|     l <- liftM (filterLedger nullfilterspec) sampleledger | ||||
|     l <- liftM (filterAndCacheLedger nullfilterspec) sampleledger | ||||
|     let a = ledgerAccount l "assets" | ||||
|     map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"] | ||||
| 
 | ||||
| @ -1078,7 +1078,7 @@ journal7 = Journal | ||||
|           (TOD 0 0) | ||||
|           "" | ||||
| 
 | ||||
| ledger7 = makeLedger journal7 | ||||
| ledger7 = filterAndCacheLedger nullfilterspec $ makeUncachedLedger False "" (TOD 0 0) "" journal7 | ||||
| 
 | ||||
| ledger8_str = unlines | ||||
|  ["2008/1/1 test           " | ||||
|  | ||||
| @ -21,14 +21,14 @@ import System.IO (hPutStrLn) | ||||
| import System.Exit | ||||
| import System.Process (readProcessWithExitCode) | ||||
| import System.Info (os) | ||||
| import System.Time (ClockTime,getClockTime) | ||||
| import System.Time (getClockTime) | ||||
| 
 | ||||
| 
 | ||||
| -- | Parse the user's specified ledger file and run a hledger command on | ||||
| -- it, or report a parse error. This function makes the whole thing go. | ||||
| -- Warning, this provides only an uncached Ledger (no accountnametree or | ||||
| -- accountmap), so cmd must cacheLedger'/crunchJournal if needed. | ||||
| withLedgerDo :: [Opt] -> [String] -> String -> ([Opt] -> [String] -> Ledger -> IO ()) -> IO () | ||||
| -- Warning, this provides only an uncached/unfiltered ledger, so the | ||||
| -- command should do further processing if needed. | ||||
| withLedgerDo :: [Opt] -> [String] -> String -> ([Opt] -> [String] -> UncachedLedger -> IO ()) -> IO () | ||||
| withLedgerDo opts args cmdname cmd = do | ||||
|   -- We kludgily read the file before parsing to grab the full text, unless | ||||
|   -- it's stdin, or it doesn't exist and we are adding. We read it strictly | ||||
| @ -37,29 +37,25 @@ withLedgerDo opts args cmdname cmd = do | ||||
|   let f' = if f == "-" then "/dev/null" else f | ||||
|   fileexists <- doesFileExist f | ||||
|   let creating = not fileexists && cmdname == "add" | ||||
|       cb = CostBasis `elem` opts | ||||
|   t <- getCurrentLocalTime | ||||
|   tc <- getClockTime | ||||
|   txt <-  if creating then return "" else strictReadFile f' | ||||
|   let runcmd = cmd opts args . makeUncachedLedgerWithOpts opts f tc txt | ||||
|   -- (though commands receive an uncached ledger, their type signature is just "Ledger" for now) | ||||
|   let runcmd = cmd opts args . makeUncachedLedger cb f tc txt | ||||
|   if creating | ||||
|    then runcmd nulljournal | ||||
|    else (runErrorT . parseLedgerFile t) f >>= either parseerror runcmd | ||||
|     where parseerror e = hPutStrLn stderr e >> exitWith (ExitFailure 1) | ||||
| 
 | ||||
| makeUncachedLedgerWithOpts :: [Opt] -> FilePath -> ClockTime -> String -> Journal -> UncachedLedger | ||||
| makeUncachedLedgerWithOpts opts f tc txt j = nullledger{journal=j'} | ||||
|     where j' = (canonicaliseAmounts costbasis j){filepath=f,filereadtime=tc,jtext=txt} | ||||
|           costbasis=CostBasis `elem` opts | ||||
| 
 | ||||
| -- | Get a Ledger from the given string and options, or raise an error. | ||||
| ledgerFromStringWithOpts :: [Opt] -> String -> IO Ledger | ||||
| -- | Get an uncached ledger from the given string and options, or raise an error. | ||||
| ledgerFromStringWithOpts :: [Opt] -> String -> IO UncachedLedger | ||||
| ledgerFromStringWithOpts opts s = do | ||||
|     tc <- getClockTime | ||||
|     j <- journalFromString s | ||||
|     return $ makeUncachedLedgerWithOpts opts "" tc s j | ||||
|     let cb = CostBasis `elem` opts | ||||
|     return $ makeUncachedLedger cb "" tc s j | ||||
| 
 | ||||
| -- -- | Read a Ledger from the given file, or give an error. | ||||
| -- -- | Read a ledger from the given file, or give an error. | ||||
| -- readLedgerWithOpts :: [Opt] -> [String] -> FilePath -> IO Ledger | ||||
| -- readLedgerWithOpts opts args f = do | ||||
| --   t <- getCurrentLocalTime | ||||
|  | ||||
| @ -6,7 +6,7 @@ Utilities for doing I/O with ledger files. | ||||
| module Hledger.Data.IO | ||||
| where | ||||
| import Control.Monad.Error | ||||
| import Hledger.Data.Ledger (makeLedger) | ||||
| import Hledger.Data.Ledger (makeUncachedLedger) | ||||
| import Hledger.Data.Parse (parseLedger) | ||||
| import Hledger.Data.Types (FilterSpec(..),WhichDate(..),Journal(..),Ledger(..)) | ||||
| import Hledger.Data.Utils (getCurrentLocalTime) | ||||
| @ -62,13 +62,13 @@ myLedger = myLedgerPath >>= readLedger | ||||
| myTimelog :: IO Ledger | ||||
| myTimelog = myTimelogPath >>= readLedger | ||||
| 
 | ||||
| -- | Read a ledger from this file, with no filtering, or give an error. | ||||
| -- | Read an unfiltered, uncached ledger from this file, or give an error. | ||||
| readLedger :: FilePath -> IO Ledger | ||||
| readLedger f = do | ||||
|   t <- getClockTime | ||||
|   s <- readFile f | ||||
|   j <- journalFromString s | ||||
|   return $ makeLedger j{filepath=f,filereadtime=t,jtext=s} | ||||
|   return $ makeUncachedLedger False f t s j | ||||
| 
 | ||||
| -- -- | Read a ledger from this file, filtering according to the filter spec., | ||||
| -- -- | or give an error. | ||||
| @ -77,7 +77,7 @@ readLedger f = do | ||||
| --   s <- readFile f | ||||
| --   t <- getClockTime | ||||
| --   j <- journalFromString s | ||||
| --   return $ filterLedger fspec s j{filepath=f, filereadtime=t} | ||||
| --   return $ filterAndCacheLedger fspec s j{filepath=f, filereadtime=t} | ||||
| 
 | ||||
| -- | Read a Journal from the given string, using the current time as | ||||
| -- reference time, or give a parse error. | ||||
|  | ||||
| @ -60,6 +60,7 @@ import Hledger.Data.Account (nullacct) | ||||
| import Hledger.Data.AccountName | ||||
| import Hledger.Data.Journal | ||||
| import Hledger.Data.Posting | ||||
| import System.Time (ClockTime) | ||||
| 
 | ||||
| 
 | ||||
| instance Show Ledger where | ||||
| @ -77,13 +78,15 @@ nullledger = Ledger{ | ||||
|       accountmap = fromList [] | ||||
|     } | ||||
| 
 | ||||
| -- | Convert a journal to a more efficient cached ledger, described above. | ||||
| makeLedger :: Journal -> Ledger | ||||
| makeLedger j = nullledger{journal=j,accountnametree=ant,accountmap=amap} where (ant, amap) = crunchJournal j | ||||
| -- | Generate a ledger, from a journal and related environmental | ||||
| -- information, with basic data cleanups, but don't cache it yet. | ||||
| makeUncachedLedger :: Bool -> FilePath -> ClockTime -> String -> Journal -> UncachedLedger | ||||
| makeUncachedLedger costbasis f t s j = | ||||
|     nullledger{journal=canonicaliseAmounts costbasis j{filepath=f,filereadtime=t,jtext=s}} | ||||
| 
 | ||||
| -- | Filter and re-cache a ledger. | ||||
| filterLedger :: FilterSpec -> Ledger -> Ledger | ||||
| filterLedger filterspec l@Ledger{journal=j} = l{journal=j',accountnametree=ant,accountmap=amap} | ||||
| -- | Filter a ledger's transactions according to the filter specification and generate derived data. | ||||
| filterAndCacheLedger :: FilterSpec -> UncachedLedger -> Ledger | ||||
| filterAndCacheLedger filterspec l@Ledger{journal=j} = l{journal=j',accountnametree=ant,accountmap=amap} | ||||
|     where (ant, amap) = crunchJournal j' | ||||
|           j' = filterJournalPostings filterspec{depth=Nothing} j | ||||
| 
 | ||||
|  | ||||
| @ -127,8 +127,8 @@ data Journal = Journal { | ||||
| 
 | ||||
| data Account = Account { | ||||
|       aname :: AccountName, | ||||
|       apostings :: [Posting],    -- ^ transactions in this account | ||||
|       abalance :: MixedAmount    -- ^ sum of transactions in this account and subaccounts | ||||
|       apostings :: [Posting],    -- ^ postings in this account | ||||
|       abalance :: MixedAmount    -- ^ sum of postings in this account and subaccounts | ||||
|     } | ||||
| 
 | ||||
| data Ledger = Ledger { | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user