refactor: clarify ledger construction a bit
This commit is contained in:
parent
9261071987
commit
5982460782
@ -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' = cacheLedger'' filterspec l
|
l' = filterLedger 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 (cacheLedger' l) today
|
putStr $ showStats opts args (filterLedger nullfilterspec l) today
|
||||||
|
|
||||||
showStats :: [Opt] -> [String] -> Ledger -> Day -> String
|
showStats :: [Opt] -> [String] -> Ledger -> Day -> String
|
||||||
showStats _ _ l today =
|
showStats _ _ l today =
|
||||||
|
|||||||
@ -283,8 +283,8 @@ tests = TestList [
|
|||||||
Right e' -> (pamount $ last $ tpostings e')
|
Right e' -> (pamount $ last $ tpostings e')
|
||||||
Left _ -> error "should not happen")
|
Left _ -> error "should not happen")
|
||||||
|
|
||||||
,"cacheLedger" ~:
|
-- ,"cacheLedger" ~:
|
||||||
length (Map.keys $ accountmap $ cacheLedger journal7) `is` 15
|
-- length (Map.keys $ accountmap $ cacheLedger journal7) `is` 15
|
||||||
|
|
||||||
,"canonicaliseAmounts" ~:
|
,"canonicaliseAmounts" ~:
|
||||||
"use the greatest precision" ~:
|
"use the greatest precision" ~:
|
||||||
@ -657,7 +657,7 @@ tests = TestList [
|
|||||||
-- "next january" `gives` "2009/01/01"
|
-- "next january" `gives` "2009/01/01"
|
||||||
|
|
||||||
,"subAccounts" ~: do
|
,"subAccounts" ~: do
|
||||||
l <- liftM cacheLedger' sampleledger
|
l <- liftM (filterLedger 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 = cacheLedger journal7
|
ledger7 = makeLedger journal7
|
||||||
|
|
||||||
ledger8_str = unlines
|
ledger8_str = unlines
|
||||||
["2008/1/1 test "
|
["2008/1/1 test "
|
||||||
|
|||||||
@ -40,14 +40,15 @@ withLedgerDo opts args cmdname cmd = do
|
|||||||
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 . mkLedger opts f tc txt
|
let runcmd = cmd opts args . makeUncachedLedgerWithOpts opts 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)
|
||||||
|
|
||||||
mkLedger :: [Opt] -> FilePath -> ClockTime -> String -> Journal -> Ledger
|
makeUncachedLedgerWithOpts :: [Opt] -> FilePath -> ClockTime -> String -> Journal -> UncachedLedger
|
||||||
mkLedger opts f tc txt j = nullledger{journal=j'}
|
makeUncachedLedgerWithOpts opts f tc txt j = nullledger{journal=j'}
|
||||||
where j' = (canonicaliseAmounts costbasis j){filepath=f,filereadtime=tc,jtext=txt}
|
where j' = (canonicaliseAmounts costbasis j){filepath=f,filereadtime=tc,jtext=txt}
|
||||||
costbasis=CostBasis `elem` opts
|
costbasis=CostBasis `elem` opts
|
||||||
|
|
||||||
@ -56,7 +57,7 @@ ledgerFromStringWithOpts :: [Opt] -> String -> IO Ledger
|
|||||||
ledgerFromStringWithOpts opts s = do
|
ledgerFromStringWithOpts opts s = do
|
||||||
tc <- getClockTime
|
tc <- getClockTime
|
||||||
j <- journalFromString s
|
j <- journalFromString s
|
||||||
return $ mkLedger opts "" tc s j
|
return $ makeUncachedLedgerWithOpts opts "" 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
|
||||||
|
|||||||
@ -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 (cacheLedger', nullledger)
|
import Hledger.Data.Ledger (makeLedger)
|
||||||
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)
|
||||||
@ -68,7 +68,7 @@ readLedger f = do
|
|||||||
t <- getClockTime
|
t <- getClockTime
|
||||||
s <- readFile f
|
s <- readFile f
|
||||||
j <- journalFromString s
|
j <- journalFromString s
|
||||||
return $ cacheLedger' $ nullledger{journal=j{filepath=f,filereadtime=t,jtext=s}}
|
return $ makeLedger 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.
|
||||||
@ -76,8 +76,8 @@ readLedger f = do
|
|||||||
-- readLedgerWithFilterSpec fspec f = do
|
-- readLedgerWithFilterSpec fspec f = do
|
||||||
-- s <- readFile f
|
-- s <- readFile f
|
||||||
-- t <- getClockTime
|
-- t <- getClockTime
|
||||||
-- rl <- journalFromString s
|
-- j <- journalFromString s
|
||||||
-- return $ filterAndCacheLedger fspec s rl{filepath=f, filereadtime=t}
|
-- return $ filterLedger 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.
|
||||||
|
|||||||
@ -78,22 +78,15 @@ nullledger = Ledger{
|
|||||||
}
|
}
|
||||||
|
|
||||||
-- | Convert a journal to a more efficient cached ledger, described above.
|
-- | Convert a journal to a more efficient cached ledger, described above.
|
||||||
cacheLedger :: Journal -> Ledger
|
makeLedger :: Journal -> Ledger
|
||||||
cacheLedger j = nullledger{journal=j,accountnametree=ant,accountmap=amap}
|
makeLedger j = nullledger{journal=j,accountnametree=ant,accountmap=amap} where (ant, amap) = crunchJournal j
|
||||||
where (ant, amap) = crunchJournal j
|
|
||||||
|
|
||||||
-- | Add (or recalculate) the cached journal info in a ledger.
|
-- | Filter and re-cache a ledger.
|
||||||
cacheLedger' :: Ledger -> CachedLedger
|
filterLedger :: FilterSpec -> Ledger -> Ledger
|
||||||
cacheLedger' l = l{accountnametree=ant,accountmap=amap}
|
filterLedger filterspec l@Ledger{journal=j} = l{journal=j',accountnametree=ant,accountmap=amap}
|
||||||
where (ant, amap) = crunchJournal $ journal l
|
|
||||||
|
|
||||||
-- | Like cacheLedger, but filtering the journal first.
|
|
||||||
cacheLedger'' 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
|
||||||
|
|
||||||
type CachedLedger = Ledger
|
|
||||||
|
|
||||||
-- | List a ledger's account names.
|
-- | List a ledger's account names.
|
||||||
ledgerAccountNames :: Ledger -> [AccountName]
|
ledgerAccountNames :: Ledger -> [AccountName]
|
||||||
ledgerAccountNames = drop 1 . flatten . accountnametree
|
ledgerAccountNames = drop 1 . flatten . accountnametree
|
||||||
|
|||||||
@ -137,6 +137,10 @@ data Ledger = Ledger {
|
|||||||
accountmap :: Map.Map AccountName Account
|
accountmap :: Map.Map AccountName Account
|
||||||
} deriving Typeable
|
} deriving Typeable
|
||||||
|
|
||||||
|
-- | An incomplete ledger, containing just the journal. Currently just a
|
||||||
|
-- visual indicator used in a few places.
|
||||||
|
type UncachedLedger = Ledger
|
||||||
|
|
||||||
-- | A generic, pure specification of how to filter transactions/postings.
|
-- | A generic, pure specification of how to filter transactions/postings.
|
||||||
-- This exists to keep app-specific options out of the hledger library.
|
-- This exists to keep app-specific options out of the hledger library.
|
||||||
data FilterSpec = FilterSpec {
|
data FilterSpec = FilterSpec {
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user