webyesod: warn and keep running if reloading the journal gives an error

Hledger/Cli/Commands/Web.hs

@@ -115,14 +115,19 @@ withLatestJournalRender reportfn = do
         opts = appOpts app ++ [Period p]
         args = appArgs app ++ [a]
         fspec = optsToFilterSpec opts args t
-    -- reload journal if changed
+    -- reload journal if changed, displaying any error as a message
     j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
-    (changed, j') <- liftIO $ journalReloadIfChanged opts j
+    (changed, jE) <- liftIO $ journalReloadIfChanged opts j
-    when changed $ liftIO $ putValue "hledger" "journal" j'
+    (err, j') <- either (\e -> return (show e,j)) (\j -> return ("",j)) jE
+    when (changed && null err) $ liftIO $ putValue "hledger" "journal" j'
+    if (changed && not (null err)) then setMessage $ string "error while reading"
+                                 else return ()
     -- run the specified report using this request's params
     let s = reportfn opts fspec j'
     -- render the standard template
-    msg <- getMessage
+    msg' <- getMessage
+    -- XXX work around a bug, can't get the message we set above
+    let msg = if null err then msg' else Just $ string $ printf "Error while reading %s" (filepath j')
     Just here <- getRoute
     hamletToRepHtml $ template here msg a p "hledger" s
 

Hledger/Cli/Utils.hs

@@ -12,12 +12,14 @@ module Hledger.Cli.Utils
      readJournalWithOpts,
      journalReload,
      journalReloadIfChanged,
+     journalFileIsNewer,
      journalFileModificationTime,
      openBrowserOn,
      writeFileWithBackup,
      writeFileWithBackupIfChanged,
     )
 where
+import Control.Exception (SomeException(..), try)
 import Hledger.Data
 import Hledger.Read
 import Hledger.Cli.Options (Opt(..),journalFilePathFromOpts) -- ,optsToFilterSpec)
@@ -53,26 +55,31 @@ readJournalWithOpts opts s = do
     let cost = CostBasis `elem` opts
     return $ (if cost then journalConvertAmountsToCost else id) j
 
--- | Re-read a journal from its data file.
+-- | Re-read a journal from its data file, or return the exception that was raised.
-journalReload :: Journal -> IO Journal
+journalReload :: Journal -> IO (Either SomeException Journal)
-journalReload Journal{filepath=f} = readJournalFile Nothing f
+journalReload Journal{filepath=f} = try $ readJournalFile Nothing f
 
 -- | 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
--- stdin). The provided options are mostly ignored. Return a journal and a
+-- stdin). The provided options are mostly ignored. Return a journal or
--- flag indicating whether it was re-read or not.
+-- the exception that was raised while reading it, and a flag indicating
-journalReloadIfChanged :: [Opt] -> Journal -> IO (Bool, Journal)
+-- whether it was re-read or not.
-journalReloadIfChanged opts j@Journal{filepath=f,filereadtime=tread} = do
+journalReloadIfChanged :: [Opt] -> Journal -> IO (Bool, Either SomeException Journal)
-  tmod <- journalFileModificationTime j
+journalReloadIfChanged opts j@Journal{filepath=f} = do
-  let newer = diffClockTimes tmod tread > (TimeDiff 0 0 0 0 0 0 0)
+  changed <- journalFileIsNewer j
-  -- when (Debug `elem` opts) $ printf "checking file, last modified %s, last read %s, %s\n" (show tmod) (show tread) (show newer)
+  if changed
-  if newer
    then do
      when (Verbose `elem` opts) $ printf "%s has changed, reloading\n" f
-     j' <- journalReload j
+     jE <- journalReload j
-     return (True, j')
+     return (True, jE)
    else
-     return (False, j)
+     return (False, Right j)
+
+-- | Has the journal's data file changed since last parsed ?
+journalFileIsNewer :: Journal -> IO Bool
+journalFileIsNewer j@Journal{filereadtime=tread} = do
+  tmod <- journalFileModificationTime 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).