fix: use watchDir callback instead of watchTreeChan for reliable event delivery
This commit is contained in:
+11
-27
@@ -9,10 +9,9 @@ module Roux.Server (
|
|||||||
app,
|
app,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Concurrent (forkIO)
|
import Control.Concurrent (forkIO, threadDelay)
|
||||||
import Control.Concurrent.Chan (Chan, newChan, readChan)
|
|
||||||
import Control.Exception (SomeException, catch)
|
import Control.Exception (SomeException, catch)
|
||||||
import Control.Monad (when)
|
import Control.Monad (forever, when)
|
||||||
import Data.ByteString.Lazy (ByteString)
|
import Data.ByteString.Lazy (ByteString)
|
||||||
import Data.Char (toLower)
|
import Data.Char (toLower)
|
||||||
import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)
|
import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)
|
||||||
@@ -20,7 +19,7 @@ import Data.List (isSuffixOf)
|
|||||||
import Data.Map.Strict (Map)
|
import Data.Map.Strict (Map)
|
||||||
import qualified Data.Map.Strict as Map
|
import qualified Data.Map.Strict as Map
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime)
|
|
||||||
import qualified Network.HTTP.Types as HTTP
|
import qualified Network.HTTP.Types as HTTP
|
||||||
import qualified Network.Wai as Wai
|
import qualified Network.Wai as Wai
|
||||||
import System.Directory (doesFileExist, makeAbsolute)
|
import System.Directory (doesFileExist, makeAbsolute)
|
||||||
@@ -30,7 +29,7 @@ import System.FSNotify (
|
|||||||
WatchConfig (..),
|
WatchConfig (..),
|
||||||
WatchMode (..),
|
WatchMode (..),
|
||||||
defaultConfig,
|
defaultConfig,
|
||||||
watchTreeChan,
|
watchDir,
|
||||||
withManagerConf,
|
withManagerConf,
|
||||||
)
|
)
|
||||||
import System.FilePath (makeRelative, (</>))
|
import System.FilePath (makeRelative, (</>))
|
||||||
@@ -69,34 +68,19 @@ app recipeDir = do
|
|||||||
isRight (Left _) = False
|
isRight (Left _) = False
|
||||||
|
|
||||||
{- | Watch a directory for .cook file changes and update the shared state.
|
{- | 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 :: FilePath -> IORef (Map FilePath Idx.RecipeInfo) -> IO ()
|
||||||
watchRecipes dir state = do
|
watchRecipes dir state = do
|
||||||
putStrLn $ "[roux] watching " <> dir <> " for changes"
|
putStrLn $ "[roux] watching " <> dir <> " for changes"
|
||||||
let cfg = defaultConfig{confWatchMode = WatchModeOS}
|
let cfg = defaultConfig{confWatchMode = WatchModeOS}
|
||||||
withManagerConf cfg $ \mgr -> do
|
withManagerConf cfg $ \mgr -> do
|
||||||
chan <- newChan
|
_stopListening <- watchDir mgr dir (const True) $ \ev ->
|
||||||
_stopListening <- watchTreeChan mgr dir ((".cook" `isSuffixOf`) . eventPath) chan
|
when (eventIsDirectory ev == IsFile && ".cook" `isSuffixOf` eventPath ev) $ do
|
||||||
debounceLoop chan state dir Map.empty
|
let path = makeRelative dir (eventPath ev)
|
||||||
where
|
reReadRecipe dir path state
|
||||||
debounceLoop :: Chan Event -> IORef (Map FilePath Idx.RecipeInfo) -> FilePath -> Map FilePath UTCTime -> IO ()
|
-- Keep the thread alive (watchDir runs the callback on the manager thread)
|
||||||
debounceLoop chan st dr lastSeen = do
|
forever $ threadDelay 1000000
|
||||||
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)
|
|
||||||
|
|
||||||
{- | Re-read a single recipe file and update the shared state.
|
{- | Re-read a single recipe file and update the shared state.
|
||||||
On read/parse errors, logs the error and keeps the previous version.
|
On read/parse errors, logs the error and keeps the previous version.
|
||||||
|
|||||||
Reference in New Issue
Block a user