From a90a97a5a7a1eb1481989fecb498e334541131bf Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Fri, 2 Aug 2024 13:58:17 +0300 Subject: [PATCH] wip, rewrite glob --- .../lib/Data/Config/Suckless/Script/File.hs | 41 ++++++++++--------- 1 file changed, 21 insertions(+), 20 deletions(-) diff --git a/hbs2-cli/lib/Data/Config/Suckless/Script/File.hs b/hbs2-cli/lib/Data/Config/Suckless/Script/File.hs index 220405a7..c2fa4536 100644 --- a/hbs2-cli/lib/Data/Config/Suckless/Script/File.hs +++ b/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)