mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 02:37:12 +03:00
rename RawLedger to Journal
This commit is contained in:
parent
83f9aa5693
commit
2e9b27da0d
@ -22,7 +22,7 @@ import Utils (ledgerFromStringWithOpts)
|
||||
-- command has no effect.
|
||||
add :: [Opt] -> [String] -> Ledger -> IO ()
|
||||
add _ args l
|
||||
| filepath (rawledger l) == "-" = return ()
|
||||
| filepath (journal l) == "-" = return ()
|
||||
| otherwise = do
|
||||
hPutStrLn stderr
|
||||
"Enter one or more transactions, which will be added to your ledger file.\n\
|
||||
@ -128,10 +128,10 @@ askFor prompt def validator = do
|
||||
addTransaction :: Ledger -> LedgerTransaction -> IO Ledger
|
||||
addTransaction l t = do
|
||||
appendToLedgerFile l $ show t
|
||||
putStrLn $ printf "\nAdded transaction to %s:" (filepath $ rawledger l)
|
||||
putStrLn $ printf "\nAdded transaction to %s:" (filepath $ journal l)
|
||||
putStrLn =<< registerFromString (show t)
|
||||
return l{rawledger=rl{ledger_txns=ts}}
|
||||
where rl = rawledger l
|
||||
return l{journal=rl{ledger_txns=ts}}
|
||||
where rl = journal l
|
||||
ts = ledger_txns rl ++ [t]
|
||||
|
||||
-- | Append data to the ledger's file, ensuring proper separation from any
|
||||
@ -142,10 +142,10 @@ appendToLedgerFile l s =
|
||||
then putStr $ sep ++ s
|
||||
else appendFile f $ sep++s
|
||||
where
|
||||
f = filepath $ rawledger l
|
||||
f = filepath $ journal l
|
||||
-- we keep looking at the original raw text from when the ledger
|
||||
-- was first read, but that's good enough for now
|
||||
t = rawledgertext l
|
||||
t = journaltext l
|
||||
sep | null $ strip t = ""
|
||||
| otherwise = replicate (2 - min 2 (length lastnls)) '\n'
|
||||
where lastnls = takeWhile (=='\n') $ reverse t
|
||||
@ -188,6 +188,6 @@ transactionsSimilarTo l s =
|
||||
[(compareLedgerDescriptions s $ ltdescription t, t) | t <- ts]
|
||||
where
|
||||
compareRelevanceAndRecency (n1,t1) (n2,t2) = compare (n2,ltdate t2) (n1,ltdate t1)
|
||||
ts = ledger_txns $ rawledger l
|
||||
ts = ledger_txns $ journal l
|
||||
threshold = 0
|
||||
|
||||
|
@ -25,7 +25,7 @@ showHistogram opts args l = concatMap (printDayWith countBar) daytxns
|
||||
i = intervalFromOpts opts
|
||||
interval | i == NoInterval = Daily
|
||||
| otherwise = i
|
||||
fullspan = rawLedgerDateSpan $ rawledger l
|
||||
fullspan = journalDateSpan $ journal l
|
||||
days = filter (DateSpan Nothing Nothing /=) $ splitSpan interval fullspan
|
||||
daytxns = [(s, filter (isTransactionInDateSpan s) ts) | s <- days]
|
||||
-- same as Register
|
||||
|
@ -21,9 +21,9 @@ showLedgerTransactions opts args l = concatMap (showLedgerTransactionForPrint ef
|
||||
where
|
||||
txns = sortBy (comparing ltdate) $
|
||||
ledger_txns $
|
||||
filterRawLedgerPostingsByDepth depth $
|
||||
filterRawLedgerTransactionsByAccount apats $
|
||||
rawledger l
|
||||
filterJournalPostingsByDepth depth $
|
||||
filterJournalTransactionsByAccount apats $
|
||||
journal l
|
||||
depth = depthFromOpts opts
|
||||
effective = Effective `elem` opts
|
||||
(apats,_) = parsePatternArgs args
|
||||
|
@ -27,7 +27,7 @@ showStats _ _ l today =
|
||||
w1 = maximum $ map (length . fst) stats
|
||||
w2 = maximum $ map (length . show . snd) stats
|
||||
stats = [
|
||||
("File", filepath $ rawledger l)
|
||||
("File", filepath $ journal l)
|
||||
,("Period", printf "%s to %s (%d days)" (start span) (end span) days)
|
||||
,("Transactions", printf "%d (%0.1f per day)" tnum txnrate)
|
||||
,("Transactions last 30 days", printf "%d (%0.1f per day)" tnum30 txnrate30)
|
||||
@ -43,7 +43,7 @@ showStats _ _ l today =
|
||||
-- Days since last transaction : %(recentelapsed)s
|
||||
]
|
||||
where
|
||||
ts = sortBy (comparing ltdate) $ ledger_txns $ rawledger l
|
||||
ts = sortBy (comparing ltdate) $ ledger_txns $ journal l
|
||||
lastdate | null ts = Nothing
|
||||
| otherwise = Just $ ltdate $ last ts
|
||||
lastelapsed = maybe Nothing (Just . diffDays today) lastdate
|
||||
|
@ -287,7 +287,7 @@ currentLedgerTransaction a@AppState{aledger=l,abuf=buf} = entryContainingTransac
|
||||
-- | Get the entry which contains the given transaction.
|
||||
-- Will raise an error if there are problems.
|
||||
entryContainingTransaction :: AppState -> Transaction -> LedgerTransaction
|
||||
entryContainingTransaction AppState{aledger=l} t = ledger_txns (rawledger l) !! tnum t
|
||||
entryContainingTransaction AppState{aledger=l} t = ledger_txns (journal l) !! tnum t
|
||||
|
||||
-- renderers
|
||||
|
||||
|
@ -80,14 +80,14 @@ ledgerFileModifiedTime :: Ledger -> IO ClockTime
|
||||
ledgerFileModifiedTime l
|
||||
| null path = getClockTime
|
||||
| otherwise = getModificationTime path `Prelude.catch` \_ -> getClockTime
|
||||
where path = filepath $ rawledger l
|
||||
where path = filepath $ journal l
|
||||
|
||||
ledgerFileReadTime :: Ledger -> ClockTime
|
||||
ledgerFileReadTime l = filereadtime $ rawledger l
|
||||
ledgerFileReadTime l = filereadtime $ journal l
|
||||
|
||||
reload :: Ledger -> IO Ledger
|
||||
reload l = do
|
||||
l' <- readLedgerWithOpts [] [] (filepath $ rawledger l)
|
||||
l' <- readLedgerWithOpts [] [] (filepath $ journal l)
|
||||
putValue "hledger" "ledger" l'
|
||||
return l'
|
||||
|
||||
@ -99,12 +99,12 @@ reloadIfChanged opts _ l = do
|
||||
-- when (Debug `elem` opts) $ printf "checking file, last modified %s, last read %s, %s\n" (show tmod) (show tread) (show newer)
|
||||
if newer
|
||||
then do
|
||||
when (Verbose `elem` opts) $ printf "%s has changed, reloading\n" (filepath $ rawledger l)
|
||||
when (Verbose `elem` opts) $ printf "%s has changed, reloading\n" (filepath $ journal l)
|
||||
reload l
|
||||
else return l
|
||||
|
||||
-- refilter :: [Opt] -> [String] -> Ledger -> LocalTime -> IO Ledger
|
||||
-- refilter opts args l t = return $ filterAndCacheLedgerWithOpts opts args t (rawledgertext l) (rawledger l)
|
||||
-- refilter opts args l t = return $ filterAndCacheLedgerWithOpts opts args t (journaltext l) (journal l)
|
||||
|
||||
server :: [Opt] -> [String] -> Ledger -> IO ()
|
||||
server opts args l =
|
||||
|
@ -16,7 +16,7 @@ module Ledger (
|
||||
module Ledger.LedgerTransaction,
|
||||
module Ledger.Ledger,
|
||||
module Ledger.Parse,
|
||||
module Ledger.RawLedger,
|
||||
module Ledger.Journal,
|
||||
module Ledger.Posting,
|
||||
module Ledger.TimeLog,
|
||||
module Ledger.Transaction,
|
||||
@ -33,7 +33,7 @@ import Ledger.IO
|
||||
import Ledger.LedgerTransaction
|
||||
import Ledger.Ledger
|
||||
import Ledger.Parse
|
||||
import Ledger.RawLedger
|
||||
import Ledger.Journal
|
||||
import Ledger.Posting
|
||||
import Ledger.TimeLog
|
||||
import Ledger.Transaction
|
||||
|
22
Ledger/IO.hs
22
Ledger/IO.hs
@ -7,8 +7,8 @@ where
|
||||
import Control.Monad.Error
|
||||
import Ledger.Ledger (cacheLedger)
|
||||
import Ledger.Parse (parseLedger)
|
||||
import Ledger.RawLedger (canonicaliseAmounts,filterRawLedger,rawLedgerSelectingDate)
|
||||
import Ledger.Types (FilterSpec(..),WhichDate(..),DateSpan(..),RawLedger(..),Ledger(..))
|
||||
import Ledger.Journal (canonicaliseAmounts,filterJournal,journalSelectingDate)
|
||||
import Ledger.Types (FilterSpec(..),WhichDate(..),DateSpan(..),Journal(..),Ledger(..))
|
||||
import Ledger.Utils (getCurrentLocalTime)
|
||||
import System.Directory (getHomeDirectory)
|
||||
import System.Environment (getEnv)
|
||||
@ -66,28 +66,28 @@ readLedgerWithFilterSpec :: FilterSpec -> FilePath -> IO Ledger
|
||||
readLedgerWithFilterSpec fspec f = do
|
||||
s <- readFile f
|
||||
t <- getClockTime
|
||||
rl <- rawLedgerFromString s
|
||||
rl <- journalFromString s
|
||||
return $ filterAndCacheLedger fspec s rl{filepath=f, filereadtime=t}
|
||||
|
||||
-- | Read a RawLedger 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.
|
||||
rawLedgerFromString :: String -> IO RawLedger
|
||||
rawLedgerFromString s = do
|
||||
journalFromString :: String -> IO Journal
|
||||
journalFromString s = do
|
||||
t <- getCurrentLocalTime
|
||||
liftM (either error id) $ runErrorT $ parseLedger t "(string)" s
|
||||
|
||||
-- | Convert a RawLedger to a canonicalised, cached and filtered Ledger.
|
||||
filterAndCacheLedger :: FilterSpec -> String -> RawLedger -> Ledger
|
||||
-- | Convert a Journal to a canonicalised, cached and filtered Ledger.
|
||||
filterAndCacheLedger :: FilterSpec -> String -> Journal -> Ledger
|
||||
filterAndCacheLedger (FilterSpec{datespan=datespan,cleared=cleared,real=real,
|
||||
costbasis=costbasis,acctpats=acctpats,
|
||||
descpats=descpats,whichdate=whichdate})
|
||||
rawtext
|
||||
rl =
|
||||
(cacheLedger acctpats
|
||||
$ filterRawLedger datespan descpats cleared real
|
||||
$ rawLedgerSelectingDate whichdate
|
||||
$ filterJournal datespan descpats cleared real
|
||||
$ journalSelectingDate whichdate
|
||||
$ canonicaliseAmounts costbasis rl
|
||||
){rawledgertext=rawtext}
|
||||
){journaltext=rawtext}
|
||||
|
||||
-- -- | Expand ~ in a file path (does not handle ~name).
|
||||
-- tildeExpand :: FilePath -> IO FilePath
|
||||
|
@ -1,11 +1,10 @@
|
||||
{-|
|
||||
|
||||
A 'RawLedger' is a parsed ledger file. We call it raw to distinguish from
|
||||
the cached 'Ledger'.
|
||||
A 'Journal' is a parsed ledger file.
|
||||
|
||||
-}
|
||||
|
||||
module Ledger.RawLedger
|
||||
module Ledger.Journal
|
||||
where
|
||||
import qualified Data.Map as Map
|
||||
import Data.Map (findWithDefault, (!))
|
||||
@ -20,18 +19,18 @@ import Ledger.Posting
|
||||
import Ledger.TimeLog
|
||||
|
||||
|
||||
instance Show RawLedger where
|
||||
show l = printf "RawLedger with %d transactions, %d accounts: %s"
|
||||
instance Show Journal where
|
||||
show l = printf "Journal with %d transactions, %d accounts: %s"
|
||||
(length (ledger_txns l) +
|
||||
length (modifier_txns l) +
|
||||
length (periodic_txns l))
|
||||
(length accounts)
|
||||
(show accounts)
|
||||
-- ++ (show $ rawLedgerTransactions l)
|
||||
where accounts = flatten $ rawLedgerAccountNameTree l
|
||||
-- ++ (show $ journalTransactions l)
|
||||
where accounts = flatten $ journalAccountNameTree l
|
||||
|
||||
rawLedgerEmpty :: RawLedger
|
||||
rawLedgerEmpty = RawLedger { modifier_txns = []
|
||||
journalEmpty :: Journal
|
||||
journalEmpty = Journal { modifier_txns = []
|
||||
, periodic_txns = []
|
||||
, ledger_txns = []
|
||||
, open_timelog_entries = []
|
||||
@ -41,92 +40,92 @@ rawLedgerEmpty = RawLedger { modifier_txns = []
|
||||
, filereadtime = TOD 0 0
|
||||
}
|
||||
|
||||
addLedgerTransaction :: LedgerTransaction -> RawLedger -> RawLedger
|
||||
addLedgerTransaction :: LedgerTransaction -> Journal -> Journal
|
||||
addLedgerTransaction t l0 = l0 { ledger_txns = t : ledger_txns l0 }
|
||||
|
||||
addModifierTransaction :: ModifierTransaction -> RawLedger -> RawLedger
|
||||
addModifierTransaction :: ModifierTransaction -> Journal -> Journal
|
||||
addModifierTransaction mt l0 = l0 { modifier_txns = mt : modifier_txns l0 }
|
||||
|
||||
addPeriodicTransaction :: PeriodicTransaction -> RawLedger -> RawLedger
|
||||
addPeriodicTransaction :: PeriodicTransaction -> Journal -> Journal
|
||||
addPeriodicTransaction pt l0 = l0 { periodic_txns = pt : periodic_txns l0 }
|
||||
|
||||
addHistoricalPrice :: HistoricalPrice -> RawLedger -> RawLedger
|
||||
addHistoricalPrice :: HistoricalPrice -> Journal -> Journal
|
||||
addHistoricalPrice h l0 = l0 { historical_prices = h : historical_prices l0 }
|
||||
|
||||
addTimeLogEntry :: TimeLogEntry -> RawLedger -> RawLedger
|
||||
addTimeLogEntry :: TimeLogEntry -> Journal -> Journal
|
||||
addTimeLogEntry tle l0 = l0 { open_timelog_entries = tle : open_timelog_entries l0 }
|
||||
|
||||
rawLedgerTransactions :: RawLedger -> [Transaction]
|
||||
rawLedgerTransactions = txnsof . ledger_txns
|
||||
journalTransactions :: Journal -> [Transaction]
|
||||
journalTransactions = txnsof . ledger_txns
|
||||
where txnsof ts = concatMap flattenLedgerTransaction $ zip ts [1..]
|
||||
|
||||
rawLedgerAccountNamesUsed :: RawLedger -> [AccountName]
|
||||
rawLedgerAccountNamesUsed = accountNamesFromTransactions . rawLedgerTransactions
|
||||
journalAccountNamesUsed :: Journal -> [AccountName]
|
||||
journalAccountNamesUsed = accountNamesFromTransactions . journalTransactions
|
||||
|
||||
rawLedgerAccountNames :: RawLedger -> [AccountName]
|
||||
rawLedgerAccountNames = sort . expandAccountNames . rawLedgerAccountNamesUsed
|
||||
journalAccountNames :: Journal -> [AccountName]
|
||||
journalAccountNames = sort . expandAccountNames . journalAccountNamesUsed
|
||||
|
||||
rawLedgerAccountNameTree :: RawLedger -> Tree AccountName
|
||||
rawLedgerAccountNameTree = accountNameTreeFrom . rawLedgerAccountNames
|
||||
journalAccountNameTree :: Journal -> Tree AccountName
|
||||
journalAccountNameTree = accountNameTreeFrom . journalAccountNames
|
||||
|
||||
-- | Remove ledger transactions we are not interested in.
|
||||
-- Keep only those which fall between the begin and end dates, and match
|
||||
-- the description pattern, and are cleared or real if those options are active.
|
||||
filterRawLedger :: DateSpan -> [String] -> Maybe Bool -> Bool -> RawLedger -> RawLedger
|
||||
filterRawLedger span pats clearedonly realonly =
|
||||
filterRawLedgerPostingsByRealness realonly .
|
||||
filterRawLedgerTransactionsByClearedStatus clearedonly .
|
||||
filterRawLedgerTransactionsByDate span .
|
||||
filterRawLedgerTransactionsByDescription pats
|
||||
filterJournal :: DateSpan -> [String] -> Maybe Bool -> Bool -> Journal -> Journal
|
||||
filterJournal span pats clearedonly realonly =
|
||||
filterJournalPostingsByRealness realonly .
|
||||
filterJournalTransactionsByClearedStatus clearedonly .
|
||||
filterJournalTransactionsByDate span .
|
||||
filterJournalTransactionsByDescription pats
|
||||
|
||||
-- | Keep only ledger transactions whose description matches the description patterns.
|
||||
filterRawLedgerTransactionsByDescription :: [String] -> RawLedger -> RawLedger
|
||||
filterRawLedgerTransactionsByDescription pats (RawLedger ms ps ts tls hs f fp ft) =
|
||||
RawLedger ms ps (filter matchdesc ts) tls hs f fp ft
|
||||
filterJournalTransactionsByDescription :: [String] -> Journal -> Journal
|
||||
filterJournalTransactionsByDescription pats (Journal ms ps ts tls hs f fp ft) =
|
||||
Journal ms ps (filter matchdesc ts) tls hs f fp ft
|
||||
where matchdesc = matchpats pats . ltdescription
|
||||
|
||||
-- | Keep only ledger transactions which fall between begin and end dates.
|
||||
-- We include transactions on the begin date and exclude transactions on the end
|
||||
-- date, like ledger. An empty date string means no restriction.
|
||||
filterRawLedgerTransactionsByDate :: DateSpan -> RawLedger -> RawLedger
|
||||
filterRawLedgerTransactionsByDate (DateSpan begin end) (RawLedger ms ps ts tls hs f fp ft) =
|
||||
RawLedger ms ps (filter matchdate ts) tls hs f fp ft
|
||||
filterJournalTransactionsByDate :: DateSpan -> Journal -> Journal
|
||||
filterJournalTransactionsByDate (DateSpan begin end) (Journal ms ps ts tls hs f fp ft) =
|
||||
Journal ms ps (filter matchdate ts) tls hs f fp ft
|
||||
where
|
||||
matchdate t = maybe True (ltdate t>=) begin && maybe True (ltdate t<) end
|
||||
|
||||
-- | Keep only ledger transactions which have the requested
|
||||
-- cleared/uncleared status, if there is one.
|
||||
filterRawLedgerTransactionsByClearedStatus :: Maybe Bool -> RawLedger -> RawLedger
|
||||
filterRawLedgerTransactionsByClearedStatus Nothing rl = rl
|
||||
filterRawLedgerTransactionsByClearedStatus (Just val) (RawLedger ms ps ts tls hs f fp ft) =
|
||||
RawLedger ms ps (filter ((==val).ltstatus) ts) tls hs f fp ft
|
||||
filterJournalTransactionsByClearedStatus :: Maybe Bool -> Journal -> Journal
|
||||
filterJournalTransactionsByClearedStatus Nothing rl = rl
|
||||
filterJournalTransactionsByClearedStatus (Just val) (Journal ms ps ts tls hs f fp ft) =
|
||||
Journal ms ps (filter ((==val).ltstatus) ts) tls hs f fp ft
|
||||
|
||||
-- | Strip out any virtual postings, if the flag is true, otherwise do
|
||||
-- no filtering.
|
||||
filterRawLedgerPostingsByRealness :: Bool -> RawLedger -> RawLedger
|
||||
filterRawLedgerPostingsByRealness False l = l
|
||||
filterRawLedgerPostingsByRealness True (RawLedger mts pts ts tls hs f fp ft) =
|
||||
RawLedger mts pts (map filtertxns ts) tls hs f fp ft
|
||||
filterJournalPostingsByRealness :: Bool -> Journal -> Journal
|
||||
filterJournalPostingsByRealness False l = l
|
||||
filterJournalPostingsByRealness True (Journal mts pts ts tls hs f fp ft) =
|
||||
Journal mts pts (map filtertxns ts) tls hs f fp ft
|
||||
where filtertxns t@LedgerTransaction{ltpostings=ps} = t{ltpostings=filter isReal ps}
|
||||
|
||||
-- | Strip out any postings to accounts deeper than the specified depth
|
||||
-- (and any ledger transactions which have no postings as a result).
|
||||
filterRawLedgerPostingsByDepth :: Int -> RawLedger -> RawLedger
|
||||
filterRawLedgerPostingsByDepth depth (RawLedger mts pts ts tls hs f fp ft) =
|
||||
RawLedger mts pts (filter (not . null . ltpostings) $ map filtertxns ts) tls hs f fp ft
|
||||
filterJournalPostingsByDepth :: Int -> Journal -> Journal
|
||||
filterJournalPostingsByDepth depth (Journal mts pts ts tls hs f fp ft) =
|
||||
Journal mts pts (filter (not . null . ltpostings) $ map filtertxns ts) tls hs f fp ft
|
||||
where filtertxns t@LedgerTransaction{ltpostings=ps} =
|
||||
t{ltpostings=filter ((<= depth) . accountNameLevel . paccount) ps}
|
||||
|
||||
-- | Keep only ledger transactions which affect accounts matched by the account patterns.
|
||||
filterRawLedgerTransactionsByAccount :: [String] -> RawLedger -> RawLedger
|
||||
filterRawLedgerTransactionsByAccount apats (RawLedger ms ps ts tls hs f fp ft) =
|
||||
RawLedger ms ps (filter (any (matchpats apats . paccount) . ltpostings) ts) tls hs f fp ft
|
||||
filterJournalTransactionsByAccount :: [String] -> Journal -> Journal
|
||||
filterJournalTransactionsByAccount apats (Journal ms ps ts tls hs f fp ft) =
|
||||
Journal ms ps (filter (any (matchpats apats . paccount) . ltpostings) ts) tls hs f fp ft
|
||||
|
||||
-- | Convert this ledger's transactions' primary date to either their
|
||||
-- actual or effective date.
|
||||
rawLedgerSelectingDate :: WhichDate -> RawLedger -> RawLedger
|
||||
rawLedgerSelectingDate ActualDate rl = rl
|
||||
rawLedgerSelectingDate EffectiveDate rl =
|
||||
journalSelectingDate :: WhichDate -> Journal -> Journal
|
||||
journalSelectingDate ActualDate rl = rl
|
||||
journalSelectingDate EffectiveDate rl =
|
||||
rl{ledger_txns=map (ledgerTransactionWithDate EffectiveDate) $ ledger_txns rl}
|
||||
|
||||
-- | Give all a ledger's amounts their canonical display settings. That
|
||||
@ -136,8 +135,8 @@ rawLedgerSelectingDate EffectiveDate rl =
|
||||
-- Also, missing unit prices are added if known from the price history.
|
||||
-- Also, amounts are converted to cost basis if that flag is active.
|
||||
-- XXX refactor
|
||||
canonicaliseAmounts :: Bool -> RawLedger -> RawLedger
|
||||
canonicaliseAmounts costbasis rl@(RawLedger ms ps ts tls hs f fp ft) = RawLedger ms ps (map fixledgertransaction ts) tls hs f fp ft
|
||||
canonicaliseAmounts :: Bool -> Journal -> Journal
|
||||
canonicaliseAmounts costbasis rl@(Journal ms ps ts tls hs f fp ft) = Journal ms ps (map fixledgertransaction ts) tls hs f fp ft
|
||||
where
|
||||
fixledgertransaction (LedgerTransaction d ed s c de co ts pr) = LedgerTransaction d ed s c de co (map fixrawposting ts) pr
|
||||
where
|
||||
@ -154,16 +153,16 @@ canonicaliseAmounts costbasis rl@(RawLedger ms ps ts tls hs f fp ft) = RawLedger
|
||||
commoditymap = Map.fromList [(s,commoditieswithsymbol s) | s <- commoditysymbols]
|
||||
commoditieswithsymbol s = filter ((s==) . symbol) commodities
|
||||
commoditysymbols = nub $ map symbol commodities
|
||||
commodities = map commodity (concatMap (amounts . tamount) (rawLedgerTransactions rl)
|
||||
commodities = map commodity (concatMap (amounts . tamount) (journalTransactions rl)
|
||||
++ concatMap (amounts . hamount) (historical_prices rl))
|
||||
fixprice :: Amount -> Amount
|
||||
fixprice a@Amount{price=Just _} = a
|
||||
fixprice a@Amount{commodity=c} = a{price=rawLedgerHistoricalPriceFor rl d c}
|
||||
fixprice a@Amount{commodity=c} = a{price=journalHistoricalPriceFor rl d c}
|
||||
|
||||
-- | Get the price for a commodity on the specified day from the price database, if known.
|
||||
-- Does only one lookup step, ie will not look up the price of a price.
|
||||
rawLedgerHistoricalPriceFor :: RawLedger -> Day -> Commodity -> Maybe MixedAmount
|
||||
rawLedgerHistoricalPriceFor rl d Commodity{symbol=s} = do
|
||||
journalHistoricalPriceFor :: Journal -> Day -> Commodity -> Maybe MixedAmount
|
||||
journalHistoricalPriceFor rl d Commodity{symbol=s} = do
|
||||
let ps = reverse $ filter ((<= d).hdate) $ filter ((s==).hsymbol) $ sortBy (comparing hdate) $ historical_prices rl
|
||||
case ps of (HistoricalPrice{hamount=a}:_) -> Just $ canonicaliseCommodities a
|
||||
_ -> Nothing
|
||||
@ -173,28 +172,28 @@ canonicaliseAmounts costbasis rl@(RawLedger ms ps ts tls hs f fp ft) = RawLedger
|
||||
a{commodity=findWithDefault (error "programmer error: canonicaliseCommodity failed") s canonicalcommoditymap}
|
||||
|
||||
-- | Get just the amounts from a ledger, in the order parsed.
|
||||
rawLedgerAmounts :: RawLedger -> [MixedAmount]
|
||||
rawLedgerAmounts = map tamount . rawLedgerTransactions
|
||||
journalAmounts :: Journal -> [MixedAmount]
|
||||
journalAmounts = map tamount . journalTransactions
|
||||
|
||||
-- | Get just the ammount commodities from a ledger, in the order parsed.
|
||||
rawLedgerCommodities :: RawLedger -> [Commodity]
|
||||
rawLedgerCommodities = map commodity . concatMap amounts . rawLedgerAmounts
|
||||
journalCommodities :: Journal -> [Commodity]
|
||||
journalCommodities = map commodity . concatMap amounts . journalAmounts
|
||||
|
||||
-- | Get just the amount precisions from a ledger, in the order parsed.
|
||||
rawLedgerPrecisions :: RawLedger -> [Int]
|
||||
rawLedgerPrecisions = map precision . rawLedgerCommodities
|
||||
journalPrecisions :: Journal -> [Int]
|
||||
journalPrecisions = map precision . journalCommodities
|
||||
|
||||
-- | Close any open timelog sessions using the provided current time.
|
||||
rawLedgerConvertTimeLog :: LocalTime -> RawLedger -> RawLedger
|
||||
rawLedgerConvertTimeLog t l0 = l0 { ledger_txns = convertedTimeLog ++ ledger_txns l0
|
||||
journalConvertTimeLog :: LocalTime -> Journal -> Journal
|
||||
journalConvertTimeLog t l0 = l0 { ledger_txns = convertedTimeLog ++ ledger_txns l0
|
||||
, open_timelog_entries = []
|
||||
}
|
||||
where convertedTimeLog = entriesFromTimeLogEntries t $ open_timelog_entries l0
|
||||
|
||||
-- | The (fully specified) date span containing all the raw ledger's transactions,
|
||||
-- or DateSpan Nothing Nothing if there are none.
|
||||
rawLedgerDateSpan :: RawLedger -> DateSpan
|
||||
rawLedgerDateSpan rl
|
||||
journalDateSpan :: Journal -> DateSpan
|
||||
journalDateSpan rl
|
||||
| null ts = DateSpan Nothing Nothing
|
||||
| otherwise = DateSpan (Just $ ltdate $ head ts) (Just $ addDays 1 $ ltdate $ last ts)
|
||||
where
|
@ -1,11 +1,11 @@
|
||||
{-|
|
||||
|
||||
A compound data type for efficiency. A 'Ledger' caches information derived
|
||||
from a 'RawLedger' for easier querying. Also it typically has had
|
||||
from a 'Journal' for easier querying. Also it typically has had
|
||||
uninteresting 'LedgerTransaction's and 'Posting's filtered out. It
|
||||
contains:
|
||||
|
||||
- the original unfiltered 'RawLedger'
|
||||
- the original unfiltered 'Journal'
|
||||
|
||||
- a tree of 'AccountName's
|
||||
|
||||
@ -60,22 +60,22 @@ import Ledger.Types
|
||||
import Ledger.Account ()
|
||||
import Ledger.AccountName
|
||||
import Ledger.Transaction
|
||||
import Ledger.RawLedger
|
||||
import Ledger.Journal
|
||||
|
||||
|
||||
instance Show Ledger where
|
||||
show l = printf "Ledger with %d transactions, %d accounts\n%s"
|
||||
(length (ledger_txns $ rawledger l) +
|
||||
length (modifier_txns $ rawledger l) +
|
||||
length (periodic_txns $ rawledger l))
|
||||
(length (ledger_txns $ journal l) +
|
||||
length (modifier_txns $ journal l) +
|
||||
length (periodic_txns $ journal l))
|
||||
(length $ accountnames l)
|
||||
(showtree $ accountnametree l)
|
||||
|
||||
-- | Convert a raw ledger to a more efficient cached type, described above.
|
||||
cacheLedger :: [String] -> RawLedger -> Ledger
|
||||
cacheLedger apats l = Ledger{rawledgertext="",rawledger=l,accountnametree=ant,accountmap=acctmap}
|
||||
cacheLedger :: [String] -> Journal -> Ledger
|
||||
cacheLedger apats l = Ledger{journaltext="",journal=l,accountnametree=ant,accountmap=acctmap}
|
||||
where
|
||||
(ant,txnsof,_,inclbalof) = groupTransactions $ filtertxns apats $ rawLedgerTransactions l
|
||||
(ant,txnsof,_,inclbalof) = groupTransactions $ filtertxns apats $ journalTransactions l
|
||||
acctmap = Map.fromList [(a, mkacct a) | a <- flatten ant]
|
||||
where mkacct a = Account a (txnsof a) (inclbalof a)
|
||||
|
||||
@ -156,7 +156,7 @@ ledgerSubAccounts l Account{aname=a} =
|
||||
|
||||
-- | List a ledger's "transactions", ie postings with transaction info attached.
|
||||
ledgerTransactions :: Ledger -> [Transaction]
|
||||
ledgerTransactions = rawLedgerTransactions . rawledger
|
||||
ledgerTransactions = journalTransactions . journal
|
||||
|
||||
-- | Get a ledger's tree of accounts to the specified depth.
|
||||
ledgerAccountTree :: Int -> Ledger -> Tree Account
|
||||
@ -198,7 +198,7 @@ transactions :: Ledger -> [Transaction]
|
||||
transactions = ledgerTransactions
|
||||
|
||||
commodities :: Ledger -> [Commodity]
|
||||
commodities = nub . rawLedgerCommodities . rawledger
|
||||
commodities = nub . journalCommodities . journal
|
||||
|
||||
accounttree :: Int -> Ledger -> Tree Account
|
||||
accounttree = ledgerAccountTree
|
||||
@ -210,7 +210,7 @@ accounttreeat = ledgerAccountTreeAt
|
||||
-- datespan = ledgerDateSpan
|
||||
|
||||
rawdatespan :: Ledger -> DateSpan
|
||||
rawdatespan = rawLedgerDateSpan . rawledger
|
||||
rawdatespan = journalDateSpan . journal
|
||||
|
||||
ledgeramounts :: Ledger -> [MixedAmount]
|
||||
ledgeramounts = rawLedgerAmounts . rawledger
|
||||
ledgeramounts = journalAmounts . journal
|
||||
|
@ -20,7 +20,7 @@ import Ledger.AccountName (accountNameFromComponents,accountNameComponents)
|
||||
import Ledger.Amount
|
||||
import Ledger.LedgerTransaction
|
||||
import Ledger.Posting
|
||||
import Ledger.RawLedger
|
||||
import Ledger.Journal
|
||||
import System.FilePath(takeDirectory,combine)
|
||||
|
||||
|
||||
@ -63,21 +63,21 @@ printParseError e = do putStr "ledger parse error at "; print e
|
||||
|
||||
-- let's get to it
|
||||
|
||||
parseLedgerFile :: LocalTime -> FilePath -> ErrorT String IO RawLedger
|
||||
parseLedgerFile :: LocalTime -> FilePath -> ErrorT String IO Journal
|
||||
parseLedgerFile t "-" = liftIO getContents >>= parseLedger t "-"
|
||||
parseLedgerFile t f = liftIO (readFile f) >>= parseLedger t f
|
||||
|
||||
-- | Parses the contents of a ledger file, or gives an error. Requires
|
||||
-- the current (local) time to calculate any unfinished timelog sessions,
|
||||
-- we pass it in for repeatability.
|
||||
parseLedger :: LocalTime -> FilePath -> String -> ErrorT String IO RawLedger
|
||||
parseLedger :: LocalTime -> FilePath -> String -> ErrorT String IO Journal
|
||||
parseLedger reftime inname intxt =
|
||||
case runParser ledgerFile emptyCtx inname intxt of
|
||||
Right m -> liftM (rawLedgerConvertTimeLog reftime) $ m `ap` return rawLedgerEmpty
|
||||
Right m -> liftM (journalConvertTimeLog reftime) $ m `ap` return journalEmpty
|
||||
Left err -> throwError $ show err
|
||||
|
||||
|
||||
ledgerFile :: GenParser Char LedgerFileCtx (ErrorT String IO (RawLedger -> RawLedger))
|
||||
ledgerFile :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal))
|
||||
ledgerFile = do items <- many ledgerItem
|
||||
eof
|
||||
return $ liftM (foldr (.) id) $ sequence items
|
||||
@ -95,7 +95,7 @@ ledgerFile = do items <- many ledgerItem
|
||||
, liftM (return . addTimeLogEntry) timelogentry
|
||||
]
|
||||
|
||||
ledgerDirective :: GenParser Char LedgerFileCtx (ErrorT String IO (RawLedger -> RawLedger))
|
||||
ledgerDirective :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal))
|
||||
ledgerDirective = do char '!' <?> "directive"
|
||||
directive <- many nonspace
|
||||
case directive of
|
||||
@ -104,7 +104,7 @@ ledgerDirective = do char '!' <?> "directive"
|
||||
"end" -> ledgerAccountEnd
|
||||
_ -> mzero
|
||||
|
||||
ledgerInclude :: GenParser Char LedgerFileCtx (ErrorT String IO (RawLedger -> RawLedger))
|
||||
ledgerInclude :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal))
|
||||
ledgerInclude = do many1 spacenonewline
|
||||
filename <- restofline
|
||||
outerState <- getState
|
||||
@ -127,19 +127,19 @@ expandPath pos fp = liftM mkRelative (expandHome fp)
|
||||
return $ homedir ++ drop 1 inname
|
||||
| otherwise = return inname
|
||||
|
||||
ledgerAccountBegin :: GenParser Char LedgerFileCtx (ErrorT String IO (RawLedger -> RawLedger))
|
||||
ledgerAccountBegin :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal))
|
||||
ledgerAccountBegin = do many1 spacenonewline
|
||||
parent <- ledgeraccountname
|
||||
newline
|
||||
pushParentAccount parent
|
||||
return $ return id
|
||||
|
||||
ledgerAccountEnd :: GenParser Char LedgerFileCtx (ErrorT String IO (RawLedger -> RawLedger))
|
||||
ledgerAccountEnd :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal))
|
||||
ledgerAccountEnd = popParentAccount >> return (return id)
|
||||
|
||||
-- parsers
|
||||
|
||||
-- | Parse a RawLedger from either a ledger file or a timelog file.
|
||||
-- | Parse a Journal from either a ledger file or a timelog file.
|
||||
-- It tries first the timelog parser then the ledger parser; this means
|
||||
-- parse errors for ledgers are useful while those for timelogs are not.
|
||||
|
||||
@ -295,7 +295,7 @@ ledgerHistoricalPrice = do
|
||||
return $ HistoricalPrice date symbol price
|
||||
|
||||
-- like ledgerAccountBegin, updates the LedgerFileCtx
|
||||
ledgerDefaultYear :: GenParser Char LedgerFileCtx (ErrorT String IO (RawLedger -> RawLedger))
|
||||
ledgerDefaultYear :: GenParser Char LedgerFileCtx (ErrorT String IO (Journal -> Journal))
|
||||
ledgerDefaultYear = do
|
||||
char 'Y' <?> "default year"
|
||||
many spacenonewline
|
||||
|
@ -1,25 +1,30 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-|
|
||||
|
||||
Most data types are defined here to avoid import cycles. See the
|
||||
corresponding modules for each type's documentation.
|
||||
Most data types are defined here to avoid import cycles.
|
||||
Here is an overview of the hledger data model as of 0.8:
|
||||
|
||||
A note about entry\/transaction\/posting terminology:
|
||||
Ledger -- hledger's ledger, a journal file plus various cached data
|
||||
Journal -- representation of the journal file
|
||||
[Transaction] (LedgerTransaction) -- journal transactions, with date, description and..
|
||||
[Posting] -- one or more journal postings
|
||||
[LedgerPosting] -- all postings combined with their transaction info
|
||||
Tree AccountName -- the tree of all account names
|
||||
Map AccountName AccountInfo -- account info in a map for easy lookup by name
|
||||
|
||||
- ledger 2 had Entrys containing Transactions.
|
||||
|
||||
- hledger 0.4 had Entrys containing RawTransactions, plus Transactions
|
||||
which were a RawTransaction with its parent Entry's info added.
|
||||
The latter are what we most work with when reporting and are
|
||||
ubiquitous in the code and docs.
|
||||
|
||||
- ledger 3 has Transactions containing Postings.
|
||||
|
||||
For more detailed documentation on each type, see the corresponding modules.
|
||||
|
||||
- hledger 0.5 has LedgerTransactions containing Postings, plus
|
||||
Transactions as before (a Posting plus it's parent's info). The
|
||||
\"transaction\" term is pretty ingrained in the code, docs and with
|
||||
users, so we've kept it.
|
||||
A note about terminology:
|
||||
|
||||
- ledger 2 had entries containing transactions.
|
||||
|
||||
- ledger 3 has transactions containing postings.
|
||||
|
||||
- hledger 0.4 had Entrys containing RawTransactions, which were flattened to Transactions.
|
||||
|
||||
- hledger 0.5 had LedgerTransactions containing Postings, which were flattened to Transactions.
|
||||
|
||||
- hledger 0.8 has Transactions containing Postings, which are flattened to LedgerPostings.
|
||||
|
||||
-}
|
||||
|
||||
@ -107,7 +112,7 @@ data HistoricalPrice = HistoricalPrice {
|
||||
hamount :: MixedAmount
|
||||
} deriving (Eq) -- & Show (in Amount.hs)
|
||||
|
||||
data RawLedger = RawLedger {
|
||||
data Journal = Journal {
|
||||
modifier_txns :: [ModifierTransaction],
|
||||
periodic_txns :: [PeriodicTransaction],
|
||||
ledger_txns :: [LedgerTransaction],
|
||||
@ -146,8 +151,8 @@ data Account = Account {
|
||||
}
|
||||
|
||||
data Ledger = Ledger {
|
||||
rawledgertext :: String,
|
||||
rawledger :: RawLedger,
|
||||
journaltext :: String,
|
||||
journal :: Journal,
|
||||
accountnametree :: Tree AccountName,
|
||||
accountmap :: Map.Map AccountName Account
|
||||
} deriving Typeable
|
||||
|
26
Tests.hs
26
Tests.hs
@ -85,8 +85,8 @@ tests :: [Test]
|
||||
tests = [
|
||||
|
||||
"account directive" ~:
|
||||
let sameParse str1 str2 = do l1 <- rawLedgerFromString str1
|
||||
l2 <- rawLedgerFromString str2
|
||||
let sameParse str1 str2 = do l1 <- journalFromString str1
|
||||
l2 <- journalFromString str2
|
||||
l1 `is` l2
|
||||
in TestList
|
||||
[
|
||||
@ -275,7 +275,7 @@ tests = [
|
||||
]
|
||||
|
||||
,"balance report with cost basis" ~: do
|
||||
rl <- rawLedgerFromString $ unlines
|
||||
rl <- journalFromString $ unlines
|
||||
[""
|
||||
,"2008/1/1 test "
|
||||
," a:b 10h @ $50"
|
||||
@ -283,7 +283,7 @@ tests = [
|
||||
,""
|
||||
]
|
||||
let l = cacheLedger [] $
|
||||
filterRawLedger (DateSpan Nothing Nothing) [] Nothing False $
|
||||
filterJournal (DateSpan Nothing Nothing) [] Nothing False $
|
||||
canonicaliseAmounts True rl -- enable cost basis adjustment
|
||||
showBalanceReport [] [] l `is`
|
||||
unlines
|
||||
@ -331,11 +331,11 @@ tests = [
|
||||
Left _ -> error "should not happen")
|
||||
|
||||
,"cacheLedger" ~:
|
||||
length (Map.keys $ accountmap $ cacheLedger [] rawledger7) `is` 15
|
||||
length (Map.keys $ accountmap $ cacheLedger [] journal7) `is` 15
|
||||
|
||||
,"canonicaliseAmounts" ~:
|
||||
"use the greatest precision" ~:
|
||||
rawLedgerPrecisions (canonicaliseAmounts False $ rawLedgerWithAmounts ["1","2.00"]) `is` [2,2]
|
||||
journalPrecisions (canonicaliseAmounts False $ journalWithAmounts ["1","2.00"]) `is` [2,2]
|
||||
|
||||
,"commodities" ~:
|
||||
commodities ledger7 `is` [Commodity {symbol="$", side=L, spaced=False, comma=False, precision=2}]
|
||||
@ -457,13 +457,13 @@ tests = [
|
||||
"assets:bank" `isSubAccountNameOf` "my assets" `is` False
|
||||
|
||||
,"default year" ~: do
|
||||
rl <- rawLedgerFromString defaultyear_ledger_str
|
||||
rl <- journalFromString defaultyear_ledger_str
|
||||
ltdate (head $ ledger_txns rl) `is` fromGregorian 2009 1 1
|
||||
return ()
|
||||
|
||||
,"ledgerFile" ~: do
|
||||
assertBool "ledgerFile should parse an empty file" (isRight $ parseWithCtx emptyCtx ledgerFile "")
|
||||
r <- rawLedgerFromString "" -- don't know how to get it from ledgerFile
|
||||
r <- journalFromString "" -- don't know how to get it from ledgerFile
|
||||
assertBool "ledgerFile parsing an empty file should give an empty ledger" $ null $ ledger_txns r
|
||||
|
||||
,"ledgerHistoricalPrice" ~:
|
||||
@ -1060,7 +1060,7 @@ ledger7_str = unlines
|
||||
,""
|
||||
]
|
||||
|
||||
rawledger7 = RawLedger
|
||||
journal7 = Journal
|
||||
[]
|
||||
[]
|
||||
[
|
||||
@ -1226,7 +1226,7 @@ rawledger7 = RawLedger
|
||||
""
|
||||
(TOD 0 0)
|
||||
|
||||
ledger7 = cacheLedger [] rawledger7
|
||||
ledger7 = cacheLedger [] journal7
|
||||
|
||||
ledger8_str = unlines
|
||||
["2008/1/1 test "
|
||||
@ -1248,9 +1248,9 @@ a1 = Mixed [(hours 1){price=Just $ Mixed [Amount (comm "$") 10 Nothing]}]
|
||||
a2 = Mixed [(hours 2){price=Just $ Mixed [Amount (comm "EUR") 10 Nothing]}]
|
||||
a3 = Mixed $ amounts a1 ++ amounts a2
|
||||
|
||||
rawLedgerWithAmounts :: [String] -> RawLedger
|
||||
rawLedgerWithAmounts as =
|
||||
RawLedger
|
||||
journalWithAmounts :: [String] -> Journal
|
||||
journalWithAmounts as =
|
||||
Journal
|
||||
[]
|
||||
[]
|
||||
[nullledgertxn{ltdescription=a,ltpostings=[nullrawposting{pamount=parse a}]} | a <- as]
|
||||
|
8
Utils.hs
8
Utils.hs
@ -34,14 +34,14 @@ withLedgerDo opts args cmdname cmd = do
|
||||
t <- getCurrentLocalTime
|
||||
tc <- getClockTime
|
||||
let go = cmd opts args . filterAndCacheLedgerWithOpts opts args t rawtext . (\rl -> rl{filepath=f,filereadtime=tc})
|
||||
if creating then go rawLedgerEmpty else (runErrorT . parseLedgerFile t) f
|
||||
if creating then go journalEmpty else (runErrorT . parseLedgerFile t) f
|
||||
>>= flip either go
|
||||
(\e -> hPutStrLn stderr e >> exitWith (ExitFailure 1))
|
||||
|
||||
-- | Get a Ledger from the given string and options, or raise an error.
|
||||
ledgerFromStringWithOpts :: [Opt] -> [String] -> LocalTime -> String -> IO Ledger
|
||||
ledgerFromStringWithOpts opts args reftime s =
|
||||
liftM (filterAndCacheLedgerWithOpts opts args reftime s) $ rawLedgerFromString s
|
||||
liftM (filterAndCacheLedgerWithOpts opts args reftime s) $ journalFromString s
|
||||
|
||||
-- | Read a Ledger from the given file, filtering according to the
|
||||
-- options, or give an error.
|
||||
@ -50,9 +50,9 @@ readLedgerWithOpts opts args f = do
|
||||
t <- getCurrentLocalTime
|
||||
readLedgerWithFilterSpec (optsToFilterSpec opts args t) f
|
||||
|
||||
-- | Convert a RawLedger to a canonicalised, cached and filtered Ledger
|
||||
-- | Convert a Journal to a canonicalised, cached and filtered Ledger
|
||||
-- based on the command-line options/arguments and a reference time.
|
||||
filterAndCacheLedgerWithOpts :: [Opt] -> [String] -> LocalTime -> String -> RawLedger -> Ledger
|
||||
filterAndCacheLedgerWithOpts :: [Opt] -> [String] -> LocalTime -> String -> Journal -> Ledger
|
||||
filterAndCacheLedgerWithOpts opts args = filterAndCacheLedger . optsToFilterSpec opts args
|
||||
|
||||
-- | Attempt to open a web browser on the given url, all platforms.
|
||||
|
@ -51,7 +51,7 @@ library
|
||||
Ledger.Dates
|
||||
Ledger.IO
|
||||
Ledger.LedgerTransaction
|
||||
Ledger.RawLedger
|
||||
Ledger.Journal
|
||||
Ledger.Ledger
|
||||
Ledger.Posting
|
||||
Ledger.Parse
|
||||
@ -92,7 +92,7 @@ executable hledger
|
||||
Ledger.LedgerTransaction
|
||||
Ledger.Ledger
|
||||
Ledger.Parse
|
||||
Ledger.RawLedger
|
||||
Ledger.Journal
|
||||
Ledger.Posting
|
||||
Ledger.TimeLog
|
||||
Ledger.Transaction
|
||||
|
Loading…
Reference in New Issue
Block a user