web: offer a choice of files to edit when there are multiple (included) files
This commit is contained in:
parent
78db98366f
commit
7714bab58d
@ -10,6 +10,7 @@ module Hledger.Data.Journal
|
||||
where
|
||||
import qualified Data.Map as Map
|
||||
import Data.Map (findWithDefault, (!))
|
||||
import Safe (headDef)
|
||||
import System.Time (ClockTime(TOD))
|
||||
import Hledger.Data.Utils
|
||||
import Hledger.Data.Types
|
||||
@ -24,7 +25,7 @@ import Hledger.Data.TimeLog
|
||||
|
||||
instance Show Journal where
|
||||
show j = printf "Journal %s with %d transactions, %d accounts: %s"
|
||||
(filepath j)
|
||||
(journalFilePath j)
|
||||
(length (jtxns j) +
|
||||
length (jmodifiertxns j) +
|
||||
length (jperiodictxns j))
|
||||
@ -40,10 +41,8 @@ nulljournal = Journal { jmodifiertxns = []
|
||||
, open_timelog_entries = []
|
||||
, historical_prices = []
|
||||
, final_comment_lines = []
|
||||
, filepath = ""
|
||||
, allfilepaths = []
|
||||
, files = []
|
||||
, filereadtime = TOD 0 0
|
||||
, jtext = ""
|
||||
}
|
||||
|
||||
nullfilterspec = FilterSpec {
|
||||
@ -58,6 +57,15 @@ nullfilterspec = FilterSpec {
|
||||
,depth=Nothing
|
||||
}
|
||||
|
||||
journalFilePath :: Journal -> FilePath
|
||||
journalFilePath = fst . mainfile
|
||||
|
||||
journalFilePaths :: Journal -> [FilePath]
|
||||
journalFilePaths = map fst . files
|
||||
|
||||
mainfile :: Journal -> (FilePath, String)
|
||||
mainfile = headDef ("", "") . files
|
||||
|
||||
addTransaction :: Transaction -> Journal -> Journal
|
||||
addTransaction t l0 = l0 { jtxns = t : jtxns l0 }
|
||||
|
||||
@ -214,10 +222,11 @@ journalSelectingDate EffectiveDate j =
|
||||
|
||||
-- | Do post-parse processing on a journal, to make it ready for use.
|
||||
journalFinalise :: ClockTime -> LocalTime -> FilePath -> String -> Journal -> Journal
|
||||
journalFinalise tclock tlocal path txt j = journalCanonicaliseAmounts $
|
||||
journalApplyHistoricalPrices $
|
||||
journalCloseTimeLogEntries tlocal
|
||||
j{filepath=path, allfilepaths=path:(allfilepaths j), filereadtime=tclock, jtext=txt}
|
||||
journalFinalise tclock tlocal path txt j@Journal{files=fs} =
|
||||
journalCanonicaliseAmounts $
|
||||
journalApplyHistoricalPrices $
|
||||
journalCloseTimeLogEntries tlocal
|
||||
j{files=(path,txt):fs, filereadtime=tclock}
|
||||
|
||||
-- | Convert all the journal's amounts to their canonical display
|
||||
-- settings. Ie, all amounts in a given commodity will use (a) the
|
||||
|
||||
@ -128,10 +128,11 @@ data Journal = Journal {
|
||||
open_timelog_entries :: [TimeLogEntry],
|
||||
historical_prices :: [HistoricalPrice],
|
||||
final_comment_lines :: String, -- ^ any trailing comments from the journal file
|
||||
filepath :: FilePath, -- ^ file path of this journal
|
||||
allfilepaths :: [FilePath], -- ^ file paths of this and any included journals
|
||||
filereadtime :: ClockTime, -- ^ when this journal was read from its file
|
||||
jtext :: String -- ^ the raw text read from the journal's file
|
||||
files :: [(FilePath, String)], -- ^ the file path and raw text of the main and
|
||||
-- any included journal files. The main file is
|
||||
-- first followed by any included files in the
|
||||
-- order encountered.
|
||||
filereadtime :: ClockTime -- ^ when this journal was last read from its file(s)
|
||||
} deriving (Eq, Typeable)
|
||||
|
||||
data Ledger = Ledger {
|
||||
|
||||
@ -26,7 +26,6 @@ module Test.HUnit,
|
||||
where
|
||||
import Data.Char
|
||||
import Codec.Binary.UTF8.String as UTF8 (decodeString, encodeString, isUTF8Encoded)
|
||||
import Control.Exception
|
||||
import Control.Monad
|
||||
import Data.List
|
||||
--import qualified Data.Map as Map
|
||||
@ -361,9 +360,6 @@ isLeft _ = False
|
||||
isRight :: Either a b -> Bool
|
||||
isRight = not . isLeft
|
||||
|
||||
strictReadFile :: FilePath -> IO String
|
||||
strictReadFile f = readFile f >>= \s -> Control.Exception.evaluate (length s) >> return s
|
||||
|
||||
-- -- | Expand ~ in a file path (does not handle ~name).
|
||||
-- tildeExpand :: FilePath -> IO FilePath
|
||||
-- tildeExpand ('~':[]) = getHomeDirectory
|
||||
|
||||
@ -107,6 +107,7 @@ module Hledger.Read.Journal (
|
||||
tests_Journal,
|
||||
reader,
|
||||
journalFile,
|
||||
journalAddFile,
|
||||
someamount,
|
||||
ledgeraccountname,
|
||||
ledgerExclamationDirective,
|
||||
@ -150,7 +151,9 @@ detect f _ = fileSuffix f == format
|
||||
-- | Parse and post-process a "Journal" from hledger's journal file
|
||||
-- format, or give an error.
|
||||
parse :: FilePath -> String -> ErrorT String IO Journal
|
||||
parse = parseJournalWith journalFile
|
||||
parse = do
|
||||
j <- parseJournalWith journalFile
|
||||
return j
|
||||
|
||||
-- | Top-level journal parser. Returns a single composite, I/O performing,
|
||||
-- error-raising "JournalUpdate" which can be applied to an empty journal
|
||||
@ -176,8 +179,8 @@ journalFile = do journalupdates <- many journalItem
|
||||
, emptyLine >> return (return id)
|
||||
] <?> "journal transaction or directive"
|
||||
|
||||
journalAddFilePath :: FilePath -> Journal -> Journal
|
||||
journalAddFilePath f j@Journal{allfilepaths=fs} = j{allfilepaths=fs++[f]}
|
||||
journalAddFile :: (FilePath,String) -> Journal -> Journal
|
||||
journalAddFile f j@Journal{files=fs} = j{files=fs++[f]}
|
||||
|
||||
emptyLine :: GenParser Char JournalContext ()
|
||||
emptyLine = do many spacenonewline
|
||||
@ -218,10 +221,10 @@ ledgerInclude = do
|
||||
outerState <- getState
|
||||
outerPos <- getPosition
|
||||
return $ do filepath <- expandPath outerPos filename
|
||||
contents <- readFileOrError outerPos filepath
|
||||
txt <- readFileOrError outerPos filepath
|
||||
let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n"
|
||||
case runParser journalFile outerState filepath contents of
|
||||
Right ju -> juSequence [return $ journalAddFilePath filepath, ju] `catchError` (throwError . (inIncluded ++))
|
||||
case runParser journalFile outerState filepath txt of
|
||||
Right ju -> juSequence [return $ journalAddFile (filepath,txt), ju] `catchError` (throwError . (inIncluded ++))
|
||||
Left err -> throwError $ inIncluded ++ show err
|
||||
where readFileOrError pos fp =
|
||||
ErrorT $ liftM Right (readFile fp) `catch`
|
||||
|
||||
@ -27,7 +27,7 @@ import Yesod.Helpers.Auth
|
||||
import Text.Hamlet (defaultHamletSettings)
|
||||
import Text.Hamlet.RT
|
||||
|
||||
import Hledger.Cli.Commands.Add (journalAddTransaction)
|
||||
import Hledger.Cli.Commands.Add (appendToJournalFile)
|
||||
import Hledger.Cli.Commands.Balance
|
||||
import Hledger.Cli.Commands.Print
|
||||
import Hledger.Cli.Commands.Register
|
||||
@ -339,7 +339,7 @@ navbar TD{p=p,j=j,today=today} = [$hamlet|
|
||||
journalTitleDesc :: Journal -> String -> Day -> (String, String)
|
||||
journalTitleDesc j p today = (title, desc)
|
||||
where
|
||||
title = printf "%s" (takeFileName $ filepath j) :: String
|
||||
title = printf "%s" (takeFileName $ journalFilePath j) :: String
|
||||
desc = printf "%s" (showspan span) :: String
|
||||
span = either (const $ DateSpan Nothing Nothing) snd (parsePeriodExpr today p)
|
||||
showspan (DateSpan Nothing Nothing) = ""
|
||||
@ -503,7 +503,7 @@ getJournalR = do
|
||||
br = balanceReportAsHtml opts td $ balanceReport opts fspec j
|
||||
jr = journalReportAsHtml opts td $ journalReport opts fspec j
|
||||
td = mktd{here=here, title="hledger journal", msg=msg, a=a, p=p, j=j, today=today}
|
||||
editform' = editform td $ jtext j
|
||||
editform' = editform td
|
||||
hamletToRepHtml $ pageLayout td [$hamlet|
|
||||
%div.ledger
|
||||
%div.accounts!style=float:left; ^br^
|
||||
@ -534,7 +534,7 @@ getRegisterR = do
|
||||
br = balanceReportAsHtml opts td $ balanceReport opts fspec j
|
||||
rr = registerReportAsHtml opts td $ registerReport opts fspec j
|
||||
td = mktd{here=here, title="hledger register", msg=msg, a=a, p=p, j=j, today=today}
|
||||
editform' = editform td $ jtext j
|
||||
editform' = editform td
|
||||
hamletToRepHtml $ pageLayout td [$hamlet|
|
||||
%div.ledger
|
||||
%div.accounts!style=float:left; ^br^
|
||||
@ -635,7 +635,7 @@ getJournalOnlyR = do
|
||||
(a, p, opts, fspec, j, msg, here) <- getHandlerData
|
||||
today <- liftIO getCurrentDay
|
||||
let td = mktd{here=here, title="hledger journal", msg=msg, a=a, p=p, j=j, today=today}
|
||||
editform' = editform td $ jtext j
|
||||
editform' = editform td
|
||||
txns = journalReportAsHtml opts td $ journalReport opts fspec j
|
||||
hamletToRepHtml $ pageLayout td [$hamlet|
|
||||
%div.journal
|
||||
@ -714,6 +714,8 @@ addform td = [$hamlet|
|
||||
%td!colspan=4
|
||||
%input!type=hidden!name=action!value=add
|
||||
%input!type=submit!name=submit!value="add transaction"
|
||||
$if manyfiles
|
||||
\ to: ^journalselect.files.j.td^
|
||||
|]
|
||||
where
|
||||
-- datehelplink = helplink "dates" "..."
|
||||
@ -721,6 +723,7 @@ addform td = [$hamlet|
|
||||
deschelp = "eg: supermarket (optional)"
|
||||
date = "today"
|
||||
descriptions = sort $ nub $ map tdescription $ jtxns $ j td
|
||||
manyfiles = (length $ files $ j td) > 1
|
||||
|
||||
postingsfields :: TemplateData -> Hamlet AppRoute
|
||||
postingsfields td = [$hamlet|
|
||||
@ -732,7 +735,7 @@ postingsfields td = [$hamlet|
|
||||
p2 = postingfields td 2
|
||||
|
||||
postingfields :: TemplateData -> Int -> Hamlet AppRoute
|
||||
postingfields td n = [$hamlet|
|
||||
postingfields TD{j=j} n = [$hamlet|
|
||||
%tr#postingrow
|
||||
%td!align=right $acctlabel$:
|
||||
%td
|
||||
@ -753,7 +756,7 @@ postingfields td n = [$hamlet|
|
||||
numbered = (++ show n)
|
||||
acctvar = numbered "account"
|
||||
amtvar = numbered "amount"
|
||||
acctnames = sort $ journalAccountNamesUsed $ j td
|
||||
acctnames = sort $ journalAccountNamesUsed j
|
||||
(acctlabel, accthelp, amtfield, amthelp)
|
||||
| n == 1 = ("To account"
|
||||
,"eg: expenses:food"
|
||||
@ -771,14 +774,19 @@ postingfields td n = [$hamlet|
|
||||
,""
|
||||
)
|
||||
|
||||
editform :: TemplateData -> String -> Hamlet AppRoute
|
||||
editform _ content = [$hamlet|
|
||||
editform :: TemplateData -> Hamlet AppRoute
|
||||
editform TD{j=j} = [$hamlet|
|
||||
%form#editform!method=POST!style=display:none;
|
||||
%table.form#editform
|
||||
$if manyfiles
|
||||
%tr
|
||||
%td!colspan=2
|
||||
Editing ^journalselect.files.j^
|
||||
%tr
|
||||
%td!colspan=2
|
||||
%textarea!name=text!rows=30!cols=80
|
||||
$content$
|
||||
$forall files.j f
|
||||
%textarea!id=$fst.f$_textarea!name=text!rows=25!cols=80!style=display:none;!disabled=disabled
|
||||
$snd.f$
|
||||
%tr#addbuttonrow
|
||||
%td
|
||||
%span.help ^formathelp^
|
||||
@ -788,10 +796,18 @@ editform _ content = [$hamlet|
|
||||
%input!type=submit!name=submit!value="save journal"
|
||||
\ or $
|
||||
%a!href!onclick="return editformToggle()" cancel
|
||||
|]
|
||||
|] -- XXX textarea ids are unquoted journal file paths, which is not valid html
|
||||
where
|
||||
manyfiles = (length $ files j) > 1
|
||||
formathelp = helplink "file-format" "file format help"
|
||||
|
||||
journalselect :: [(FilePath,String)] -> Hamlet AppRoute
|
||||
journalselect journalfiles = [$hamlet|
|
||||
%select!id=journalselect!name=journal!onchange="editformJournalSelect()"
|
||||
$forall journalfiles f
|
||||
%option!value=$fst.f$ $fst.f$
|
||||
|]
|
||||
|
||||
importform :: Hamlet AppRoute
|
||||
importform = [$hamlet|
|
||||
%form#importform!method=POST!style=display:none;
|
||||
@ -815,17 +831,18 @@ postJournalOnlyR = do
|
||||
-- | Handle a journal add form post.
|
||||
postAddForm :: Handler RepPlain
|
||||
postAddForm = do
|
||||
(_, _, opts, _, _, _, _) <- getHandlerData
|
||||
(_, _, _, _, j, _, _) <- getHandlerData
|
||||
today <- liftIO getCurrentDay
|
||||
-- get form input values. M means a Maybe value.
|
||||
(dateM, descM, acct1M, amt1M, acct2M, amt2M) <- runFormPost'
|
||||
$ (,,,,,)
|
||||
(dateM, descM, acct1M, amt1M, acct2M, amt2M, journalM) <- runFormPost'
|
||||
$ (,,,,,,)
|
||||
<$> maybeStringInput "date"
|
||||
<*> maybeStringInput "description"
|
||||
<*> maybeStringInput "account1"
|
||||
<*> maybeStringInput "amount1"
|
||||
<*> maybeStringInput "account2"
|
||||
<*> maybeStringInput "amount2"
|
||||
<*> maybeStringInput "journal"
|
||||
-- supply defaults and parse date and amounts, or get errors.
|
||||
let dateE = maybe (Left "date required") (either (\e -> Left $ showDateParseError e) Right . fixSmartDateStrEither today) dateM
|
||||
descE = Right $ fromMaybe "" descM
|
||||
@ -833,11 +850,16 @@ postAddForm = do
|
||||
acct2E = maybe (Left "from account required") Right acct2M
|
||||
amt1E = maybe (Left "amount required") (either (const $ Left "could not parse amount") Right . parse someamount "") amt1M
|
||||
amt2E = maybe (Right missingamt) (either (const $ Left "could not parse amount") Right . parse someamount "") amt2M
|
||||
strEs = [dateE, descE, acct1E, acct2E]
|
||||
journalE = maybe (Right $ journalFilePath j)
|
||||
(\f -> if f `elem` journalFilePaths j
|
||||
then Right f
|
||||
else Left $ "unrecognised journal file path: " ++ f)
|
||||
journalM
|
||||
strEs = [dateE, descE, acct1E, acct2E, journalE]
|
||||
amtEs = [amt1E, amt2E]
|
||||
[date,desc,acct1,acct2] = rights strEs
|
||||
[amt1,amt2] = rights amtEs
|
||||
errs = lefts strEs ++ lefts amtEs
|
||||
[date,desc,acct1,acct2,journalpath] = rights strEs
|
||||
[amt1,amt2] = rights amtEs
|
||||
-- if no errors so far, generate a transaction and balance it or get the error.
|
||||
tE | not $ null errs = Left errs
|
||||
| otherwise = either (\e -> Left ["unbalanced postings: " ++ (head $ lines e)]) Right
|
||||
@ -863,46 +885,54 @@ postAddForm = do
|
||||
|
||||
Right t -> do
|
||||
let t' = txnTieKnot t -- XXX move into balanceTransaction
|
||||
j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
|
||||
liftIO $ journalAddTransaction j opts t'
|
||||
liftIO $ appendToJournalFile journalpath $ showTransaction t'
|
||||
setMessage $ string $ printf "Added transaction:\n%s" (show t')
|
||||
redirect RedirectTemporary RegisterR
|
||||
|
||||
-- | Handle a journal edit form post.
|
||||
postEditForm :: Handler RepPlain
|
||||
postEditForm = do
|
||||
-- get form input values, or basic validation errors. E means an Either value.
|
||||
textM <- runFormPost' $ maybeStringInput "text"
|
||||
(_, _, _, _, j, _, _) <- getHandlerData
|
||||
-- get form input values, or validation errors.
|
||||
-- getRequest >>= liftIO (reqRequestBody req) >>= mtrace
|
||||
(textM, journalM) <- runFormPost'
|
||||
$ (,)
|
||||
<$> maybeStringInput "text"
|
||||
<*> maybeStringInput "journal"
|
||||
let textE = maybe (Left "No value provided") Right textM
|
||||
-- display errors or add transaction
|
||||
case textE of
|
||||
Left errs -> do
|
||||
-- XXX should save current form values in session
|
||||
setMessage $ string errs
|
||||
journalE = maybe (Right $ journalFilePath j)
|
||||
(\f -> if f `elem` journalFilePaths j
|
||||
then Right f
|
||||
else Left "unrecognised journal file path")
|
||||
journalM
|
||||
strEs = [textE, journalE]
|
||||
errs = lefts strEs
|
||||
[text,journalpath] = rights strEs
|
||||
-- display errors or perform edit
|
||||
if not $ null errs
|
||||
then do
|
||||
setMessage $ string $ intercalate "; " errs
|
||||
redirect RedirectTemporary JournalR
|
||||
|
||||
Right t' -> do
|
||||
else do
|
||||
-- try to avoid unnecessary backups or saving invalid data
|
||||
j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
|
||||
filechanged' <- liftIO $ journalFileIsNewer j
|
||||
let f = filepath j
|
||||
told = jtext j
|
||||
tnew = filter (/= '\r') t'
|
||||
filechanged' <- liftIO $ journalSpecifiedFileIsNewer j journalpath
|
||||
told <- liftIO $ readFileStrictly journalpath
|
||||
let tnew = filter (/= '\r') text
|
||||
changed = tnew /= told || filechanged'
|
||||
-- changed <- liftIO $ writeFileWithBackupIfChanged f t''
|
||||
if not changed
|
||||
then do
|
||||
setMessage $ string $ "No change"
|
||||
redirect RedirectTemporary JournalR
|
||||
else do
|
||||
jE <- liftIO $ journalFromPathAndString Nothing f tnew
|
||||
jE <- liftIO $ journalFromPathAndString Nothing journalpath tnew
|
||||
either
|
||||
(\e -> do
|
||||
setMessage $ string e
|
||||
redirect RedirectTemporary JournalR)
|
||||
(const $ do
|
||||
liftIO $ writeFileWithBackup f tnew
|
||||
setMessage $ string $ printf "Saved journal %s\n" (show f)
|
||||
liftIO $ writeFileWithBackup journalpath tnew
|
||||
setMessage $ string $ printf "Saved journal %s\n" (show journalpath)
|
||||
redirect RedirectTemporary JournalR)
|
||||
jE
|
||||
|
||||
|
||||
@ -70,6 +70,7 @@ function addformToggle() {
|
||||
function editformToggle() {
|
||||
var a = document.getElementById('addform');
|
||||
var e = document.getElementById('editform');
|
||||
var ej = document.getElementById('journalselect');
|
||||
var f = document.getElementById('filterform');
|
||||
var i = document.getElementById('importform');
|
||||
var t = document.getElementById('transactions');
|
||||
@ -87,9 +88,10 @@ function editformToggle() {
|
||||
jlink.style['font-weight'] = 'normal';
|
||||
rlink.style['font-weight'] = 'normal';
|
||||
a.style.display = 'none';
|
||||
e.style.display = 'block';
|
||||
i.style.display = 'none';
|
||||
t.style.display = 'none';
|
||||
e.style.display = 'block';
|
||||
editformJournalSelect();
|
||||
} else {
|
||||
alink.style['font-weight'] = 'normal';
|
||||
elink.style['font-weight'] = 'normal';
|
||||
@ -102,6 +104,24 @@ function editformToggle() {
|
||||
return false;
|
||||
}
|
||||
|
||||
function editformJournalSelect() {
|
||||
var textareas = $('textarea', $('form#editform'));
|
||||
for (i=0; i<textareas.length; i++) {
|
||||
textareas[i].style.display = 'none';
|
||||
textareas[i].disabled = true;
|
||||
}
|
||||
if (event.target.value) {
|
||||
var journalid = event.target.value+'_textarea';
|
||||
var textarea = document.getElementById(journalid);
|
||||
}
|
||||
else {
|
||||
var textarea = textareas[0];
|
||||
}
|
||||
textarea.style.display = 'block';
|
||||
textarea.disabled = false;
|
||||
return true;
|
||||
}
|
||||
|
||||
function importformToggle() {
|
||||
var a = document.getElementById('addform');
|
||||
var e = document.getElementById('editform');
|
||||
|
||||
@ -36,7 +36,7 @@ add opts args j
|
||||
++"To complete a transaction, enter . as account name. To quit, press control-c."
|
||||
today <- getCurrentDay
|
||||
getAndAddTransactions j opts args today `catch` (\e -> unless (isEOFError e) $ ioError e)
|
||||
where f = filepath j
|
||||
where f = journalFilePath j
|
||||
|
||||
-- | Read a number of transactions from the command line, prompting,
|
||||
-- validating, displaying and appending them to the journal file, until
|
||||
@ -132,30 +132,28 @@ askFor prompt def validator = do
|
||||
Nothing -> return input
|
||||
where showdef s = " [" ++ 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.
|
||||
-- | Append this transaction to the journal's file, and to the journal's
|
||||
-- transaction list.
|
||||
journalAddTransaction :: Journal -> [Opt] -> Transaction -> IO Journal
|
||||
journalAddTransaction j@Journal{jtxns=ts} opts t = do
|
||||
appendToJournalFile j $ showTransaction t
|
||||
let f = journalFilePath j
|
||||
appendToJournalFile f $ showTransaction t
|
||||
when (Debug `elem` opts) $ do
|
||||
putStrLn $ printf "\nAdded transaction to %s:" (filepath j)
|
||||
putStrLn $ printf "\nAdded transaction to %s:" f
|
||||
putStrLn =<< registerFromString (show t)
|
||||
return j{jtxns=ts++[t]}
|
||||
|
||||
-- | 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 =
|
||||
-- | Append data to a journal file; or if the file is "-", dump it to stdout.
|
||||
appendToJournalFile :: FilePath -> String -> IO ()
|
||||
appendToJournalFile f s =
|
||||
if f == "-"
|
||||
then putStr $ sep ++ s
|
||||
else appendFile f $ sep++s
|
||||
where
|
||||
-- XXX we are looking at the original raw text from when the journal
|
||||
-- was first read, but that's good enough for now
|
||||
sep | null $ strip t = ""
|
||||
| otherwise = replicate (2 - min 2 (length lastnls)) '\n'
|
||||
where lastnls = takeWhile (=='\n') $ reverse t
|
||||
sep = "\n\n"
|
||||
-- sep | null $ strip t = ""
|
||||
-- | otherwise = replicate (2 - min 2 (length lastnls)) '\n'
|
||||
-- where lastnls = takeWhile (=='\n') $ reverse t
|
||||
|
||||
-- | Convert a string of journal data into a register report.
|
||||
registerFromString :: String -> IO String
|
||||
|
||||
@ -38,7 +38,7 @@ showLedgerStats _ _ l today span =
|
||||
w1 = maximum $ map (length . fst) stats
|
||||
w2 = maximum $ map (length . show . snd) stats
|
||||
stats = [
|
||||
("Journal file", filepath $ journal l)
|
||||
("Journal file", journalFilePath $ journal l)
|
||||
,("Transactions span", printf "%s to %s (%d days)" (start span) (end span) days)
|
||||
,("Last transaction", maybe "none" show lastdate ++ showelapsed lastelapsed)
|
||||
,("Transactions", printf "%d (%0.1f per day)" tnum txnrate)
|
||||
|
||||
@ -63,7 +63,7 @@ tests = TestList [
|
||||
"account directive" ~:
|
||||
let sameParse str1 str2 = do j1 <- readJournal Nothing str1 >>= either error' return
|
||||
j2 <- readJournal Nothing str2 >>= either error' return
|
||||
j1 `is` j2{filereadtime=filereadtime j1, jtext=jtext j1}
|
||||
j1 `is` j2{filereadtime=filereadtime j1, files=files j1}
|
||||
in TestList
|
||||
[
|
||||
"account directive 1" ~: sameParse
|
||||
@ -1059,9 +1059,8 @@ journal7 = Journal
|
||||
[]
|
||||
[]
|
||||
""
|
||||
""
|
||||
[]
|
||||
(TOD 0 0)
|
||||
""
|
||||
|
||||
ledger7 = journalToLedger nullfilterspec journal7
|
||||
|
||||
@ -1091,8 +1090,7 @@ journalWithAmounts as =
|
||||
[]
|
||||
[]
|
||||
""
|
||||
""
|
||||
[]
|
||||
(TOD 0 0)
|
||||
""
|
||||
where parse = fromparse . parseWithCtx emptyCtx someamount
|
||||
|
||||
|
||||
@ -13,15 +13,18 @@ module Hledger.Cli.Utils
|
||||
journalReload,
|
||||
journalReloadIfChanged,
|
||||
journalFileIsNewer,
|
||||
journalFileModificationTime,
|
||||
journalSpecifiedFileIsNewer,
|
||||
fileModificationTime,
|
||||
openBrowserOn,
|
||||
writeFileWithBackup,
|
||||
writeFileWithBackupIfChanged,
|
||||
readFileStrictly,
|
||||
)
|
||||
where
|
||||
import Hledger.Data
|
||||
import Hledger.Read
|
||||
import Hledger.Cli.Options (Opt(..),journalFilePathFromOpts) -- ,optsToFilterSpec)
|
||||
import Control.Exception
|
||||
import Safe (readMay)
|
||||
import System.Directory (getModificationTime, getDirectoryContents, copyFile)
|
||||
import System.Exit
|
||||
@ -38,7 +41,7 @@ withJournalDo opts args _ 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.
|
||||
journalFilePathFromOpts opts >>= readJournalFile Nothing >>= either (error'.trace "BBB") runcmd
|
||||
journalFilePathFromOpts opts >>= readJournalFile Nothing >>= either error' runcmd
|
||||
where
|
||||
costify = (if CostBasis `elem` opts then journalConvertAmountsToCost else id)
|
||||
runcmd = cmd opts args . costify
|
||||
@ -52,7 +55,7 @@ readJournalWithOpts opts s = do
|
||||
|
||||
-- | Re-read a journal from its data file, or return an error string.
|
||||
journalReload :: Journal -> IO (Either String Journal)
|
||||
journalReload Journal{filepath=f} = readJournalFile Nothing f
|
||||
journalReload j = readJournalFile Nothing $ journalFilePath j
|
||||
|
||||
-- | Re-read a journal from its data file mostly, only if the file has
|
||||
-- changed since last read (or if there is no file, ie data read from
|
||||
@ -60,26 +63,36 @@ journalReload Journal{filepath=f} = readJournalFile Nothing f
|
||||
-- the error message while reading it, and a flag indicating whether it
|
||||
-- was re-read or not.
|
||||
journalReloadIfChanged :: [Opt] -> Journal -> IO (Either String Journal, Bool)
|
||||
journalReloadIfChanged opts j@Journal{filepath=f} = do
|
||||
changed <- journalFileIsNewer j
|
||||
if changed
|
||||
journalReloadIfChanged opts j = do
|
||||
let maybeChangedFilename f = do newer <- journalSpecifiedFileIsNewer j f
|
||||
return $ if newer then Just f else Nothing
|
||||
changedfiles <- catMaybes `fmap` mapM maybeChangedFilename (journalFilePaths j)
|
||||
if not $ null changedfiles
|
||||
then do
|
||||
when (Verbose `elem` opts) $ printf "%s has changed, reloading\n" f
|
||||
when (Verbose `elem` opts) $ printf "%s has changed, reloading\n" (head changedfiles)
|
||||
jE <- journalReload j
|
||||
return (jE, True)
|
||||
else
|
||||
return (Right j, False)
|
||||
|
||||
-- | Has the journal's data file changed since last parsed ?
|
||||
-- | Has the journal's main data file changed since the journal was last
|
||||
-- read ?
|
||||
journalFileIsNewer :: Journal -> IO Bool
|
||||
journalFileIsNewer j@Journal{filereadtime=tread} = do
|
||||
tmod <- journalFileModificationTime j
|
||||
tmod <- fileModificationTime $ journalFilePath j
|
||||
return $ diffClockTimes tmod tread > (TimeDiff 0 0 0 0 0 0 0)
|
||||
|
||||
-- | Get the last modified time of the journal's data file (or if there is no
|
||||
-- file, the current time).
|
||||
journalFileModificationTime :: Journal -> IO ClockTime
|
||||
journalFileModificationTime Journal{filepath=f}
|
||||
-- | Has the specified file (presumably one of journal's data files)
|
||||
-- changed since journal was last read ?
|
||||
journalSpecifiedFileIsNewer :: Journal -> FilePath -> IO Bool
|
||||
journalSpecifiedFileIsNewer Journal{filereadtime=tread} f = do
|
||||
tmod <- fileModificationTime f
|
||||
return $ diffClockTimes tmod tread > (TimeDiff 0 0 0 0 0 0 0)
|
||||
|
||||
-- | Get the last modified time of the specified file, or if it does not
|
||||
-- exist or there is some other error, the current time.
|
||||
fileModificationTime :: FilePath -> IO ClockTime
|
||||
fileModificationTime f
|
||||
| null f = getClockTime
|
||||
| otherwise = getModificationTime f `Prelude.catch` \_ -> getClockTime
|
||||
|
||||
@ -120,6 +133,9 @@ writeFileWithBackupIfChanged f t = do
|
||||
writeFileWithBackup :: FilePath -> String -> IO ()
|
||||
writeFileWithBackup f t = backUpFile f >> writeFile f t
|
||||
|
||||
readFileStrictly :: FilePath -> IO String
|
||||
readFileStrictly f = readFile f >>= \s -> Control.Exception.evaluate (length s) >> return s
|
||||
|
||||
-- | Back up this file with a (incrementing) numbered suffix, or give an error.
|
||||
backUpFile :: FilePath -> IO ()
|
||||
backUpFile fp = do
|
||||
|
||||
Loading…
Reference in New Issue
Block a user