module Hydrogen.Prelude.System (
module Hydrogen.Prelude.IO
, module System.CPUTime
, module System.Directory
, module System.Environment
, module System.Exit
, module System.FilePath
, module System.Info
, module System.Process
, module System.Random
, findFilesRecursively
, findFilesRecursivelyWithContext
, escapeFileName
, unescapeFileName
) where
import Hydrogen.Prelude.IO
import "base" System.CPUTime
import "directory" System.Directory
import "base" System.Environment
import "base" System.Exit
import "filepath" System.FilePath
import "base" System.Info
import "process" System.Process
import "random" System.Random
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) /= '.'))
escapeFileName :: String -> String
escapeFileName s = case s of
('/' : xs)
-> '_' : escapeFileName xs
(x : xs) ->
if | isSafeChar x -> x : escapeFileName xs
| ord x <= 255 -> '$' : printf "%02X" (ord x) ++ escapeFileName xs
| otherwise -> "$$" ++ printf "%04X" (ord x) ++ escapeFileName xs
[] -> []
where
isSafeChar x = isAscii x && isAlphaNum x || x `elem` ".-"
unescapeFileName :: String -> Maybe String
unescapeFileName s = case s of
('$' : '$' : a : b : c : d : xs)
-> (chr <$> hexnum (a : b : c : [d])) `cons` unescapeFileName xs
('$' : a : b : xs)
-> (chr <$> hexnum (a : [b])) `cons` unescapeFileName xs
('_' : xs)
-> pure '/' `cons` unescapeFileName xs
(x : xs)
-> pure x `cons` unescapeFileName xs
[] -> return []
where
cons = liftA2 (:)
hexnum = fmap fst . listToMaybe . readHex