glob.hs

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)