mirror of https://github.com/voidlizard/hbs2
98 lines
2.6 KiB
Haskell
98 lines
2.6 KiB
Haskell
{-# Language MultiWayIf #-}
|
|
module Data.Config.Suckless.Script.File where
|
|
|
|
import Data.Config.Suckless
|
|
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
|
|
import System.FilePath
|
|
import System.FilePattern
|
|
|
|
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
|
|
-> FilePath -- ^ directory
|
|
-> (FilePath -> m Bool) -- ^ file action
|
|
-> m ()
|
|
|
|
glob pat ignore dir action = do
|
|
let seed = [dir]
|
|
|
|
q <- newTQueueIO
|
|
|
|
a <- liftIO $ async do
|
|
flip fix seed $ \next items -> do
|
|
case items of
|
|
[] -> atomically (writeTQueue q Nothing)
|
|
(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 ]
|
|
|
|
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 ]
|
|
skip p = or [ i ?== p | i <- ignore ]
|
|
|
|
entries :: forall c m . ( IsContext c
|
|
, Exception (BadFormException c)
|
|
, MonadUnliftIO m)
|
|
=> MakeDictM c m ()
|
|
entries = do
|
|
entry $ bindMatch "glob" $ \syn -> do
|
|
|
|
(p,i,d) <- case syn of
|
|
[] -> pure (["*"], [], ".")
|
|
|
|
[StringLike d, StringLike i] -> do
|
|
pure ([i], [], d)
|
|
|
|
[StringLike d, StringLike i, StringLike e] -> do
|
|
pure ([i], [e], d)
|
|
|
|
[StringLike d, ListVal (StringLikeList i), ListVal (StringLikeList e)] -> do
|
|
pure (i, e, d)
|
|
|
|
_ -> throwIO (BadFormException @c nil)
|
|
|
|
r <- S.toList_ $ glob p i d $ \fn -> do
|
|
S.yield (mkStr @c fn) -- do
|
|
pure True
|
|
|
|
pure (mkList r)
|
|
|