fix: catch IOExceptions in reReadRecipe and wrap watchDir callback for resilience

src/Roux/Server.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 {- | WAI application for the Roux recipe server.
 
@@ -10,7 +11,7 @@ module Roux.Server (
 ) where
 
 import Control.Concurrent (forkIO, threadDelay)
-import Control.Exception (SomeException, catch)
+import Control.Exception (IOException, SomeException, catch, try)
 import Control.Monad (forever, when)
 import Data.ByteString.Lazy (ByteString)
 import Data.Char (toLower)
@@ -76,9 +77,16 @@ watchRecipes dir state = do
     let cfg = defaultConfig{confWatchMode = WatchModeOS}
     withManagerConf cfg $ \mgr -> do
         _stopListening <- watchDir mgr dir (const True) $ \ev ->
+            catch
+                ( do
                     when (eventIsDirectory ev == IsFile && ".cook" `isSuffixOf` eventPath ev) $ do
                         let path = makeRelative dir (eventPath ev)
                         reReadRecipe dir path state
+                )
+                ( \e ->
+                    putStrLn $
+                        "[roux] watchDir callback error: " <> show (e :: SomeException)
+                )
         -- Keep the thread alive (watchDir runs the callback on the manager thread)
         forever $ threadDelay 1000000
 
@@ -89,15 +97,20 @@ reReadRecipe :: FilePath -> FilePath -> IORef (Map FilePath Idx.RecipeInfo) -> I
 reReadRecipe dir path state = do
     let key = map toLower (stripCookExt path)
     let fullPath = dir </> path
-    exists <- doesFileExist fullPath
+    result <- try (doesFileExist fullPath)
-    if not exists
+    case result of
-        then do
+        Left (_ :: IOException) -> do
+            putStrLn $ "[roux] IO error checking " <> path <> ", skipping"
+        Right False -> do
             atomicModifyIORef' state $ \m ->
                 (Map.delete key m, ())
             putStrLn $ "[roux] removed " <> path
-        else do
+        Right True -> do
-            info <- Idx.loadRecipe dir path
+            content <- try (Idx.loadRecipe dir path)
-            case Idx.riRecipe info of
+            case content of
+                Left (_ :: IOException) -> do
+                    putStrLn $ "[roux] IO error reading " <> path <> ", keeping previous version"
+                Right info -> case Idx.riRecipe info of
                     Left err -> do
                         putStrLn $ "[roux] parse error in " <> path <> ": " <> err
                         putStrLn $ "[roux] keeping previous version"