fix: correct path handling in live recipe watching
- Strip .cook from map keys to match lookupRecipe behavior - Use makeRelative for event paths to match relative map keys - Filter watcher to only .cook files - Log watcher thread exceptions - Use imported isSuffixOf from Data.List
This commit is contained in:
+18
-16
@@ -11,10 +11,12 @@ module Roux.Server (
|
||||
|
||||
import Control.Concurrent (forkIO)
|
||||
import Control.Concurrent.Chan (Chan, newChan, readChan)
|
||||
import Control.Exception (SomeException, catch)
|
||||
import Control.Monad (when)
|
||||
import Data.ByteString.Lazy (ByteString)
|
||||
import Data.Char (toLower)
|
||||
import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)
|
||||
import Data.List (isSuffixOf)
|
||||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Text (Text)
|
||||
@@ -31,7 +33,7 @@ import System.FSNotify (
|
||||
watchTreeChan,
|
||||
withManagerConf,
|
||||
)
|
||||
import System.FilePath ((</>))
|
||||
import System.FilePath (makeRelative, (</>))
|
||||
|
||||
import qualified Roux.Html as Html
|
||||
import qualified Roux.RecipeIndex as Idx
|
||||
@@ -51,11 +53,14 @@ app recipeDir = do
|
||||
when (errs > 0) $
|
||||
putStrLn $
|
||||
"[roux] " <> show errs <> " had parse errors"
|
||||
-- Build initial map keyed by lowercased filename
|
||||
let recipeMap = Map.fromList [(map toLower (Idx.riFilename r), r) | r <- recipes]
|
||||
-- Build initial map keyed by lowercased filename (without .cook extension)
|
||||
let recipeMap = Map.fromList [(map toLower (stripCookExt (Idx.riFilename r)), r) | r <- recipes]
|
||||
state <- newIORef recipeMap
|
||||
-- Start the filesystem watcher
|
||||
_ <- forkIO (watchRecipes recipeDir state)
|
||||
_ <-
|
||||
forkIO $
|
||||
watchRecipes recipeDir state `catch` \e ->
|
||||
putStrLn $ "[roux] watcher thread crashed: " <> show (e :: SomeException)
|
||||
pure (handleRequest state)
|
||||
where
|
||||
isRight (Right _) = True
|
||||
@@ -70,23 +75,23 @@ watchRecipes dir state = do
|
||||
let cfg = defaultConfig{confWatchMode = WatchModeOS}
|
||||
withManagerConf cfg $ \mgr -> do
|
||||
chan <- newChan
|
||||
_stopListening <- watchTreeChan mgr dir (const True) chan
|
||||
_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
|
||||
let isDir = eventIsDirectory ev
|
||||
now <- getCurrentTime
|
||||
if isDir == IsDirectory
|
||||
if eventIsDirectory ev == IsDirectory
|
||||
then debounceLoop chan st dr lastSeen
|
||||
else do
|
||||
let path = eventPath ev
|
||||
let key = map toLower path
|
||||
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 -> do
|
||||
debounceLoop chan st dr lastSeen
|
||||
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)
|
||||
@@ -96,17 +101,16 @@ On read/parse errors, logs the error and keeps the previous version.
|
||||
-}
|
||||
reReadRecipe :: FilePath -> FilePath -> IORef (Map FilePath Idx.RecipeInfo) -> IO ()
|
||||
reReadRecipe dir path state = do
|
||||
let key = map toLower (stripCookExt path)
|
||||
let fullPath = dir </> path
|
||||
exists <- doesFileExist fullPath
|
||||
if not exists
|
||||
then do
|
||||
let key = map toLower path
|
||||
atomicModifyIORef' state $ \m ->
|
||||
(Map.delete key m, ())
|
||||
putStrLn $ "[roux] removed " <> path
|
||||
else do
|
||||
info <- Idx.loadRecipe dir path
|
||||
let key = map toLower path
|
||||
case Idx.riRecipe info of
|
||||
Left err -> do
|
||||
putStrLn $ "[roux] parse error in " <> path <> ": " <> err
|
||||
@@ -145,8 +149,6 @@ stripCookExt :: FilePath -> FilePath
|
||||
stripCookExt fp
|
||||
| ".cook" `isSuffixOf` fp = take (length fp - 5) fp
|
||||
| otherwise = fp
|
||||
where
|
||||
isSuffixOf suffix s = suffix == drop (length s - length suffix) s
|
||||
|
||||
-- | Decode a percent-encoded URL path segment to a FilePath.
|
||||
urlDecodePath :: Text -> FilePath
|
||||
|
||||
Reference in New Issue
Block a user