From 7714bab58d1f706c63048877204eee7023b6cf23 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Fri, 24 Sep 2010 01:56:11 +0000 Subject: [PATCH] web: offer a choice of files to edit when there are multiple (included) files --- hledger-lib/Hledger/Data/Journal.hs | 25 +++++-- hledger-lib/Hledger/Data/Types.hs | 9 ++- hledger-lib/Hledger/Data/Utils.hs | 4 - hledger-lib/Hledger/Read/Journal.hs | 15 ++-- hledger-web/Hledger/Web/App.hs | 104 +++++++++++++++++--------- hledger-web/data/static/hledger.js | 22 +++++- hledger/Hledger/Cli/Commands/Add.hs | 28 ++++--- hledger/Hledger/Cli/Commands/Stats.hs | 2 +- hledger/Hledger/Cli/Tests.hs | 8 +- hledger/Hledger/Cli/Utils.hs | 42 +++++++---- 10 files changed, 165 insertions(+), 94 deletions(-) diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 7364980ad..622ba6000 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -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 diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index c5134834d..b8e62c13e 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -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 { diff --git a/hledger-lib/Hledger/Data/Utils.hs b/hledger-lib/Hledger/Data/Utils.hs index 54275606a..ba4efec69 100644 --- a/hledger-lib/Hledger/Data/Utils.hs +++ b/hledger-lib/Hledger/Data/Utils.hs @@ -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 diff --git a/hledger-lib/Hledger/Read/Journal.hs b/hledger-lib/Hledger/Read/Journal.hs index c66295132..2805705b0 100644 --- a/hledger-lib/Hledger/Read/Journal.hs +++ b/hledger-lib/Hledger/Read/Journal.hs @@ -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` diff --git a/hledger-web/Hledger/Web/App.hs b/hledger-web/Hledger/Web/App.hs index bc90e9368..afe6746e1 100644 --- a/hledger-web/Hledger/Web/App.hs +++ b/hledger-web/Hledger/Web/App.hs @@ -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 diff --git a/hledger-web/data/static/hledger.js b/hledger-web/data/static/hledger.js index 97f0f5922..2c4f11f90 100644 --- a/hledger-web/data/static/hledger.js +++ b/hledger-web/data/static/hledger.js @@ -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 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 diff --git a/hledger/Hledger/Cli/Commands/Stats.hs b/hledger/Hledger/Cli/Commands/Stats.hs index fa40a4f57..813dbec75 100644 --- a/hledger/Hledger/Cli/Commands/Stats.hs +++ b/hledger/Hledger/Cli/Commands/Stats.hs @@ -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) diff --git a/hledger/Hledger/Cli/Tests.hs b/hledger/Hledger/Cli/Tests.hs index 7851d8f9f..e9fc78c90 100644 --- a/hledger/Hledger/Cli/Tests.hs +++ b/hledger/Hledger/Cli/Tests.hs @@ -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 diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index ae54be5a2..b449a0c05 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -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