voidlizard · August 2, 2024 15:50 · Aug 2, 2024
diff --git a/glob.hs b/glob.hs
@@ -0,0 +1,38 @@
+glob :: forall m . MonadIO m
+     => [FilePattern]           -- ^ search patterns
+     -> [FilePattern]           -- ^ ignore patterns
+     -> FilePath                -- ^ directory
+     -> (FilePath -> m Bool)    -- ^ file action
+     -> m ()
+
+glob pat ignore dir action = do
+  q <- newTQueueIO
+  void $ liftIO (async $ go q dir >> atomically (writeTQueue q Nothing))
+  fix $ \next -> do
+    atomically (readTQueue q) >>= \case
+      Nothing -> pure ()
+      Just x -> do
+        r <- action x
+        when r next
+
+  where
+
+    matches p f = or [ i ?== f | i <- p ]
+    skip p = or [ i ?== p | i <- ignore ]
+
+    go q f = do
+
+      isD <- doesDirectoryExist f
+
+      if not isD then do
+        isF <- doesFileExist f
+        when (isF && matches pat f) do
+          atomically $ writeTQueue q (Just f)
+      else do
+        co' <- (try @_ @IOError $ listDirectory f)
+                 <&> fromRight mempty
+
+        let co = [ normalise (f </> x)  | x <- co' ]
+                   & filter (not . skip)
+
+        forConcurrently_ co (go q)
No results found