on master help sign in
Fix #1332 and change default config
0869165Harendra Kumar
src/Streamly/Internal/FileSystem/Event/Linux.hs+34−16
@@ -220,7 +220,7 @@ data Config = Config
220--
220--
221-- /Pre-release/
221-- /Pre-release/
222--
222--
223−data Toggle = On | Off
223+data Toggle = On | Off deriving (Show, Eq)
224
224
225toggle :: Toggle -> Toggle
225toggle :: Toggle -> Toggle
226toggle On = Off
226toggle On = Off
@@ -245,8 +245,8 @@ setFlag mask status cfg@Config{..} =
245--
245--
246-- /Pre-release/
246-- /Pre-release/
247--
247--
248−setRecursiveMode :: Bool -> Config -> Config
248+setRecursiveMode :: Toggle -> Config -> Config
249−setRecursiveMode rec cfg@Config{} = cfg {watchRec = rec}
249+setRecursiveMode rec cfg@Config{} = cfg {watchRec = rec == On}
250
250
251foreign import capi
251foreign import capi
252 "sys/inotify.h value IN_DONT_FOLLOW" iN_DONT_FOLLOW :: Word32
252 "sys/inotify.h value IN_DONT_FOLLOW" iN_DONT_FOLLOW :: Word32
@@ -562,7 +562,7 @@ defaultConfig =
562 $ setMovedTo On
562 $ setMovedTo On
563 $ setModified On
563 $ setModified On
564 $ Config
564 $ Config
565− { watchRec = True
565+ { watchRec = False
566 , createFlags = 0
566 , createFlags = 0
567 }
567 }
568
568
@@ -682,6 +682,12 @@ removeTrailingSlash path =
682 else path
682 else path
683 else path
683 else path
684
684
685+appendPaths :: Array Word8 -> Array Word8 -> Array Word8
686+appendPaths a b
687+ | byteLength a == 0 = b
688+ | byteLength b == 0 = a
689+ | otherwise = ensureTrailingSlash a <> b
690+
685-- | @addToWatch cfg watch root subpath@ adds @subpath@ to the list of paths
691-- | @addToWatch cfg watch root subpath@ adds @subpath@ to the list of paths
686-- being monitored under @root@ via the watch handle @watch@. @root@ must be
692-- being monitored under @root@ via the watch handle @watch@. @root@ must be
687-- an absolute path and @subpath@ must be relative to @root@.
693-- an absolute path and @subpath@ must be relative to @root@.
@@ -708,9 +714,11 @@ addToWatch cfg@Config{..} watch0@(Watch handle wdMap) root0 path0 = do
708 -- handle it. For example, if it is a dir create the application can read
714 -- handle it. For example, if it is a dir create the application can read
709 -- the dir to scan the files in it.
715 -- the dir to scan the files in it.
710 --
716 --
711− let root = ensureTrailingSlash root0
717+ let root = removeTrailingSlash root0
712− path = ensureTrailingSlash path0
718+ path = removeTrailingSlash path0
713− absPath = root <> path
719+ absPath = appendPaths root path
720+ putStrLn $ "root = " ++ utf8ToString root ++ " path = " ++ utf8ToString path ++ " absPath = " ++ utf8ToString absPath
721+
714 fd <- handleToFd handle
722 fd <- handleToFd handle
715
723
716 -- XXX we need to tolerate an error where we are adding a watch for a
724 -- XXX we need to tolerate an error where we are adding a watch for a
@@ -733,12 +741,12 @@ addToWatch cfg@Config{..} watch0@(Watch handle wdMap) root0 path0 = do
733 -- parent, this will make sure they are added too.
741 -- parent, this will make sure they are added too.
734 --
742 --
735 -- XXX Ensure that we generate events that we may have missed while we were
743 -- XXX Ensure that we generate events that we may have missed while we were
736− -- adding the dirs.
744+ -- adding the dirs. That may generate spurious events though.
737 --
745 --
738 -- XXX toDirs currently uses paths as String, we need to convert it
746 -- XXX toDirs currently uses paths as String, we need to convert it
739 -- to "/" separated by byte arrays.
747 -- to "/" separated by byte arrays.
740 when watchRec $ do
748 when watchRec $ do
741− S.mapM_ (\p -> addToWatch cfg watch0 root (path <> p))
749+ S.mapM_ (\p -> addToWatch cfg watch0 root (appendPaths path p))
742 $ S.mapM toUtf8
750 $ S.mapM toUtf8
743 $ Dir.toDirs $ utf8ToString absPath
751 $ Dir.toDirs $ utf8ToString absPath
744
752
@@ -779,7 +787,9 @@ removeFromWatch (Watch handle wdMap) path = do
779openWatch :: Config -> NonEmpty (Array Word8) -> IO Watch
787openWatch :: Config -> NonEmpty (Array Word8) -> IO Watch
780openWatch cfg paths = do
788openWatch cfg paths = do
781 w <- createWatch
789 w <- createWatch
782− mapM_ (\p -> addToWatch cfg w p (A.fromList [])) $ NonEmpty.toList paths
790+ mapM_
791+ (\root -> addToWatch cfg w root (A.fromList []))
792+ $ NonEmpty.toList paths
783 return w
793 return w
784
794
785-- | Close a 'Watch' handle.
795-- | Close a 'Watch' handle.
@@ -852,8 +862,7 @@ readOneEvent cfg wt@(Watch _ wdMap) = do
852 error $ "readOneEvent: "
862 error $ "readOneEvent: "
853 <> "Unknown watch descriptor: "
863 <> "Unknown watch descriptor: "
854 <> show ewd
864 <> show ewd
855− let -- "sub" is guaranteed to have a trailing "/"
865+ let sub1 = appendPaths sub path
856− sub1 = sub <> path
857 -- Check for "ISDIR" first because it is less likely
866 -- Check for "ISDIR" first because it is less likely
858 isDirCreate = eflags .&. iN_ISDIR /= 0 && eflags .&. iN_CREATE /= 0
867 isDirCreate = eflags .&. iN_ISDIR /= 0 && eflags .&. iN_CREATE /= 0
859 when (watchRec cfg && isDirCreate)
868 when (watchRec cfg && isDirCreate)
@@ -941,23 +950,23 @@ watchWith f paths = S.bracket before after (watchToStream cfg)
941
950
942-- | Same as 'watchWith' using 'defaultConfig' and recursive mode.
951-- | Same as 'watchWith' using 'defaultConfig' and recursive mode.
943--
952--
944−-- >>> watchRecursive = watchWith id
953+-- >>> watchRecursive = watchWith (setRecursiveMode On)
945--
954--
946-- See 'watchWith' for pitfalls and bugs when using recursive watch on Linux.
955-- See 'watchWith' for pitfalls and bugs when using recursive watch on Linux.
947--
956--
948-- /Pre-release/
957-- /Pre-release/
949--
958--
950watchRecursive :: NonEmpty (Array Word8) -> SerialT IO Event
959watchRecursive :: NonEmpty (Array Word8) -> SerialT IO Event
951−watchRecursive = watchWith id
960+watchRecursive = watchWith (setRecursiveMode On)
952
961
953-- | Same as 'watchWith' using defaultConfig and non-recursive mode.
962-- | Same as 'watchWith' using defaultConfig and non-recursive mode.
954--
963--
955−-- >>> watch = watchWith (setRecursiveMode False)
964+-- >>> watch = watchWith id
956--
965--
957-- /Pre-release/
966-- /Pre-release/
958--
967--
959watch :: NonEmpty (Array Word8) -> SerialT IO Event
968watch :: NonEmpty (Array Word8) -> SerialT IO Event
960−watch = watchWith (setRecursiveMode False)
969+watch = watchWith id
961
970
962-------------------------------------------------------------------------------
971-------------------------------------------------------------------------------
963-- Examine event stream
972-- Examine event stream
@@ -1057,6 +1066,9 @@ foreign import capi
1057-- | A path was removed from the watch explicitly using 'removeFromWatch' or
1066-- | A path was removed from the watch explicitly using 'removeFromWatch' or
1058-- automatically (file was deleted, or filesystem was unmounted).
1067-- automatically (file was deleted, or filesystem was unmounted).
1059--
1068--
1069+-- Note that in recursive watch mode all the subdirectories are watch roots,
1070+-- therefore, they will all generate this event.
1071+--
1060-- /Occurs only for a watched path/
1072-- /Occurs only for a watched path/
1061--
1073--
1062-- /Pre-release/
1074-- /Pre-release/
@@ -1070,6 +1082,9 @@ isRootUnwatched = getFlag iN_IGNORED
1070-- In addition, an 'isRootUnwatched' event will subsequently be generated
1082-- In addition, an 'isRootUnwatched' event will subsequently be generated
1071-- for the watch descriptor.
1083-- for the watch descriptor.
1072--
1084--
1085+-- Note that in recursive watch mode all the subdirectories are watch roots,
1086+-- therefore, they will all generate this event.
1087+--
1073-- /Occurs only for a watched path/
1088-- /Occurs only for a watched path/
1074--
1089--
1075-- /Pre-release/
1090-- /Pre-release/
@@ -1079,6 +1094,9 @@ isRootDeleted = getFlag iN_DELETE_SELF
1079
1094
1080-- | Watched file/directory was itself moved within the file system.
1095-- | Watched file/directory was itself moved within the file system.
1081--
1096--
1097+-- Note that in recursive watch mode all the subdirectories are watch roots,
1098+-- therefore, they will all generate this event.
1099+--
1082-- /Occurs only for a watched path/
1100-- /Occurs only for a watched path/
1083--
1101--
1084-- /Pre-release/
1102-- /Pre-release/