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

refactor: clarify the roles of Journal (primary data) and Ledger (derived report)

Browse Source
This commit is contained in:
Simon Michael 2010-05-23 17:41:25 +00:00
parent fc330b5c9f
commit bf5ee88a30
18 changed files with 214 additions and 299 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
Hledger/Cli/Commands/Add.hs
View File

@ -19,42 +19,42 @@ import System.IO ( stderr, hFlush, hPutStrLn, hPutStr )
#endif
import System.IO.Error
import Text.ParserCombinators.Parsec
import Hledger.Cli.Utils (ledgerFromStringWithOpts)
import Hledger.Cli.Utils (journalFromStringWithOpts)
import qualified Data.Foldable as Foldable (find)
-- | Read ledger transactions from the terminal, prompting for each field,
-- and append them to the ledger file. If the ledger came from stdin, this
-- command has no effect.
add :: [Opt] -> [String] -> Ledger -> IO ()
add opts args l
| filepath (journal l) == "-" = return ()
add :: [Opt] -> [String] -> Journal -> IO ()
add opts args j
| filepath j == "-" = return ()
| otherwise = do
hPutStrLn stderr $
"Enter one or more transactions, which will be added to your ledger file.\n"
++"To complete a transaction, enter . as account name. To quit, press control-c."
today <- getCurrentDay
getAndAddTransactions l opts args today `catch` (\e -> unless (isEOFError e) $ ioError e)
getAndAddTransactions j opts args today `catch` (\e -> unless (isEOFError e) $ ioError e)
-- | Read a number of ledger transactions from the command line,
-- prompting, validating, displaying and appending them to the ledger
-- file, until end of input (then raise an EOF exception). Any
-- command-line arguments are used as the first transaction's description.
getAndAddTransactions :: Ledger -> [Opt] -> [String] -> Day -> IO ()
getAndAddTransactions l opts args defaultDate = do
(ledgerTransaction,date) <- getTransaction l opts args defaultDate
l <- ledgerAddTransaction l ledgerTransaction
getAndAddTransactions l opts args date
-- | Read a number of transactions from the command line, prompting,
-- validating, displaying and appending them to the journal file, until
-- end of input (then raise an EOF exception). Any command-line arguments
-- are used as the first transaction's description.
getAndAddTransactions :: Journal -> [Opt] -> [String] -> Day -> IO ()
getAndAddTransactions j opts args defaultDate = do
(t, d) <- getTransaction j opts args defaultDate
j <- journalAddTransaction j t
getAndAddTransactions j opts args d
-- | Read a transaction from the command line, with history-aware prompting.
getTransaction :: Ledger -> [Opt] -> [String] -> Day -> IO (Transaction,Day)
getTransaction l opts args defaultDate = do
getTransaction :: Journal -> [Opt] -> [String] -> Day -> IO (Transaction,Day)
getTransaction j opts args defaultDate = do
today <- getCurrentDay
datestr <- askFor "date"
(Just $ showDate defaultDate)
(Just $ \s -> null s ||
isRight (parse (smartdate >> many spacenonewline >> eof) "" $ lowercase s))
description <- askFor "description" Nothing (Just $ not . null)
let historymatches = transactionsSimilarTo l args description
let historymatches = transactionsSimilarTo j args description
bestmatch | null historymatches = Nothing
| otherwise = Just $ snd $ head historymatches
bestmatchpostings = maybe Nothing (Just . tpostings) bestmatch
@ -63,7 +63,7 @@ getTransaction l opts args defaultDate = do
if NoNewAccts `elem` opts
then isJust $ Foldable.find (== x) ant
else True
where (ant,_,_,_) = groupPostings . journalPostings . journal $ l
where (ant,_,_,_) = groupPostings $ journalPostings j
getpostingsandvalidate = do
ps <- getPostings accept bestmatchpostings []
let t = nulltransaction{tdate=date
@ -129,30 +129,26 @@ askFor prompt def validator = do
Nothing -> return input
where showdef s = " [" ++ s ++ "]"
-- | Append this transaction to the ledger's file. Also, to the ledger's
-- | Append this transaction to the journal's file. Also, to the journal's
-- transaction list, but we don't bother updating the other fields - this
-- is enough to include new transactions in the history matching.
ledgerAddTransaction :: Ledger -> Transaction -> IO Ledger
ledgerAddTransaction l t = do
appendToLedgerFile l $ showTransaction t
putStrLn $ printf "\nAdded transaction to %s:" (filepath $ journal l)
journalAddTransaction :: Journal -> Transaction -> IO Journal
journalAddTransaction j@Journal{jtxns=ts} t = do
appendToJournalFile j $ showTransaction t
putStrLn $ printf "\nAdded transaction to %s:" (filepath j)
putStrLn =<< registerFromString (show t)
return l{journal=rl{jtxns=ts}}
where rl = journal l
ts = jtxns rl ++ [t]
return j{jtxns=ts++[t]}
-- | Append data to the ledger's file, ensuring proper separation from any
-- existing data; or if the file is "-", dump it to stdout.
appendToLedgerFile :: Ledger -> String -> IO ()
appendToLedgerFile l s =
-- | Append data to the journal's file, ensuring proper separation from
-- any existing data; or if the file is "-", dump it to stdout.
appendToJournalFile :: Journal -> String -> IO ()
appendToJournalFile Journal{filepath=f, jtext=t} s =
if f == "-"
then putStr $ sep ++ s
else appendFile f $ sep++s
where
f = filepath $ journal l
-- XXX we are looking at the original raw text from when the ledger
-- was first read, but that's good enough for now
t = jtext $ journal l
sep | null $ strip t = ""
| otherwise = replicate (2 - min 2 (length lastnls)) '\n'
where lastnls = takeWhile (=='\n') $ reverse t
@ -161,7 +157,7 @@ appendToLedgerFile l s =
registerFromString :: String -> IO String
registerFromString s = do
now <- getCurrentLocalTime
l <- ledgerFromStringWithOpts [] s
l <- journalFromStringWithOpts [] s
return $ showRegisterReport opts (optsToFilterSpec opts [] now) l
where opts = [Empty]
@ -184,19 +180,19 @@ wordLetterPairs = concatMap letterPairs . words
letterPairs (a:b:rest) = [a,b] : letterPairs (b:rest)
letterPairs _ = []
compareLedgerDescriptions :: [Char] -> [Char] -> Double
compareLedgerDescriptions s t = compareStrings s' t'
compareDescriptions :: [Char] -> [Char] -> Double
compareDescriptions s t = compareStrings s' t'
where s' = simplify s
t' = simplify t
simplify = filter (not . (`elem` "0123456789"))
transactionsSimilarTo :: Ledger -> [String] -> String -> [(Double,Transaction)]
transactionsSimilarTo l apats s =
transactionsSimilarTo :: Journal -> [String] -> String -> [(Double,Transaction)]
transactionsSimilarTo j apats s =
sortBy compareRelevanceAndRecency
$ filter ((> threshold).fst)
[(compareLedgerDescriptions s $ tdescription t, t) | t <- ts]
[(compareDescriptions s $ tdescription t, t) | t <- ts]
where
compareRelevanceAndRecency (n1,t1) (n2,t2) = compare (n2,tdate t2) (n1,tdate t1)
ts = jtxns $ filterJournalTransactionsByAccount apats $ journal l
ts = jtxns $ filterJournalTransactionsByAccount apats j
threshold = 0

20
Hledger/Cli/Commands/Balance.hs
View File

@ -111,27 +111,27 @@ import System.IO.UTF8
-- | Print a balance report.
balance :: [Opt] -> [String] -> Ledger -> IO ()
balance opts args l = do
balance :: [Opt] -> [String] -> Journal -> IO ()
balance opts args j = do
t <- getCurrentLocalTime
putStr $ showBalanceReport opts (optsToFilterSpec opts args t) l
putStr $ showBalanceReport opts (optsToFilterSpec opts args t) j
-- | Generate a balance report with the specified options for this ledger.
showBalanceReport :: [Opt] -> FilterSpec -> Ledger -> String
showBalanceReport opts filterspec l = acctsstr ++ totalstr
showBalanceReport :: [Opt] -> FilterSpec -> Journal -> String
showBalanceReport opts filterspec j = acctsstr ++ totalstr
where
l' = filterAndCacheLedger filterspec l
l = journalToLedger filterspec j
acctsstr = unlines $ map showacct interestingaccts
where
showacct = showInterestingAccount l' interestingaccts
interestingaccts = filter (isInteresting opts l') acctnames
showacct = showInterestingAccount l interestingaccts
interestingaccts = filter (isInteresting opts l) acctnames
acctnames = sort $ tail $ flatten $ treemap aname accttree
accttree = ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) l'
accttree = ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) l
totalstr | NoTotal `elem` opts = ""
| notElem Empty opts && isZeroMixedAmount total = ""
| otherwise = printf "--------------------\n%s\n" $ padleft 20 $ showMixedAmountWithoutPrice total
where
total = sum $ map abalance $ ledgerTopAccounts l'
total = sum $ map abalance $ ledgerTopAccounts l
-- | Display one line of the balance report with appropriate indenting and eliding.
showInterestingAccount :: Ledger -> [AccountName] -> AccountName -> String

12
Hledger/Cli/Commands/Chart.hs
View File

@ -24,10 +24,10 @@ import Data.List
import Safe (readDef)
-- | Generate an image with the pie chart and write it to a file
chart :: [Opt] -> [String] -> Ledger -> IO ()
chart opts args l = do
chart :: [Opt] -> [String] -> Journal -> IO ()
chart opts args j = do
t <- getCurrentLocalTime
let chart = genPie opts (optsToFilterSpec opts args t) l
let chart = genPie opts (optsToFilterSpec opts args t) j
renderableToPNGFile (toRenderable chart) w h filename
where
filename = getOption opts ChartOutput chartoutput
@ -48,8 +48,8 @@ parseSize str = (read w, read h)
(w,_:h) = splitAt x str
-- | Generate pie chart
genPie :: [Opt] -> FilterSpec -> Ledger -> PieLayout
genPie opts filterspec l = defaultPieLayout { pie_background_ = solidFillStyle $ opaque $ white
genPie :: [Opt] -> FilterSpec -> Journal -> PieLayout
genPie opts filterspec j = defaultPieLayout { pie_background_ = solidFillStyle $ opaque $ white
, pie_plot_ = pie_chart }
where
pie_chart = defaultPieChart { pie_data_ = map (uncurry accountPieItem) chartitems'
@ -60,7 +60,7 @@ genPie opts filterspec l = defaultPieLayout { pie_background_ = solidFillStyle $
chartitems' = debug "chart" $ top num samesignitems
(samesignitems, sign) = sameSignNonZero rawitems
rawitems = debug "raw" $ flatten $ balances $
ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) $ cacheLedger'' filterspec l
ledgerAccountTree (fromMaybe 99999 $ depthFromOpts opts) $ journalToLedger filterspec j
top n t = topn ++ [other]
where
(topn,rest) = splitAt n $ reverse $ sortBy (comparing snd) t

6
Hledger/Cli/Commands/Convert.hs
View File

@ -6,7 +6,7 @@ format, and print it on stdout. See the manual for more details.
module Hledger.Cli.Commands.Convert where
import Hledger.Cli.Options (Opt(Debug))
import Hledger.Cli.Version (versionstr)
import Hledger.Data.Types (Ledger,AccountName,Transaction(..),Posting(..),PostingType(..))
import Hledger.Data.Types (Journal,AccountName,Transaction(..),Posting(..),PostingType(..))
import Hledger.Data.Utils (strip, spacenonewline, restofline, parseWithCtx, assertParse, assertParseEqual)
import Hledger.Data.Parse (someamount, emptyCtx, ledgeraccountname)
import Hledger.Data.Amount (nullmixedamt)
@ -66,9 +66,9 @@ type AccountRule = (
type CsvRecord = [String]
-- | Read the CSV file named as an argument and print equivalent ledger transactions,
-- | Read the CSV file named as an argument and print equivalent journal transactions,
-- using/creating a .rules file.
convert :: [Opt] -> [String] -> Ledger -> IO ()
convert :: [Opt] -> [String] -> Journal -> IO ()
convert opts args _ = do
when (null args) $ error "please specify a csv data file."
let csvfile = head args

14
Hledger/Cli/Commands/Histogram.hs
View File

@ -19,23 +19,23 @@ barchar = '*'
-- | Print a histogram of some statistic per reporting interval, such as
-- number of postings per day.
histogram :: [Opt] -> [String] -> Ledger -> IO ()
histogram opts args l = do
histogram :: [Opt] -> [String] -> Journal -> IO ()
histogram opts args j = do
t <- getCurrentLocalTime
putStr $ showHistogram opts (optsToFilterSpec opts args t) l
putStr $ showHistogram opts (optsToFilterSpec opts args t) j
showHistogram :: [Opt] -> FilterSpec -> Ledger -> String
showHistogram opts filterspec l = concatMap (printDayWith countBar) dayps
showHistogram :: [Opt] -> FilterSpec -> Journal -> String
showHistogram opts filterspec j = concatMap (printDayWith countBar) dayps
where
i = intervalFromOpts opts
interval | i == NoInterval = Daily
| otherwise = i
fullspan = journalDateSpan $ journal l
fullspan = journalDateSpan j
days = filter (DateSpan Nothing Nothing /=) $ splitSpan interval fullspan
dayps = [(s, filter (isPostingInDateSpan s) ps) | s <- days]
-- same as Register
-- should count transactions, not postings ?
ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ ledgerPostings l
ps = sortBy (comparing postingDate) $ filterempties $ filter matchapats $ filterdepth $ journalPostings j
filterempties
| Empty `elem` opts = id
| otherwise = filter (not . isZeroMixedAmount . pamount)

12
Hledger/Cli/Commands/Print.hs
View File

@ -16,14 +16,14 @@ import System.IO.UTF8
-- | Print ledger transactions in standard format.
print' :: [Opt] -> [String] -> Ledger -> IO ()
print' opts args l = do
print' :: [Opt] -> [String] -> Journal -> IO ()
print' opts args j = do
t <- getCurrentLocalTime
putStr $ showTransactions (optsToFilterSpec opts args t) l
putStr $ showTransactions (optsToFilterSpec opts args t) j
showTransactions :: FilterSpec -> Ledger -> String
showTransactions filterspec l =
showTransactions :: FilterSpec -> Journal -> String
showTransactions filterspec j =
concatMap (showTransactionForPrint effective) $ sortBy (comparing tdate) txns
where
effective = EffectiveDate == whichdate filterspec
txns = jtxns $ filterJournalTransactions filterspec $ journal l
txns = jtxns $ filterJournalTransactions filterspec j

14
Hledger/Cli/Commands/Register.hs
View File

@ -22,21 +22,21 @@ import System.IO.UTF8
-- | Print a register report.
register :: [Opt] -> [String] -> Ledger -> IO ()
register opts args l = do
register :: [Opt] -> [String] -> Journal -> IO ()
register opts args j = do
t <- getCurrentLocalTime
putStr $ showRegisterReport opts (optsToFilterSpec opts args t) l
putStr $ showRegisterReport opts (optsToFilterSpec opts args t) j
-- | Generate the register report, which is a list of postings with transaction
-- info and a running balance.
showRegisterReport :: [Opt] -> FilterSpec -> Ledger -> String
showRegisterReport opts filterspec l = showPostingsWithBalance ps nullposting startbal
showRegisterReport :: [Opt] -> FilterSpec -> Journal -> String
showRegisterReport opts filterspec j = showPostingsWithBalance ps nullposting startbal
where
ps | interval == NoInterval = displayableps
| otherwise = summarisePostings interval depth empty filterspan displayableps
startbal = sumPostings precedingps
(precedingps,displayableps,_) =
postingsMatchingDisplayExpr (displayExprFromOpts opts) $ journalPostings $ filterJournalPostings filterspec $ journal l
postingsMatchingDisplayExpr (displayExprFromOpts opts) $ journalPostings $ filterJournalPostings filterspec j
(interval, depth, empty) = (intervalFromOpts opts, depthFromOpts opts, Empty `elem` opts)
filterspan = datespan filterspec
@ -99,7 +99,7 @@ summarisePostingsInDateSpan (DateSpan b e) depth showempty ps
summaryps' = (if showempty then id else filter (not . isZeroMixedAmount . pamount)) summaryps
summaryps = [summaryp{paccount=a,pamount=balancetoshowfor a} | a <- clippedanames]
anames = sort $ nub $ map paccount ps
-- aggregate balances by account, like cacheLedger, then do depth-clipping
-- aggregate balances by account, like journalToLedger, then do depth-clipping
(_,_,exclbalof,inclbalof) = groupPostings ps
clippedanames = nub $ map (clipAccountName d) anames
isclipped a = accountNameLevel a >= d

6
Hledger/Cli/Commands/Stats.hs
View File

@ -17,10 +17,10 @@ import qualified Data.Map as Map
-- | Print various statistics for the ledger.
stats :: [Opt] -> [String] -> Ledger -> IO ()
stats opts args l = do
stats :: [Opt] -> [String] -> Journal -> IO ()
stats opts args j = do
today <- getCurrentDay
putStr $ showStats opts args (filterAndCacheLedger nullfilterspec l) today
putStr $ showStats opts args (journalToLedger nullfilterspec j) today
showStats :: [Opt] -> [String] -> Ledger -> Day -> String
showStats _ _ l today =

20
Hledger/Cli/Commands/Vty.hs
View File

@ -27,7 +27,7 @@ data AppState = AppState {
,amsg :: String -- ^ status message
,aopts :: [Opt] -- ^ command-line opts
,aargs :: [String] -- ^ command-line args at startup
,aledger :: Ledger -- ^ parsed ledger
,ajournal :: Journal -- ^ parsed journal
,abuf :: [String] -- ^ lines of the current buffered view
,alocs :: [Loc] -- ^ user's navigation trail within the UI
-- ^ never null, head is current location
@ -49,8 +49,8 @@ data Screen = BalanceScreen -- ^ like hledger balance, shows accounts
deriving (Eq,Show)
-- | Run the vty (curses-style) ui.
vty :: [Opt] -> [String] -> Ledger -> IO ()
vty opts args l = do
vty :: [Opt] -> [String] -> Journal -> IO ()
vty opts args j = do
v <- mkVty
DisplayRegion w h <- display_bounds $ terminal v
let opts' = SubTotal:opts
@ -63,7 +63,7 @@ vty opts args l = do
,amsg=helpmsg
,aopts=opts'
,aargs=args
,aledger=l
,ajournal=j
,abuf=[]
,alocs=[]
}
@ -227,11 +227,11 @@ resetTrailAndEnter t scr a = enter t scr (aargs a) $ clearLocs a
-- | Regenerate the display data appropriate for the current screen.
updateData :: LocalTime -> AppState -> AppState
updateData t a@AppState{aopts=opts,aledger=l} =
updateData t a@AppState{aopts=opts,ajournal=j} =
case screen a of
BalanceScreen -> a{abuf=lines $ showBalanceReport opts fspec l}
RegisterScreen -> a{abuf=lines $ showRegisterReport opts fspec l}
PrintScreen -> a{abuf=lines $ showTransactions fspec l}
BalanceScreen -> a{abuf=lines $ showBalanceReport opts fspec j}
RegisterScreen -> a{abuf=lines $ showRegisterReport opts fspec j}
PrintScreen -> a{abuf=lines $ showTransactions fspec j}
where fspec = optsToFilterSpec opts (currentArgs a) t
backout :: LocalTime -> AppState -> AppState
@ -285,9 +285,9 @@ scrollToTransaction (Just t) a@AppState{abuf=buf} = setCursorY cy $ setScrollY s
-- the cursor on the register screen (or best guess). Results undefined
-- while on other screens.
currentTransaction :: AppState -> Maybe Transaction
currentTransaction a@AppState{aledger=l,abuf=buf} = ptransaction p
currentTransaction a@AppState{ajournal=j,abuf=buf} = ptransaction p
where
p = headDef nullposting $ filter ismatch $ ledgerPostings l
p = headDef nullposting $ filter ismatch $ journalPostings j
ismatch p = postingDate p == parsedate (take 10 datedesc)
&& take 70 (showPostingWithBalance False p nullmixedamt) == (datedesc ++ acctamt)
datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ headDef "" rest : reverse above

84
Hledger/Cli/Commands/Web.hs
View File

@ -38,7 +38,7 @@ import Network.Loli.Utils (update)
import HSP hiding (Request,catch)
import qualified HSP (Request(..))
import Hledger.Cli.Commands.Add (ledgerAddTransaction)
import Hledger.Cli.Commands.Add (journalAddTransaction)
import Hledger.Cli.Commands.Balance
import Hledger.Cli.Commands.Histogram
import Hledger.Cli.Commands.Print
@ -60,22 +60,22 @@ tcpport = 5000 :: Int
homeurl = printf "http://localhost:%d/" tcpport
browserdelay = 100000 -- microseconds
web :: [Opt] -> [String] -> Ledger -> IO ()
web opts args l = do
web :: [Opt] -> [String] -> Journal -> IO ()
web opts args j = do
unless (Debug `elem` opts) $ forkIO browser >> return ()
server opts args l
server opts args j
browser :: IO ()
browser = putStrLn "starting web browser" >> threadDelay browserdelay >> openBrowserOn homeurl >> return ()
server :: [Opt] -> [String] -> Ledger -> IO ()
server opts args l =
server :: [Opt] -> [String] -> Journal -> IO ()
server opts args j =
-- server initialisation
withStore "hledger" $ do -- IO ()
printf "starting web server on port %d\n" tcpport
t <- getCurrentLocalTime
webfiles <- getDataFileName "web"
putValue "hledger" "ledger" l
putValue "hledger" "journal" j
#ifdef WEBHAPPSTACK
hostname <- readProcess "hostname" [] "" `catch` \_ -> return "hostname"
runWithConfig (ServerConf tcpport hostname) $ -- (Env -> IO Response) -> IO ()
@ -88,18 +88,18 @@ server opts args l =
p = intercalate "+" $ reqparam env "p"
opts' = opts ++ [Period p]
args' = args ++ (map urlDecode $ words a)
l' <- fromJust `fmap` getValue "hledger" "ledger"
l'' <- reloadIfChanged opts' args' l'
j' <- fromJust `fmap` getValue "hledger" "journal"
j'' <- journalReloadIfChanged opts' args' j'
-- declare path-specific request handlers
let command :: [String] -> ([Opt] -> FilterSpec -> Ledger -> String) -> AppUnit
command msgs f = string msgs $ f opts' (optsToFilterSpec opts' args' t) l''
let command :: [String] -> ([Opt] -> FilterSpec -> Journal -> String) -> AppUnit
command msgs f = string msgs $ f opts' (optsToFilterSpec opts' args' t) j''
(loli $ -- State Loli () -> (Env -> IO Response)
do
get "/balance" $ command [] showBalanceReport -- String -> ReaderT Env (StateT Response IO) () -> State Loli ()
get "/register" $ command [] showRegisterReport
get "/histogram" $ command [] showHistogram
get "/transactions" $ ledgerpage [] l'' (showTransactions (optsToFilterSpec opts' args' t))
post "/transactions" $ handleAddform l''
get "/transactions" $ ledgerpage [] j'' (showTransactions (optsToFilterSpec opts' args' t))
post "/transactions" $ handleAddform j''
get "/env" $ getenv >>= (text . show)
get "/params" $ getenv >>= (text . show . Hack.Contrib.Request.params)
get "/inputs" $ getenv >>= (text . show . Hack.Contrib.Request.inputs)
@ -118,41 +118,33 @@ reqparam env p = map snd $ filter ((==p).fst) $ Hack.Contrib.Request.params env
reqparam env p = map (decodeString.snd) $ filter ((==p).fst) $ Hack.Contrib.Request.params env
#endif
ledgerFileModifiedTime :: Ledger -> IO ClockTime
ledgerFileModifiedTime l
| null path = getClockTime
| otherwise = getModificationTime path `Prelude.catch` \_ -> getClockTime
where path = filepath $ journal l
ledgerFileReadTime :: Ledger -> ClockTime
ledgerFileReadTime l = filereadtime $ journal l
reload :: Ledger -> IO Ledger
reload l = do
l' <- readLedger (filepath $ journal l)
putValue "hledger" "ledger" l'
return l'
reloadIfChanged :: [Opt] -> [String] -> Ledger -> IO Ledger
reloadIfChanged opts _ l = do
tmod <- ledgerFileModifiedTime l
let tread = ledgerFileReadTime l
newer = diffClockTimes tmod tread > (TimeDiff 0 0 0 0 0 0 0)
journalReloadIfChanged :: [Opt] -> [String] -> Journal -> IO Journal
journalReloadIfChanged opts _ j@Journal{filepath=f,filereadtime=tread} = do
tmod <- journalFileModifiedTime j
let newer = diffClockTimes tmod tread > (TimeDiff 0 0 0 0 0 0 0)
-- 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 $ journal l)
reload l
else return l
when (Verbose `elem` opts) $ printf "%s has changed, reloading\n" f
reload j
else return j
-- refilter :: [Opt] -> [String] -> Ledger -> LocalTime -> IO Ledger
-- refilter opts args l t = return $ filterAndCacheLedgerWithOpts opts args t (jtext $ journal l) (journal l)
journalFileModifiedTime :: Journal -> IO ClockTime
journalFileModifiedTime Journal{filepath=f}
| null f = getClockTime
| otherwise = getModificationTime f `Prelude.catch` \_ -> getClockTime
ledgerpage :: [String] -> Ledger -> (Ledger -> String) -> AppUnit
ledgerpage msgs l f = do
reload :: Journal -> IO Journal
reload Journal{filepath=f} = do
j' <- readJournal f
putValue "hledger" "journal" j'
return j'
ledgerpage :: [String] -> Journal -> (Journal -> String) -> AppUnit
ledgerpage msgs j f = do
env <- getenv
l' <- io $ reloadIfChanged [] [] l
hsp msgs $ const <div><% addform env %><pre><% f l' %></pre></div>
j' <- io $ journalReloadIfChanged [] [] j
hsp msgs $ const <div><% addform env %><pre><% f j' %></pre></div>
-- | A loli directive to serve a string in pre tags within the hledger web
-- layout.
@ -305,8 +297,8 @@ transactionfields n env = do
acctvar = numbered "acct"
amtvar = numbered "amt"
handleAddform :: Ledger -> AppUnit
handleAddform l = do
handleAddform :: Journal -> AppUnit
handleAddform j = do
env <- getenv
d <- io getCurrentDay
t <- io getCurrentLocalTime
@ -380,8 +372,8 @@ handleAddform l = do
handle :: LocalTime -> Failing Transaction -> AppUnit
handle _ (Failure errs) = hsp errs addform
handle ti (Success t) = do
io $ ledgerAddTransaction l t >> reload l
ledgerpage [msg] l (showTransactions (optsToFilterSpec [] [] ti))
io $ journalAddTransaction j t >> reload j
ledgerpage [msg] j (showTransactions (optsToFilterSpec [] [] ti))
where msg = printf "Added transaction:\n%s" (show t)
nbsp :: XML

26
Hledger/Cli/Main.hs
View File

@ -20,8 +20,8 @@ You can use the command line:
or ghci:
> $ ghci hledger
> > l <- readLedger "sample.ledger"
> > register [] ["income","expenses"] l
> > j <- readJournal "data/sample.journal"
> > register [] ["income","expenses"] j
> 2008/01/01 income income:salary $-1 $-1
> 2008/06/01 gift income:gifts $-1 $-2
> 2008/06/03 eat & shop expenses:food $1 $-1
@ -48,7 +48,7 @@ import Hledger.Cli.Commands.All
import Hledger.Data
import Hledger.Cli.Options
import Hledger.Cli.Tests
import Hledger.Cli.Utils (withLedgerDo)
import Hledger.Cli.Utils (withJournalDo)
import Hledger.Cli.Version (versionmsg, binaryfilename)
main :: IO ()
@ -60,21 +60,21 @@ main = do
| Help `elem` opts = putStr usage
| Version `elem` opts = putStrLn versionmsg
| BinaryFilename `elem` opts = putStrLn binaryfilename
| cmd `isPrefixOf` "balance" = withLedgerDo opts args cmd balance
| cmd `isPrefixOf` "convert" = withLedgerDo opts args cmd convert
| cmd `isPrefixOf` "print" = withLedgerDo opts args cmd print'
| cmd `isPrefixOf` "register" = withLedgerDo opts args cmd register
| cmd `isPrefixOf` "histogram" = withLedgerDo opts args cmd histogram
| cmd `isPrefixOf` "add" = withLedgerDo opts args cmd add
| cmd `isPrefixOf` "stats" = withLedgerDo opts args cmd stats
| cmd `isPrefixOf` "balance" = withJournalDo opts args cmd balance
| cmd `isPrefixOf` "convert" = withJournalDo opts args cmd convert
| cmd `isPrefixOf` "print" = withJournalDo opts args cmd print'
| cmd `isPrefixOf` "register" = withJournalDo opts args cmd register
| cmd `isPrefixOf` "histogram" = withJournalDo opts args cmd histogram
| cmd `isPrefixOf` "add" = withJournalDo opts args cmd add
| cmd `isPrefixOf` "stats" = withJournalDo opts args cmd stats
#ifdef VTY
| cmd `isPrefixOf` "vty" = withLedgerDo opts args cmd vty
| cmd `isPrefixOf` "vty" = withJournalDo opts args cmd vty
#endif
#if defined(WEB) || defined(WEBHAPPSTACK)
| cmd `isPrefixOf` "web" = withLedgerDo opts args cmd web
| cmd `isPrefixOf` "web" = withJournalDo opts args cmd web
#endif
#ifdef CHART
| cmd `isPrefixOf` "chart" = withLedgerDo opts args cmd chart
| cmd `isPrefixOf` "chart" = withJournalDo opts args cmd chart
#endif
| cmd `isPrefixOf` "test" = runtests opts args >> return ()
| otherwise = putStr usage

6
Hledger/Cli/Options.hs
View File

@ -228,9 +228,9 @@ usingTimeProgramName = do
progname <- getProgName
return $ map toLower progname == timeprogname
-- | Get the ledger file path from options, an environment variable, or a default
ledgerFilePathFromOpts :: [Opt] -> IO String
ledgerFilePathFromOpts opts = do
-- | Get the journal file path from options, an environment variable, or a default
journalFilePathFromOpts :: [Opt] -> IO String
journalFilePathFromOpts opts = do
istimequery <- usingTimeProgramName
f <- if istimequery then myTimelogPath else myLedgerPath
return $ last $ f : optValuesForConstructor File opts

25
Hledger/Cli/Tests.hs
View File

@ -237,14 +237,14 @@ tests = TestList [
,""
]
let j' = journalCanonicaliseAmounts $ journalConvertAmountsToCost j -- enable cost basis adjustment
showBalanceReport [] nullfilterspec nullledger{journal=j'} `is`
showBalanceReport [] nullfilterspec j' `is`
unlines
[" $500 a:b"
," $-500 c:d"
]
,"balance report elides zero-balance root account(s)" ~: do
l <- ledgerFromStringWithOpts []
l <- journalFromStringWithOpts []
(unlines
["2008/1/1 one"
," test:a 1"
@ -282,9 +282,6 @@ tests = TestList [
Right e' -> (pamount $ last $ tpostings e')
Left _ -> error "should not happen")
-- ,"cacheLedger" ~:
-- length (Map.keys $ accountmap $ cacheLedger journal7) `is` 15
,"journalCanonicaliseAmounts" ~:
"use the greatest precision" ~:
(map precision $ journalAmountAndPriceCommodities $ journalCanonicaliseAmounts $ journalWithAmounts ["1","2.00"]) `is` [2,2]
@ -471,7 +468,7 @@ tests = TestList [
,"register report with cleared option" ~:
do
let opts = [Cleared]
l <- ledgerFromStringWithOpts opts sample_ledger_str
l <- journalFromStringWithOpts opts sample_ledger_str
showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines
["2008/06/03 eat & shop expenses:food $1 $1"
," expenses:supplies $1 $2"
@ -483,7 +480,7 @@ tests = TestList [
,"register report with uncleared option" ~:
do
let opts = [UnCleared]
l <- ledgerFromStringWithOpts opts sample_ledger_str
l <- journalFromStringWithOpts opts sample_ledger_str
showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines
["2008/01/01 income assets:bank:checking $1 $1"
," income:salary $-1 0"
@ -495,7 +492,7 @@ tests = TestList [
,"register report sorts by date" ~:
do
l <- ledgerFromStringWithOpts [] $ unlines
l <- journalFromStringWithOpts [] $ unlines
["2008/02/02 a"
," b 1"
," c"
@ -580,14 +577,14 @@ tests = TestList [
,"show hours" ~: show (hours 1) ~?= "1.0h"
,"unicode in balance layout" ~: do
l <- ledgerFromStringWithOpts []
l <- journalFromStringWithOpts []
"2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
showBalanceReport [] (optsToFilterSpec [] [] t1) l `is` unlines
[" -100 актив:наличные"
," 100 расходы:покупки"]
,"unicode in register layout" ~: do
l <- ledgerFromStringWithOpts []
l <- journalFromStringWithOpts []
"2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n"
showRegisterReport [] (optsToFilterSpec [] [] t1) l `is` unlines
["2009/01/01 медвежья шкура расходы:покупки 100 100"
@ -629,7 +626,7 @@ tests = TestList [
-- "next january" `gives` "2009/01/01"
,"subAccounts" ~: do
l <- liftM (filterAndCacheLedger nullfilterspec) sampleledger
l <- liftM (journalToLedger nullfilterspec) sampleledger
let a = ledgerAccount l "assets"
map aname (ledgerSubAccounts l a) `is` ["assets:bank","assets:cash"]
@ -676,8 +673,8 @@ tests = TestList [
date1 = parsedate "2008/11/26"
t1 = LocalTime date1 midday
sampleledger = ledgerFromStringWithOpts [] sample_ledger_str
sampleledgerwithopts opts _ = ledgerFromStringWithOpts opts sample_ledger_str
sampleledger = journalFromStringWithOpts [] sample_ledger_str
sampleledgerwithopts opts _ = journalFromStringWithOpts opts sample_ledger_str
sample_ledger_str = unlines
["; A sample ledger file."
@ -1050,7 +1047,7 @@ journal7 = Journal
(TOD 0 0)
""
ledger7 = filterAndCacheLedger nullfilterspec $ makeUncachedLedger journal7
ledger7 = journalToLedger nullfilterspec journal7
ledger8_str = unlines
["2008/1/1 test "

40
Hledger/Cli/Utils.hs
View File

@ -7,10 +7,15 @@ Hledger.Data.Utils.
-}
module Hledger.Cli.Utils
(
withJournalDo,
journalFromStringWithOpts,
openBrowserOn
)
where
import Control.Monad.Error
import Hledger.Data
import Hledger.Cli.Options (Opt(..),ledgerFilePathFromOpts) -- ,optsToFilterSpec)
import Hledger.Cli.Options (Opt(..),journalFilePathFromOpts) -- ,optsToFilterSpec)
import System.Directory (doesFileExist)
import System.IO (stderr)
#if __GLASGOW_HASKELL__ <= 610
@ -23,42 +28,29 @@ import System.Process (readProcessWithExitCode)
import System.Info (os)
-- | Parse the user's specified ledger file and run a hledger command on
-- | Parse the user's specified journal file and run a hledger command on
-- it, or report a parse error. This function makes the whole thing go.
-- The command will receive an uncached/unfiltered ledger, so should
-- process it further if needed.
withLedgerDo :: [Opt] -> [String] -> String -> ([Opt] -> [String] -> UncachedLedger -> IO ()) -> IO ()
withLedgerDo opts args cmdname cmd = do
withJournalDo :: [Opt] -> [String] -> String -> ([Opt] -> [String] -> Journal -> IO ()) -> IO ()
withJournalDo opts args cmdname cmd = do
-- We kludgily read the file before parsing to grab the full text, unless
-- it's stdin, or it doesn't exist and we are adding. We read it strictly
-- to let the add command work.
f <- ledgerFilePathFromOpts opts
f <- journalFilePathFromOpts opts
fileexists <- doesFileExist f
let creating = not fileexists && cmdname == "add"
cost = CostBasis `elem` opts
let runcmd = cmd opts args . makeUncachedLedger . (if cost then journalConvertAmountsToCost else id)
costify = (if CostBasis `elem` opts then journalConvertAmountsToCost else id)
runcmd = cmd opts args . costify
if creating
then runcmd nulljournal
else (runErrorT . parseJournalFile) f >>= either parseerror runcmd
where parseerror e = hPutStrLn stderr e >> exitWith (ExitFailure 1)
-- | Get an uncached ledger from the given string and options, or raise an error.
ledgerFromStringWithOpts :: [Opt] -> String -> IO UncachedLedger
ledgerFromStringWithOpts opts s = do
-- | Get a journal from the given string and options, or throw an error.
journalFromStringWithOpts :: [Opt] -> String -> IO Journal
journalFromStringWithOpts opts s = do
j <- journalFromString s
let cost = CostBasis `elem` opts
return $ makeUncachedLedger $ (if cost then journalConvertAmountsToCost else id) j
-- -- | Read a ledger from the given file, or give an error.
-- readLedgerWithOpts :: [Opt] -> [String] -> FilePath -> IO Ledger
-- readLedgerWithOpts opts args f = do
-- t <- getCurrentLocalTime
-- readLedger f
-- -- | 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 -> Journal -> Ledger
-- filterAndCacheLedgerWithOpts opts args = filterAndCacheLedger . optsToFilterSpec opts args
return $ (if cost then journalConvertAmountsToCost else id) j
-- | Attempt to open a web browser on the given url, all platforms.
openBrowserOn :: String -> IO ExitCode

33
hledger-lib/Hledger/Data/IO.hs
View File

@ -6,9 +6,8 @@ Utilities for doing I/O with ledger files.
module Hledger.Data.IO
where
import Control.Monad.Error
import Hledger.Data.Ledger (makeUncachedLedger)
import Hledger.Data.Parse (parseJournal)
import Hledger.Data.Types (FilterSpec(..),WhichDate(..),Journal(..),Ledger(..))
import Hledger.Data.Types (FilterSpec(..),WhichDate(..),Journal(..))
import Hledger.Data.Dates (nulldatespan)
import System.Directory (getHomeDirectory)
import System.Environment (getEnv)
@ -52,32 +51,22 @@ myTimelogPath =
home <- getHomeDirectory
return $ home </> timelogdefaultfilename)
-- | Read the user's default ledger file, or give an error.
myLedger :: IO Ledger
myLedger = myLedgerPath >>= readLedger
-- | Read the user's default journal file, or give an error.
myJournal :: IO Journal
myJournal = myLedgerPath >>= readJournal
-- | Read the user's default timelog file, or give an error.
myTimelog :: IO Ledger
myTimelog = myTimelogPath >>= readLedger
myTimelog :: IO Journal
myTimelog = myTimelogPath >>= readJournal
-- | Read an unfiltered, uncached ledger from this file, or give an error.
readLedger :: FilePath -> IO Ledger
readLedger f = do
-- | Read a journal from this file, or give an error.
readJournal :: FilePath -> IO Journal
readJournal f = do
s <- readFile f
j <- journalFromString s
return $ makeUncachedLedger j
-- -- | Read a ledger from this file, filtering according to the filter spec.,
-- -- | or give an error.
-- readLedgerWithFilterSpec :: FilterSpec -> FilePath -> IO Ledger
-- readLedgerWithFilterSpec fspec f = do
-- s <- readFile f
-- t <- getClockTime
-- j <- journalFromString s
-- return $ filterAndCacheLedger fspec s j{filepath=f, filereadtime=t}
journalFromString s
-- | Read a Journal from the given string, using the current time as
-- reference time, or give a parse error.
-- reference time, or throw an error.
journalFromString :: String -> IO Journal
journalFromString s = liftM (either error id) $ runErrorT $ parseJournal "(string)" s

5
hledger-lib/Hledger/Data/Journal.hs
View File

@ -1,8 +1,7 @@
{-|
A 'Journal' is a parsed ledger file, containing 'Transaction's.
It can be filtered and massaged in various ways, then \"crunched\"
to form a 'Ledger'.
A 'Journal' is a set of 'Transaction's and related data, usually parsed
from a hledger/ledger journal file or timelog.
-}

66
hledger-lib/Hledger/Data/Ledger.hs
View File

@ -1,53 +1,9 @@
{-|
A compound data type for efficiency. A 'Ledger' caches information derived
from a 'Journal' for easier querying. Also it typically has had
uninteresting 'Transaction's and 'Posting's filtered out. It
contains:
- the original unfiltered 'Journal'
- a tree of 'AccountName's
- a map from account names to 'Account's
- the full text of the journal file, when available
This is the main object you'll deal with as a user of the Ledger
library. The most useful functions also have shorter, lower-case
aliases for easier interaction. Here's an example:
> > import Hledger.Data
> > l <- readLedger "sample.ledger"
> > accountnames l
> ["assets","assets:bank","assets:bank:checking","assets:bank:saving",...
> > accounts l
> [Account assets with 0 txns and $-1 balance,Account assets:bank with...
> > topaccounts l
> [Account assets with 0 txns and $-1 balance,Account expenses with...
> > account l "assets"
> Account assets with 0 txns and $-1 balance
> > accountsmatching ["ch"] l
> accountsmatching ["ch"] l
> [Account assets:bank:checking with 4 txns and $0 balance]
> > subaccounts l (account l "assets")
> subaccounts l (account l "assets")
> [Account assets:bank with 0 txns and $1 balance,Account assets:cash...
> > head $ transactions l
> 2008/01/01 income assets:bank:checking $1 RegularPosting
> > accounttree 2 l
> Node {rootLabel = Account top with 0 txns and 0 balance, subForest = [...
> > accounttreeat l (account l "assets")
> Just (Node {rootLabel = Account assets with 0 txns and $-1 balance, ...
> > datespan l -- disabled
> DateSpan (Just 2008-01-01) (Just 2009-01-01)
> > rawdatespan l
> DateSpan (Just 2008-01-01) (Just 2009-01-01)
> > ledgeramounts l
> [$1,$-1,$1,$-1,$1,$-1,$1,$1,$-2,$1,$-1]
> > commodities l
> [Commodity {symbol = "$", side = L, spaced = False, comma = False, ...
A 'Ledger' is derived from a 'Journal' by applying a filter specification
to select 'Transaction's and 'Posting's of interest. It contains the
filtered journal and knows the resulting chart of accounts, account
balances, and postings in each account.
-}
@ -77,23 +33,17 @@ nullledger = Ledger{
accountmap = fromList []
}
-- | Generate a ledger from a journal, but don't cache it yet.
makeUncachedLedger :: Journal -> UncachedLedger
makeUncachedLedger j = nullledger{journal=j}
-- | Filter a ledger's transactions as specified and generate derived data.
filterAndCacheLedger :: FilterSpec -> UncachedLedger -> Ledger
filterAndCacheLedger filterspec l@Ledger{journal=j} = l{journal=j',accountnametree=t,accountmap=m}
where j' = filterJournalPostings filterspec{depth=Nothing} j
journalToLedger :: FilterSpec -> Journal -> Ledger
journalToLedger fs j = nullledger{journal=j',accountnametree=t,accountmap=m}
where j' = filterJournalPostings fs{depth=Nothing} j
(t, m) = journalAccountInfo j'
-- | List a ledger's account names.
ledgerAccountNames :: Ledger -> [AccountName]
ledgerAccountNames = drop 1 . flatten . accountnametree
-- | Get the named account from a (cached) ledger.
-- If the ledger has not been cached (with crunchJournal or
-- cacheLedger'), this returns the null account.
-- | Get the named account from a ledger.
ledgerAccount :: Ledger -> AccountName -> Account
ledgerAccount l a = findWithDefault nullacct a $ accountmap l

50
hledger-lib/Hledger/Data/Types.hs
View File

@ -4,26 +4,31 @@
Most data types are defined here to avoid import cycles.
Here is an overview of the hledger data model:
> Ledger -- hledger's ledger is a journal file plus cached/derived data
> Journal -- a representation of the journal file, containing..
> [Transaction] -- ..journal transactions, which have date, status, code, description and..
> [Posting] -- ..two or more account postings (account name and amount)
> Tree AccountName -- all account names as a tree
> Map AccountName Account -- a map from account name to account info (postings and balances)
> Journal -- a journal is derived from one or more data files. It contains..
> [Transaction] -- journal transactions, which have date, status, code, description and..
> [Posting] -- multiple account postings (entries), which have account name and amount.
> [HistoricalPrice] -- historical commodity prices
>
> Ledger -- a ledger is derived from a journal, by applying a filter specification. It contains..
> Journal -- the filtered journal, containing only the transactions and postings we are interested in
> Tree AccountName -- account names referenced in the journal's transactions, as a tree
> Map AccountName Account -- per-account postings and balances from the journal's transactions, as a map from account name to account info
For more detailed documentation on each type, see the corresponding modules.
Terminology has been in flux:
Evolution of transaction/entry/posting terminology:
- ledger 2 had entries containing transactions.
- ledger 2: entries contain transactions
- hledger 0.4 had Entrys containing RawTransactions, which were flattened to Transactions.
- hledger 0.4: Entrys contain RawTransactions (which are flattened to Transactions)
- ledger 3 has transactions containing postings.
- ledger 3: transactions contain postings
- hledger 0.5 had LedgerTransactions containing Postings, which were flattened to Transactions.
- hledger 0.5: LedgerTransactions contain Postings (which are flattened to Transactions)
- hledger 0.8 has Transactions containing Postings, and no flattened type.
- hledger 0.8: Transactions contain Postings (referencing Transactions, corecursively)
- hledger 0.10: Postings should be called Entrys, but are left as-is for now
-}
@ -123,7 +128,13 @@ data Journal = Journal {
filepath :: FilePath,
filereadtime :: ClockTime,
jtext :: String
} deriving (Eq)
} deriving (Eq, Typeable)
data Ledger = Ledger {
journal :: Journal,
accountnametree :: Tree AccountName,
accountmap :: Map.Map AccountName Account
}
data Account = Account {
aname :: AccountName,
@ -131,18 +142,7 @@ data Account = Account {
abalance :: MixedAmount -- ^ sum of postings in this account and subaccounts
}
data Ledger = Ledger {
journal :: Journal,
accountnametree :: Tree AccountName,
accountmap :: Map.Map AccountName Account
} 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.
-- This exists to keep app-specific options out of the hledger library.
-- | A generic, pure specification of how to filter transactions and postings.
data FilterSpec = FilterSpec {
datespan :: DateSpan -- ^ only include if in this date span
,cleared :: Maybe Bool -- ^ only include if cleared\/uncleared\/don't care