cabal-rpm-0.13.3: src/FileUtils.hs
-- |
-- Module : FileUtils
-- Copyright : (C) 2014, 2016-2019 Jens Petersen
--
-- Maintainer : Jens Petersen <petersen@fedoraproject.org>
-- Stability : alpha
-- Portability : portable
--
-- Explanation: Command line option processing for building RPM
-- packages.
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
module FileUtils (
filesWithExtension,
fileWithExtension,
fileWithExtension_,
getDirectoryContents_,
mktempdir,
withCurrentDirectory,
withTempDirectory) where
import SimpleCmd (cmd)
#if (defined(MIN_VERSION_base) && MIN_VERSION_base(4,8,0))
#else
import Control.Applicative ((<$>))
#endif
import Control.Exception (bracket)
import Data.List (isPrefixOf)
import Data.Maybe (isJust)
import System.Directory (getCurrentDirectory, getDirectoryContents,
setCurrentDirectory, removeDirectoryRecursive,
#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3))
withCurrentDirectory
#endif
)
import System.FilePath (takeExtension, (</>))
filesWithExtension :: FilePath -> String -> IO [FilePath]
filesWithExtension dir ext =
filter (\ f -> takeExtension f == ext) <$> getDirectoryContents dir
-- looks in current dir for a unique file with given extension
fileWithExtension :: FilePath -> String -> IO (Maybe FilePath)
fileWithExtension dir ext = do
files <- filesWithExtension dir ext
case files of
[file] -> return $ Just $ dir </> file
[] -> return Nothing
_ -> putStrLn ("More than one " ++ ext ++ " file found!") >> return Nothing
-- looks in current dir for a unique file with given extension
fileWithExtension_ :: FilePath -> String -> IO Bool
fileWithExtension_ dir ext =
isJust <$> fileWithExtension dir ext
mktempdir :: IO FilePath
mktempdir = cmd "mktemp" ["-d", "--tmpdir", "cblrpm.XXXXXXXXXX"]
withTempDirectory :: (FilePath -> IO a) -> IO a
withTempDirectory run = bracket
mktempdir
removeDirectoryRecursive
(\ tmpdir -> do
cwd <- getCurrentDirectory
setCurrentDirectory tmpdir
res <- run cwd
setCurrentDirectory cwd
return res)
-- getDirectoryContents without hidden files
getDirectoryContents_ :: FilePath -> IO [FilePath]
getDirectoryContents_ dir =
filter (not . isPrefixOf ".") <$> getDirectoryContents dir
#if (defined(MIN_VERSION_directory) && MIN_VERSION_directory(1,2,3))
#else
withCurrentDirectory :: FilePath -> IO a -> IO a
withCurrentDirectory dir action =
bracket getCurrentDirectory setCurrentDirectory $ \ _ -> do
setCurrentDirectory dir
action
#endif