mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-26 20:02:27 +03:00
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