-- | Directory functions. module Music.Theory.Directory where import Data.List {- base -} import Data.Maybe {- base -} import System.Directory {- directory -} import System.FilePath {- filepath -} import System.Process {- process -} import qualified Music.Theory.Monad as T {- hmt -} {- | 'takeDirectory' gives different answers depending on whether there is a trailing separator. > x = ["x/y","x/y/","x","/"] > map parent_dir x == ["x","x",".","/"] > map takeDirectory x == ["x","x/y",".","/"] -} parent_dir :: FilePath -> FilePath parent_dir = takeDirectory . dropTrailingPathSeparator -- | Scan a list of directories until a file is located, or not. -- This does not traverse any sub-directory structure. -- -- > mapM (path_scan ["/sbin","/usr/bin"]) ["fsck","ghc"] path_scan :: [FilePath] -> FilePath -> IO (Maybe FilePath) path_scan p fn = case p of [] -> return Nothing dir:p' -> let nm = dir fn f x = if x then return (Just nm) else path_scan p' fn in doesFileExist nm >>= f -- | Erroring variant. path_scan_err :: [FilePath] -> FilePath -> IO FilePath path_scan_err p x = let err = error (concat ["path_scan: ",show p,": ",x]) in fmap (fromMaybe err) (path_scan p x) -- | Get list of files at dir with ext, ie. ls dir/*.ext -- -- > dir_list_ext "/home/rohan/rd/j/" ".hs" dir_list_ext :: FilePath -> String -> IO [FilePath] dir_list_ext dir ext = do l <- listDirectory dir let fn = filter ((==) ext . takeExtension) l return (sort fn) -- | Post-process 'dir_list_ext' to gives file-names with /dir/ prefix. -- -- > dir_list_ext_path "/home/rohan/rd/j/" ".hs" dir_list_ext_path :: FilePath -> String -> IO [FilePath] dir_list_ext_path dir ext = dir_list_ext dir ext >>= return . map (() dir) -- | Find files having indicated filename. -- This runs the system utility /find/, so is UNIX only. -- -- > dir_find "DX7-ROM1A.syx" "/home/rohan/sw/hsc3-data/data/yamaha/" dir_find :: FilePath -> FilePath -> IO [FilePath] dir_find fn dir = fmap lines (readProcess "find" [dir,"-name",fn] "") -- | Require that exactly one file is located, else error. -- -- > dir_find_1 "DX7-ROM1A.syx" "/home/rohan/sw/hsc3-data/data/yamaha/" dir_find_1 :: FilePath -> FilePath -> IO FilePath dir_find_1 fn dir = do r <- dir_find fn dir case r of [x] -> return x _ -> error "dir_find_1?" -- | Recursively find files having case-insensitive filename extension. -- This runs the system utility /find/, so is UNIX only. -- -- > dir_find_ext ".syx" "/home/rohan/sw/hsc3-data/data/yamaha/" dir_find_ext :: String -> FilePath -> IO [FilePath] dir_find_ext ext dir = fmap lines (readProcess "find" [dir,"-iname",'*' : ext] "") -- | Post-process 'dir_find_ext' to delete starting directory. -- -- > dir_find_ext_rel ".syx" "/home/rohan/sw/hsc3-data/data/yamaha/" dir_find_ext_rel :: String -> FilePath -> IO [FilePath] dir_find_ext_rel ext dir = let f = fromMaybe (error "dir_find_ext_rel?") . stripPrefix dir in fmap (map f) (dir_find_ext ext dir) -- | Subset of files in /dir/ with an extension in /ext/. -- Extensions include the leading dot and are case-sensitive. -- -- > dir_subset [".hs"] "/home/rohan/sw/hmt/cmd" dir_subset :: [String] -> FilePath -> IO [FilePath] dir_subset ext dir = do let f nm = takeExtension nm `elem` ext c <- getDirectoryContents dir return (map (dir ) (sort (filter f c))) -- | If path is not absolute, prepend current working directory. -- -- > to_absolute_cwd "x" to_absolute_cwd :: FilePath -> IO FilePath to_absolute_cwd x = if isAbsolute x then return x else fmap ( x) getCurrentDirectory -- | If /i/ is an existing file then /j/ else /k/. if_file_exists :: (FilePath,IO t,IO t) -> IO t if_file_exists (i,j,k) = T.m_if (doesFileExist i,j,k) -- | 'createDirectoryIfMissing' (including parents) and then 'writeFile' writeFile_mkdir :: FilePath -> String -> IO () writeFile_mkdir fn s = do let dir = takeDirectory fn createDirectoryIfMissing True dir writeFile fn s -- | 'writeFile_mkdir' only if file does not exist. writeFile_mkdir_x :: FilePath -> String -> IO () writeFile_mkdir_x fn txt = if_file_exists (fn,return (),writeFile_mkdir fn txt)