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