diff --git a/src/Roux/Server.hs b/src/Roux/Server.hs index 56fc54b..a5d2cc7 100644 --- a/src/Roux/Server.hs +++ b/src/Roux/Server.hs @@ -9,10 +9,9 @@ module Roux.Server ( app, ) where -import Control.Concurrent (forkIO) -import Control.Concurrent.Chan (Chan, newChan, readChan) +import Control.Concurrent (forkIO, threadDelay) import Control.Exception (SomeException, catch) -import Control.Monad (when) +import Control.Monad (forever, when) import Data.ByteString.Lazy (ByteString) import Data.Char (toLower) import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef) @@ -20,7 +19,7 @@ import Data.List (isSuffixOf) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Text (Text) -import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime) + import qualified Network.HTTP.Types as HTTP import qualified Network.Wai as Wai import System.Directory (doesFileExist, makeAbsolute) @@ -30,7 +29,7 @@ import System.FSNotify ( WatchConfig (..), WatchMode (..), defaultConfig, - watchTreeChan, + watchDir, withManagerConf, ) import System.FilePath (makeRelative, ()) @@ -69,34 +68,19 @@ app recipeDir = do isRight (Left _) = False {- | Watch a directory for .cook file changes and update the shared state. -Implements debouncing: events for the same path within 200ms are skipped. +Uses watchDir callback for simplicity. -} watchRecipes :: FilePath -> IORef (Map FilePath Idx.RecipeInfo) -> IO () watchRecipes dir state = do putStrLn $ "[roux] watching " <> dir <> " for changes" let cfg = defaultConfig{confWatchMode = WatchModeOS} withManagerConf cfg $ \mgr -> do - chan <- newChan - _stopListening <- watchTreeChan mgr dir ((".cook" `isSuffixOf`) . eventPath) chan - debounceLoop chan state dir Map.empty - where - debounceLoop :: Chan Event -> IORef (Map FilePath Idx.RecipeInfo) -> FilePath -> Map FilePath UTCTime -> IO () - debounceLoop chan st dr lastSeen = do - ev <- readChan chan - if eventIsDirectory ev == IsDirectory - then debounceLoop chan st dr lastSeen - else do - let path = makeRelative dr (eventPath ev) - let key = map toLower (stripCookExt path) - now <- getCurrentTime - let lastTime = Map.lookup key lastSeen - case lastTime of - Just t - | diffUTCTime now t < 0.2 -> - debounceLoop chan st dr lastSeen - _ -> do - reReadRecipe dr path st - debounceLoop chan st dr (Map.insert key now lastSeen) + _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 + -- Keep the thread alive (watchDir runs the callback on the manager thread) + forever $ threadDelay 1000000 {- | Re-read a single recipe file and update the shared state. On read/parse errors, logs the error and keeps the previous version.