slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

rename RawLedger to Journal

Browse Source
This commit is contained in:
Simon Michael 2009-12-16 07:00:43 +00:00
parent 83f9aa5693
commit 2e9b27da0d
15 changed files with 165 additions and 161 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
Commands/Add.hs
View File

@ -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

2
Commands/Histogram.hs
View File

@ -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

6
Commands/Print.hs
View File

@ -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

4
Commands/Stats.hs
View File

@ -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

2
Commands/UI.hs
View File

@ -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

10
Commands/Web.hs
View File

@ -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 =

4
Ledger.hs
View File

@ -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
View File

@ -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

133
Ledger/RawLedger.hs → Ledger/Journal.hs
View File

@ -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

26
Ledger/Ledger.hs
View File

@ -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

22
Ledger/Parse.hs
View File

@ -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

43
Ledger/Types.hs
View File

@ -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
View File

@ -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
View File

@ -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.

4
hledger.cabal
View File

@ -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