hpath/test/Utils.hs

216 lines
4.9 KiB
Haskell
Raw Normal View History

2016-05-09 14:53:31 +00:00
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
2016-05-09 14:53:31 +00:00
module Utils where
2016-05-09 16:53:26 +00:00
import Control.Applicative
(
(<$>)
)
import Control.Monad
(
void
)
2016-05-09 14:53:31 +00:00
import HPath.IO
import HPath.IO.Errors
import HPath.IO.Utils
import Data.Maybe
(
fromJust
)
import qualified HPath as P
import System.Posix.Directory.Traversals
(
allDirectoryContents
)
2016-05-09 14:53:31 +00:00
import System.Posix.Env.ByteString
(
getEnv
)
import Data.ByteString
(
ByteString
)
import System.Posix.Files.ByteString
(
groupExecuteMode
, groupReadMode
, nullFileMode
, otherExecuteMode
, otherReadMode
, ownerExecuteMode
, ownerReadMode
, setFileMode
, unionFileModes
)
import qualified "unix" System.Posix.IO.ByteString as SPI
import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB
tmpDir :: ByteString
tmpDir = "test/HPath/IO/tmp/"
2016-05-09 14:53:31 +00:00
-----------------
--[ Utilities ]--
-----------------
createTmpDir :: IO ()
createTmpDir = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel tmpDir
void $ createDir (pwd P.</> tmp)
deleteTmpDir :: IO ()
deleteTmpDir = do
2016-05-09 14:53:31 +00:00
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel tmpDir
void $ deleteDir (pwd P.</> tmp)
withRawTmpDir :: (P.Path P.Abs -> IO a) -> IO a
withRawTmpDir f = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel tmpDir
f (pwd P.</> tmp)
withTmpDir :: ByteString -> (P.Path P.Abs -> IO a) -> IO a
withTmpDir ip f = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel tmpDir
p <- (pwd P.</> tmp P.</>) <$> P.parseRel ip
2016-05-09 14:53:31 +00:00
f p
withTmpDir' :: ByteString
-> ByteString
-> (P.Path P.Abs -> P.Path P.Abs -> IO a)
-> IO a
withTmpDir' ip1 ip2 f = do
2016-05-09 14:53:31 +00:00
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel tmpDir
p1 <- (pwd P.</> tmp P.</>) <$> P.parseRel ip1
p2 <- (pwd P.</> tmp P.</>) <$> P.parseRel ip2
2016-05-09 14:53:31 +00:00
f p1 p2
removeFileIfExists :: ByteString -> IO ()
removeFileIfExists bs =
withTmpDir bs $ \p -> whenM (doesFileExist p) (deleteFile p)
2016-05-09 14:53:31 +00:00
removeDirIfExists :: ByteString -> IO ()
removeDirIfExists bs =
withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p)
2016-05-09 14:53:31 +00:00
copyFile' :: ByteString -> ByteString -> CopyMode -> IO ()
copyFile' inputFileP outputFileP cm =
withTmpDir' inputFileP outputFileP (\p1 p2 -> copyFile p1 p2 cm)
2016-05-09 14:53:31 +00:00
copyDirRecursive' :: ByteString -> ByteString
-> CopyMode -> RecursiveMode -> IO ()
copyDirRecursive' inputDirP outputDirP cm rm =
withTmpDir' inputDirP outputDirP (\p1 p2 -> copyDirRecursive p1 p2 cm rm)
2016-05-09 14:53:31 +00:00
createDir' :: ByteString -> IO ()
createDir' dest = withTmpDir dest createDir
2016-05-09 14:53:31 +00:00
createRegularFile' :: ByteString -> IO ()
createRegularFile' dest = withTmpDir dest createRegularFile
createSymlink' :: ByteString -> ByteString -> IO ()
createSymlink' dest sympoint = withTmpDir dest
(\x -> createSymlink x sympoint)
2016-05-09 14:53:31 +00:00
renameFile' :: ByteString -> ByteString -> IO ()
renameFile' inputFileP outputFileP =
withTmpDir' inputFileP outputFileP $ \i o -> do
2016-05-09 14:53:31 +00:00
renameFile i o
renameFile o i
moveFile' :: ByteString -> ByteString -> CopyMode -> IO ()
moveFile' inputFileP outputFileP cm =
withTmpDir' inputFileP outputFileP $ \i o -> do
moveFile i o cm
moveFile o i Strict
2016-05-09 14:53:31 +00:00
recreateSymlink' :: ByteString -> ByteString -> CopyMode -> IO ()
recreateSymlink' inputFileP outputFileP cm =
withTmpDir' inputFileP outputFileP (\p1 p2 -> recreateSymlink p1 p2 cm)
2016-05-09 14:53:31 +00:00
noWritableDirPerms :: ByteString -> IO ()
noWritableDirPerms path = withTmpDir path $ \p ->
2016-05-09 14:53:31 +00:00
setFileMode (P.fromAbs p) perms
where
perms = ownerReadMode
`unionFileModes` ownerExecuteMode
`unionFileModes` groupReadMode
`unionFileModes` groupExecuteMode
`unionFileModes` otherReadMode
`unionFileModes` otherExecuteMode
noPerms :: ByteString -> IO ()
noPerms path = withTmpDir path $ \p -> setFileMode (P.fromAbs p) nullFileMode
2016-05-09 14:53:31 +00:00
normalDirPerms :: ByteString -> IO ()
normalDirPerms path =
withTmpDir path $ \p -> setFileMode (P.fromAbs p) newDirPerms
2016-05-09 14:53:31 +00:00
getFileType' :: ByteString -> IO FileType
getFileType' path = withTmpDir path getFileType
2016-05-09 14:53:31 +00:00
getDirsFiles' :: ByteString -> IO [P.Path P.Abs]
getDirsFiles' path = withTmpDir path getDirsFiles
2016-05-09 14:53:31 +00:00
deleteFile' :: ByteString -> IO ()
deleteFile' p = withTmpDir p deleteFile
2016-05-09 14:53:31 +00:00
deleteDir' :: ByteString -> IO ()
deleteDir' p = withTmpDir p deleteDir
2016-05-09 14:53:31 +00:00
deleteDirRecursive' :: ByteString -> IO ()
deleteDirRecursive' p = withTmpDir p deleteDirRecursive
2016-05-09 14:53:31 +00:00
canonicalizePath' :: ByteString -> IO (P.Path P.Abs)
canonicalizePath' p = withTmpDir p canonicalizePath
2016-05-09 14:53:31 +00:00
writeFile' :: ByteString -> ByteString -> IO ()
writeFile' ip bs =
withTmpDir ip $ \p -> do
fd <- SPI.openFd (P.fromAbs p) SPI.WriteOnly Nothing
SPI.defaultFileFlags
_ <- SPB.fdWrite fd bs
SPI.closeFd fd
allDirectoryContents' :: ByteString -> IO [ByteString]
allDirectoryContents' ip =
withTmpDir ip $ \p -> allDirectoryContents (P.fromAbs p)