mirror of https://github.com/voidlizard/hbs2
123 lines
3.2 KiB
Haskell
123 lines
3.2 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 Data.HashSet qualified as HS
|
|
|
|
import Lens.Micro.Platform
|
|
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
|
|
|
|
go dir
|
|
|
|
where
|
|
|
|
matches p f = or [ i ?== f | i <- p ]
|
|
skip p = or [ i ?== p | i <- ignore ]
|
|
|
|
go f = do
|
|
|
|
isD <- liftIO $ doesDirectoryExist f
|
|
|
|
if not isD then do
|
|
isF <- liftIO $ doesFileExist f
|
|
when (isF && matches pat f) do
|
|
liftIO $ print f
|
|
-- do shit with file
|
|
else do
|
|
co' <- liftIO (try @_ @IOError $ listDirectory f)
|
|
<&> fromRight mempty
|
|
|
|
let co = [ normalise (f </> x) | x <- co' ]
|
|
& filter (not . skip)
|
|
|
|
for_ co $ \p -> do
|
|
go p
|
|
|
|
-- 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
|
|
|
|
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)
|
|
|