wip, works, suspictious

hbs2-cli/hbs2-cli.cabal

@@ -93,6 +93,7 @@ common shared-properties
       , random
       , vector
       , unix
+      , split
 
 
 library

hbs2-cli/lib/Data/Config/Suckless/Script/File.hs

@@ -18,6 +18,8 @@ import UnliftIO
 import Control.Concurrent.STM qualified as STM
 import Streaming.Prelude qualified as S
 
+import Data.List.Split (chunksOf)
+
 glob :: forall m . MonadIO m
      => [FilePattern]           -- ^ search patterns
      -> [FilePattern]           -- ^ ignore patterns
@@ -28,21 +30,39 @@ glob :: forall m . MonadIO m
 glob pat ignore dir action = do
   let seed = [dir]
 
-  flip fix seed $ \next items -> do
+  q <- newTQueueIO
-    case items of
+
-      [] -> pure ()
+  a <- liftIO $ async do
-      (p:rest) -> do
+        flip fix seed $ \next items -> do
-        isD <- liftIO (doesDirectoryExist p)
+          case items of
-        if isD && not (skip p)  then do
+            [] -> atomically (writeTQueue q Nothing)
-          content <- liftIO (try @_ @IOError $ listDirectory  p)
+            (p:rest) -> do
-                       <&> fromRight mempty
+              isD <- liftIO (doesDirectoryExist p)
-          let found = [ p </> x | x <- content ]
+              if isD && not (skip p)  then do
-          next (rest <> found)
+                content <- liftIO (try @_ @IOError $ listDirectory  p)
-        else do
+                             <&> fromRight mempty
-          isF <- liftIO (doesFileExist p)
+
-          when (isF && matches pat p ) do
+                let found = [ p </> x | x <- content ]
-            void $ action p
+
-          next rest
+                forConcurrently_ found $ \f -> do
+                  glob pat ignore f $ \fn -> do
+                    atomically $ writeTQueue q (Just fn)
+                    pure True
+
+                next []
+
+              else do
+                isF <- liftIO (doesFileExist p)
+                when (isF && matches pat p ) do
+                  atomically (writeTQueue q (Just p))
+
+                next rest
+
+  fix \next -> do
+    r <- atomically (readTQueue q)
+    case r of
+      Nothing -> pure ()
+      Just e  -> void (action e) >> next
 
   where
     matches p f = or [ i ?== f | i <- p ]