wip, rewrite glob

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

@@ -1,3 +1,4 @@
+{-# Language MultiWayIf #-}
 module Data.Config.Suckless.Script.File where
 
 import Data.Config.Suckless
@@ -6,6 +7,7 @@ import Data.Config.Suckless.Script.Internal
 import Control.Monad
 import Control.Monad.Trans.Class
 import Control.Monad.Trans.Cont
+import Data.Maybe
 import Data.Either
 import Data.Foldable
 import System.Directory
@@ -23,29 +25,28 @@ glob :: forall m . MonadIO m
      -> (FilePath -> m Bool)    -- ^ file action
      -> m ()
 
-glob pat ignore dir action = runContT (callCC $ \exit -> go exit dir) pure
+glob pat ignore dir action = do
+  let seed = [dir]
+
+  flip fix seed $ \next items -> do
+    case items of
+      [] -> pure ()
+      (p:rest) -> do
+        isD <- liftIO (doesDirectoryExist p)
+        if isD && not (skip p) then do
+          content <- liftIO (try @_ @IOError $ listDirectory  p)
+                       <&> fromRight mempty
+          let found = [ p </> x | x <- content ]
+          next (rest <> found)
+        else do
+          isF <- liftIO (doesFileExist p)
+          when (matches pat p && not (skip p) ) do
+            void $ action p
+          next rest
 
   where
     matches p f = or [ i ?== f | i <- p ]
-
-    go exit fn = do
-
-      let skip = or [ i ?== fn | i <- ignore ]
-
-      unless skip do
-        isF <- liftIO $ doesFileExist fn
-        if isF then do
-          when (matches pat fn) do
-            continue <- lift (action fn)
-            unless continue (exit ())
-        else do
-          isD <- liftIO $ doesDirectoryExist fn
-          when isD do
-            content <- liftIO (try @_ @IOError $ listDirectory  fn)
-                         <&> fromRight mempty
-            -- TODO: memory-hungry
-            for_ [ fn </> x | x <- content, not (matches ignore x) ] $ \e -> do
-              go exit e
+    skip p = or [ i ?== p | i <- ignore ]
 
 entries :: forall c m . ( IsContext c
                         , Exception (BadFormException c)