module Hydrogen.Util.Files where
import Hydrogen.Prelude.System
import qualified Data.Set as Set
findFilesRecursively :: (FilePath -> IO Bool) -> FilePath -> IO [FilePath]
findFilesRecursively f dir =
map fst <$> findFilesRecursivelyWithContext (\c _ _ -> return c) f () dir
findFilesRecursivelyWithContext
:: forall c.
(c -> FilePath -> [FilePath] -> IO c)
-> (FilePath -> IO Bool)
-> c
-> FilePath -> IO [(FilePath, c)]
findFilesRecursivelyWithContext updater predicate context dir = do
cwd <- getCurrentDirectory
snd <$> find Set.empty context (cwd </> dir)
where
find :: Set FilePath -> c -> FilePath -> IO (Set FilePath, [(FilePath, c)])
find visited context dir = do
thisDirectory <- canonicalizePath dir
if | Set.member thisDirectory visited -> return (Set.empty, [])
| otherwise -> do
allFiles <- map (dir </>) <$> getDirectoryContents dir
theFiles <- filterFiles allFiles
theDirs <- filterM isDir allFiles
context' <- updater context dir theFiles
let visited' = Set.insert thisDirectory visited
f (visited, files) dir = do
(visited', files') <- find visited context' dir
return (visited', files' : files)
(visited'', files') <- foldM f (visited', []) theDirs
return (visited'', concat (zip theFiles (repeat context') : files'))
filterFiles = filterM (\x -> liftM2 (&&) (doesFileExist x) (predicate x))
isDir x = liftM2 (&&) (doesDirectoryExist x) (return (head (takeFileName x) /= '.'))
escape :: String -> String
escape s = case s of
('/' : xs)
-> '_' : escape xs
(x : xs) ->
if | isSafeChar x -> x : escape xs
| ord x <= 255 -> '$' : printf "%02X" (ord x) ++ escape xs
| otherwise -> "$$" ++ printf "%04X" (ord x) ++ escape xs
[] -> []
where
isSafeChar x = isAscii x && isAlphaNum x || x `elem` ".-"
unescape :: String -> Maybe String
unescape s = case s of
('$' : '$' : a : b : c : d : xs)
-> (chr <$> hexnum (a : b : c : [d])) `cons` unescape xs
('$' : a : b : xs)
-> (chr <$> hexnum (a : [b])) `cons` unescape xs
('_' : xs)
-> pure '/' `cons` unescape xs
(x : xs)
-> pure x `cons` unescape xs
[] -> return []
where
cons = liftA2 (:)
hexnum = fmap fst . listToMaybe . readHex