hpath/hpath-io/test/Utils.hs

285 lines
6.8 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
(
2016-06-05 12:33:53 +00:00
forM_
, void
)
2016-06-05 19:52:52 +00:00
import Control.Monad.IfElse
(
whenM
)
2016-06-05 12:33:53 +00:00
import qualified Data.ByteString as BS
import Data.IORef
(
newIORef
, readIORef
, writeIORef
, IORef
)
2016-05-09 14:53:31 +00:00
import HPath.IO
2018-04-06 15:22:22 +00:00
import Prelude hiding (appendFile, readFile, writeFile)
2016-05-09 14:53:31 +00:00
import Data.Maybe
(
fromJust
)
import qualified HPath as P
import System.IO.Unsafe
(
unsafePerformIO
)
2016-06-05 12:55:21 +00:00
import qualified System.Posix.Directory.Traversals as DT
2016-05-09 14:53:31 +00:00
import Data.ByteString
(
ByteString
)
2018-04-06 14:42:40 +00:00
import qualified Data.ByteString.Lazy as L
2016-05-09 14:53:31 +00:00
import System.Posix.Files.ByteString
(
groupExecuteMode
, groupReadMode
, nullFileMode
, otherExecuteMode
, otherReadMode
, ownerExecuteMode
, ownerReadMode
, setFileMode
, unionFileModes
)
baseTmpDir :: IORef (Maybe ByteString)
{-# NOINLINE baseTmpDir #-}
baseTmpDir = unsafePerformIO (newIORef Nothing)
2016-06-05 12:33:53 +00:00
tmpDir :: IORef (Maybe ByteString)
2016-06-05 12:33:53 +00:00
{-# NOINLINE tmpDir #-}
tmpDir = unsafePerformIO (newIORef Nothing)
2016-05-09 14:53:31 +00:00
-----------------
--[ Utilities ]--
-----------------
2016-06-05 12:33:53 +00:00
setTmpDir :: ByteString -> IO ()
{-# NOINLINE setTmpDir #-}
setTmpDir bs = do
tmp <- fromJust <$> readIORef baseTmpDir
writeIORef tmpDir (Just (tmp `BS.append` bs))
2016-06-05 12:33:53 +00:00
createTmpDir :: IO ()
2016-06-05 12:33:53 +00:00
{-# NOINLINE createTmpDir #-}
createTmpDir = do
tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir)
void $ createDir newDirPerms tmp
deleteTmpDir :: IO ()
2016-06-05 12:33:53 +00:00
{-# NOINLINE deleteTmpDir #-}
deleteTmpDir = do
tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir)
void $ deleteDir tmp
2016-06-05 12:33:53 +00:00
deleteBaseTmpDir :: IO ()
{-# NOINLINE deleteBaseTmpDir #-}
deleteBaseTmpDir = do
tmp <- (fromJust <$> readIORef baseTmpDir) >>= P.parseAbs
contents <- getDirsFiles tmp
2016-06-05 12:33:53 +00:00
forM_ contents deleteDir
void $ deleteDir tmp
withRawTmpDir :: (P.Path P.Abs -> IO a) -> IO a
2016-06-05 12:33:53 +00:00
{-# NOINLINE withRawTmpDir #-}
withRawTmpDir f = do
tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir)
f tmp
2016-06-05 12:33:53 +00:00
getRawTmpDir :: IO ByteString
{-# NOINLINE getRawTmpDir #-}
getRawTmpDir = withRawTmpDir (return . flip BS.append "/" . P.fromAbs)
withTmpDir :: ByteString -> (P.Path P.Abs -> IO a) -> IO a
2016-06-05 12:33:53 +00:00
{-# NOINLINE withTmpDir #-}
withTmpDir ip f = do
tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir)
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
2016-06-05 12:33:53 +00:00
{-# NOINLINE withTmpDir' #-}
withTmpDir' ip1 ip2 f = do
tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir)
p1 <- (tmp P.</>) <$> P.parseRel ip1
p2 <- (tmp P.</>) <$> P.parseRel ip2
2016-05-09 14:53:31 +00:00
f p1 p2
removeFileIfExists :: ByteString -> IO ()
2016-06-05 12:33:53 +00:00
{-# NOINLINE removeFileIfExists #-}
2016-05-09 14:53:31 +00:00
removeFileIfExists bs =
withTmpDir bs $ \p -> whenM (doesFileExist p) (deleteFile p)
2016-05-09 14:53:31 +00:00
removeDirIfExists :: ByteString -> IO ()
2016-06-05 12:33:53 +00:00
{-# NOINLINE removeDirIfExists #-}
2016-05-09 14:53:31 +00:00
removeDirIfExists bs =
withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p)
2016-05-09 14:53:31 +00:00
copyFile' :: ByteString -> ByteString -> CopyMode -> IO ()
2016-06-05 12:33:53 +00:00
{-# NOINLINE copyFile' #-}
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 -> RecursiveErrorMode -> IO ()
2016-06-05 12:33:53 +00:00
{-# NOINLINE copyDirRecursive' #-}
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 ()
2016-06-05 12:33:53 +00:00
{-# NOINLINE createDir' #-}
createDir' dest = withTmpDir dest (createDir newDirPerms)
2016-05-09 14:53:31 +00:00
2016-06-12 23:28:55 +00:00
createDirRecursive' :: ByteString -> IO ()
{-# NOINLINE createDirRecursive' #-}
createDirRecursive' dest = withTmpDir dest (createDirRecursive newDirPerms)
2016-05-09 14:53:31 +00:00
createRegularFile' :: ByteString -> IO ()
2016-06-05 12:33:53 +00:00
{-# NOINLINE createRegularFile' #-}
createRegularFile' dest = withTmpDir dest (createRegularFile newFilePerms)
createSymlink' :: ByteString -> ByteString -> IO ()
2016-06-05 12:33:53 +00:00
{-# NOINLINE createSymlink' #-}
createSymlink' dest sympoint = withTmpDir dest
(\x -> createSymlink x sympoint)
2016-05-09 14:53:31 +00:00
renameFile' :: ByteString -> ByteString -> IO ()
2016-06-05 12:33:53 +00:00
{-# NOINLINE renameFile' #-}
2016-05-09 14:53:31 +00:00
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 ()
2016-06-05 12:33:53 +00:00
{-# NOINLINE moveFile' #-}
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 ()
2016-06-05 12:33:53 +00:00
{-# NOINLINE recreateSymlink' #-}
recreateSymlink' inputFileP outputFileP cm =
withTmpDir' inputFileP outputFileP (\p1 p2 -> recreateSymlink p1 p2 cm)
2016-05-09 14:53:31 +00:00
noWritableDirPerms :: ByteString -> IO ()
2016-06-05 12:33:53 +00:00
{-# NOINLINE noWritableDirPerms #-}
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 ()
2016-06-05 12:33:53 +00:00
{-# NOINLINE noPerms #-}
noPerms path = withTmpDir path $ \p -> setFileMode (P.fromAbs p) nullFileMode
2016-05-09 14:53:31 +00:00
normalDirPerms :: ByteString -> IO ()
2016-06-05 12:33:53 +00:00
{-# NOINLINE normalDirPerms #-}
2016-05-09 14:53:31 +00:00
normalDirPerms path =
withTmpDir path $ \p -> setFileMode (P.fromAbs p) newDirPerms
2016-05-09 14:53:31 +00:00
2018-04-06 14:42:40 +00:00
normalFilePerms :: ByteString -> IO ()
{-# NOINLINE normalFilePerms #-}
normalFilePerms path =
withTmpDir path $ \p -> setFileMode (P.fromAbs p) newFilePerms
2016-05-09 14:53:31 +00:00
getFileType' :: ByteString -> IO FileType
2016-06-05 12:33:53 +00:00
{-# NOINLINE getFileType' #-}
getFileType' path = withTmpDir path getFileType
2016-05-09 14:53:31 +00:00
getDirsFiles' :: ByteString -> IO [P.Path P.Abs]
2016-06-05 12:33:53 +00:00
{-# NOINLINE getDirsFiles' #-}
getDirsFiles' path = withTmpDir path getDirsFiles
2016-05-09 14:53:31 +00:00
deleteFile' :: ByteString -> IO ()
2016-06-05 12:33:53 +00:00
{-# NOINLINE deleteFile' #-}
deleteFile' p = withTmpDir p deleteFile
2016-05-09 14:53:31 +00:00
deleteDir' :: ByteString -> IO ()
2016-06-05 12:33:53 +00:00
{-# NOINLINE deleteDir' #-}
deleteDir' p = withTmpDir p deleteDir
2016-05-09 14:53:31 +00:00
deleteDirRecursive' :: ByteString -> IO ()
2016-06-05 12:33:53 +00:00
{-# NOINLINE deleteDirRecursive' #-}
deleteDirRecursive' p = withTmpDir p deleteDirRecursive
2016-05-09 14:53:31 +00:00
canonicalizePath' :: ByteString -> IO (P.Path P.Abs)
2016-06-05 12:33:53 +00:00
{-# NOINLINE canonicalizePath' #-}
canonicalizePath' p = withTmpDir p canonicalizePath
2016-05-09 14:53:31 +00:00
writeFile' :: ByteString -> ByteString -> IO ()
2016-06-05 12:33:53 +00:00
{-# NOINLINE writeFile' #-}
writeFile' ip bs =
2018-04-06 15:22:22 +00:00
withTmpDir ip $ \p -> writeFile p bs
appendFile' :: ByteString -> ByteString -> IO ()
{-# NOINLINE appendFile' #-}
appendFile' ip bs =
withTmpDir ip $ \p -> appendFile p bs
allDirectoryContents' :: ByteString -> IO [ByteString]
2016-06-05 12:33:53 +00:00
{-# NOINLINE allDirectoryContents' #-}
allDirectoryContents' ip =
2016-06-05 12:55:21 +00:00
withTmpDir ip $ \p -> DT.allDirectoryContents' (P.fromAbs p)
2018-04-06 14:42:40 +00:00
readFile' :: ByteString -> IO ByteString
{-# NOINLINE readFile' #-}
2020-01-13 22:13:21 +00:00
readFile' p = withTmpDir p (fmap L.toStrict . readFile)
2018-04-06 14:42:40 +00:00