diff --git a/src/Roux/Server.hs b/src/Roux/Server.hs index a5d2cc7..7cfc764 100644 --- a/src/Roux/Server.hs +++ b/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 -> - when (eventIsDirectory ev == IsFile && ".cook" `isSuffixOf` eventPath ev) $ do - let path = makeRelative dir (eventPath ev) - reReadRecipe dir path state + 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,22 +97,27 @@ 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 - if not exists - then do + result <- try (doesFileExist fullPath) + case result of + 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 - info <- Idx.loadRecipe dir path - case Idx.riRecipe info of - Left err -> do - putStrLn $ "[roux] parse error in " <> path <> ": " <> err - putStrLn $ "[roux] keeping previous version" - Right _ -> do - atomicModifyIORef' state $ \m -> - (Map.insert key info m, ()) - putStrLn $ "[roux] updated " <> path + Right True -> do + content <- try (Idx.loadRecipe dir path) + 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" + Right _ -> do + atomicModifyIORef' state $ \m -> + (Map.insert key info m, ()) + putStrLn $ "[roux] updated " <> path -- | Route an incoming request to the appropriate handler. handleRequest :: IORef (Map FilePath Idx.RecipeInfo) -> Wai.Application