Compare commits
8 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 456af3b1ab | |||
| f841a53985 | |||
| eb27c368e6 | |||
| c76df7f159 | |||
| 613754c58f | |||
| d8b0b99edf | |||
| 794c3a2fc4 | |||
| 8a28a5dd0f |
@@ -1,3 +1,9 @@
|
|||||||
|
0.6.0:
|
||||||
|
* fixes 'throwDestinationInSource' to be more reliable.
|
||||||
|
* removes some unused HPathIOException constructors
|
||||||
|
* consistently provide exception constructor identifiers
|
||||||
|
* be less harsh when non-supported file types get passed to our functions, possibly ignoring them
|
||||||
|
* minor cleanups
|
||||||
0.5.9:
|
0.5.9:
|
||||||
* Adds our posix-paths fork and a lot of IO operations.
|
* Adds our posix-paths fork and a lot of IO operations.
|
||||||
0.5.8:
|
0.5.8:
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
name: hpath
|
name: hpath
|
||||||
version: 0.5.9
|
version: 0.6.0
|
||||||
synopsis: Support for well-typed paths
|
synopsis: Support for well-typed paths
|
||||||
description: Support for well-typed paths, utilizing ByteString under the hood.
|
description: Support for well-typed paths, utilizing ByteString under the hood.
|
||||||
license: GPL-2
|
license: GPL-2
|
||||||
|
|||||||
@@ -27,7 +27,8 @@
|
|||||||
--
|
--
|
||||||
-- Note: `BlockDevice`, `CharacterDevice`, `NamedPipe` and `Socket`
|
-- Note: `BlockDevice`, `CharacterDevice`, `NamedPipe` and `Socket`
|
||||||
-- are not explicitly supported right now. Calling any of these
|
-- are not explicitly supported right now. Calling any of these
|
||||||
-- functions on such a file may throw an exception.
|
-- functions on such a file may throw an exception or just do
|
||||||
|
-- nothing.
|
||||||
|
|
||||||
{-# LANGUAGE PackageImports #-}
|
{-# LANGUAGE PackageImports #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
@@ -185,6 +186,11 @@ import System.Posix.Types
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-------------
|
||||||
|
--[ Types ]--
|
||||||
|
-------------
|
||||||
|
|
||||||
|
|
||||||
data FileType = Directory
|
data FileType = Directory
|
||||||
| RegularFile
|
| RegularFile
|
||||||
| SymbolicLink
|
| SymbolicLink
|
||||||
@@ -252,8 +258,7 @@ copyDirRecursive fromp destdirp
|
|||||||
SymbolicLink -> recreateSymlink f newdest
|
SymbolicLink -> recreateSymlink f newdest
|
||||||
Directory -> go f newdest
|
Directory -> go f newdest
|
||||||
RegularFile -> copyFile f newdest
|
RegularFile -> copyFile f newdest
|
||||||
_ -> ioError $ userError $ "No idea what to do with the" ++
|
_ -> return ()
|
||||||
"given filetype: " ++ show ftype
|
|
||||||
|
|
||||||
|
|
||||||
-- |Like `copyDirRecursive` except it overwrites contents of directories
|
-- |Like `copyDirRecursive` except it overwrites contents of directories
|
||||||
@@ -298,9 +303,7 @@ copyDirRecursiveOverwrite fromp destdirp
|
|||||||
>> recreateSymlink f newdest
|
>> recreateSymlink f newdest
|
||||||
Directory -> go f newdest
|
Directory -> go f newdest
|
||||||
RegularFile -> copyFileOverwrite f newdest
|
RegularFile -> copyFileOverwrite f newdest
|
||||||
_ -> ioError $ userError $ "No idea what to do with the" ++
|
_ -> return ()
|
||||||
"given filetype: " ++ show ftype
|
|
||||||
|
|
||||||
|
|
||||||
-- |Recreate a symlink.
|
-- |Recreate a symlink.
|
||||||
--
|
--
|
||||||
@@ -395,13 +398,13 @@ _copyFile :: [SPDF.Flags]
|
|||||||
-> IO ()
|
-> IO ()
|
||||||
_copyFile sflags dflags from to
|
_copyFile sflags dflags from to
|
||||||
=
|
=
|
||||||
-- TODO: add sendfile support
|
-- TODO: add sendfile support
|
||||||
withAbsPath to $ \to' -> withAbsPath from $ \from' ->
|
void $ readWriteCopy (fromAbs from) (fromAbs to)
|
||||||
void $ fallbackCopy from' to'
|
|
||||||
where
|
where
|
||||||
-- low-level copy operation utilizing read(2)/write(2)
|
-- low-level copy operation utilizing read(2)/write(2)
|
||||||
-- in case `sendFileCopy` fails/is unsupported
|
-- in case `sendFileCopy` fails/is unsupported
|
||||||
fallbackCopy source dest =
|
readWriteCopy :: ByteString -> ByteString -> IO Int
|
||||||
|
readWriteCopy source dest =
|
||||||
bracket (SPDT.openFd source SPI.ReadOnly sflags Nothing)
|
bracket (SPDT.openFd source SPI.ReadOnly sflags Nothing)
|
||||||
SPI.closeFd
|
SPI.closeFd
|
||||||
$ \sfd -> do
|
$ \sfd -> do
|
||||||
@@ -442,8 +445,7 @@ easyCopy from to = do
|
|||||||
SymbolicLink -> recreateSymlink from to
|
SymbolicLink -> recreateSymlink from to
|
||||||
RegularFile -> copyFile from to
|
RegularFile -> copyFile from to
|
||||||
Directory -> copyDirRecursive from to
|
Directory -> copyDirRecursive from to
|
||||||
_ -> ioError $ userError $ "No idea what to do with the" ++
|
_ -> return ()
|
||||||
"given filetype: " ++ show ftype
|
|
||||||
|
|
||||||
|
|
||||||
-- |Like `easyCopy` except it overwrites the destination if it already exists.
|
-- |Like `easyCopy` except it overwrites the destination if it already exists.
|
||||||
@@ -459,8 +461,7 @@ easyCopyOverwrite from to = do
|
|||||||
>> recreateSymlink from to
|
>> recreateSymlink from to
|
||||||
RegularFile -> copyFileOverwrite from to
|
RegularFile -> copyFileOverwrite from to
|
||||||
Directory -> copyDirRecursiveOverwrite from to
|
Directory -> copyDirRecursiveOverwrite from to
|
||||||
_ -> ioError $ userError $ "No idea what to do with the" ++
|
_ -> return ()
|
||||||
"given filetype: " ++ show ftype
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -526,8 +527,7 @@ deleteDirRecursive p =
|
|||||||
SymbolicLink -> deleteFile file
|
SymbolicLink -> deleteFile file
|
||||||
Directory -> deleteDirRecursive file
|
Directory -> deleteDirRecursive file
|
||||||
RegularFile -> deleteFile file
|
RegularFile -> deleteFile file
|
||||||
_ -> ioError $ userError $ "No idea what to do with the" ++
|
_ -> return ()
|
||||||
"given filetype: " ++ show ftype
|
|
||||||
removeDirectory . toFilePath $ p
|
removeDirectory . toFilePath $ p
|
||||||
|
|
||||||
|
|
||||||
@@ -546,8 +546,7 @@ easyDelete p = do
|
|||||||
SymbolicLink -> deleteFile p
|
SymbolicLink -> deleteFile p
|
||||||
Directory -> deleteDirRecursive p
|
Directory -> deleteDirRecursive p
|
||||||
RegularFile -> deleteFile p
|
RegularFile -> deleteFile p
|
||||||
_ -> ioError $ userError $ "No idea what to do with the" ++
|
_ -> return ()
|
||||||
"given filetype: " ++ show ftype
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -705,8 +704,7 @@ moveFileOverwrite from to = do
|
|||||||
Directory -> do
|
Directory -> do
|
||||||
exists <- doesDirectoryExist to
|
exists <- doesDirectoryExist to
|
||||||
when (exists && writable) (deleteDir to)
|
when (exists && writable) (deleteDir to)
|
||||||
_ -> ioError $ userError $ "Don't know how to handle filetype " ++
|
_ -> return ()
|
||||||
show ft
|
|
||||||
moveFile from to
|
moveFile from to
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
7
src/HPath/IO.hs-boot
Normal file
7
src/HPath/IO.hs-boot
Normal file
@@ -0,0 +1,7 @@
|
|||||||
|
module HPath.IO where
|
||||||
|
|
||||||
|
|
||||||
|
import HPath
|
||||||
|
|
||||||
|
canonicalizePath :: Path Abs -> IO (Path Abs)
|
||||||
|
|
||||||
@@ -12,7 +12,44 @@
|
|||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
|
||||||
module HPath.IO.Errors where
|
module HPath.IO.Errors
|
||||||
|
(
|
||||||
|
-- * Types
|
||||||
|
HPathIOException(..)
|
||||||
|
|
||||||
|
-- * Exception identifiers
|
||||||
|
, isFileDoesNotExist
|
||||||
|
, isDirDoesNotExist
|
||||||
|
, isSameFile
|
||||||
|
, isDestinationInSource
|
||||||
|
, isFileDoesExist
|
||||||
|
, isDirDoesExist
|
||||||
|
, isInvalidOperation
|
||||||
|
, isCan'tOpenDirectory
|
||||||
|
, isCopyFailed
|
||||||
|
|
||||||
|
-- * Path based functions
|
||||||
|
, throwFileDoesExist
|
||||||
|
, throwDirDoesExist
|
||||||
|
, throwFileDoesNotExist
|
||||||
|
, throwDirDoesNotExist
|
||||||
|
, throwSameFile
|
||||||
|
, sameFile
|
||||||
|
, throwDestinationInSource
|
||||||
|
, doesFileExist
|
||||||
|
, doesDirectoryExist
|
||||||
|
, isWritable
|
||||||
|
, canOpenDirectory
|
||||||
|
, throwCantOpenDirectory
|
||||||
|
|
||||||
|
-- * Error handling functions
|
||||||
|
, catchErrno
|
||||||
|
, rethrowErrnoAs
|
||||||
|
, handleIOError
|
||||||
|
, bracketeer
|
||||||
|
, reactOnError
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
@@ -44,6 +81,10 @@ import GHC.IO.Exception
|
|||||||
IOErrorType
|
IOErrorType
|
||||||
)
|
)
|
||||||
import HPath
|
import HPath
|
||||||
|
import {-# SOURCE #-} HPath.IO
|
||||||
|
(
|
||||||
|
canonicalizePath
|
||||||
|
)
|
||||||
import HPath.IO.Utils
|
import HPath.IO.Utils
|
||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
(
|
(
|
||||||
@@ -62,20 +103,13 @@ import qualified System.Posix.Files.ByteString as PF
|
|||||||
|
|
||||||
data HPathIOException = FileDoesNotExist ByteString
|
data HPathIOException = FileDoesNotExist ByteString
|
||||||
| DirDoesNotExist ByteString
|
| DirDoesNotExist ByteString
|
||||||
| PathNotAbsolute ByteString
|
|
||||||
| FileNotExecutable ByteString
|
|
||||||
| SameFile ByteString ByteString
|
| SameFile ByteString ByteString
|
||||||
| NotAFile ByteString
|
|
||||||
| NotADir ByteString
|
|
||||||
| DestinationInSource ByteString ByteString
|
| DestinationInSource ByteString ByteString
|
||||||
| FileDoesExist ByteString
|
| FileDoesExist ByteString
|
||||||
| DirDoesExist ByteString
|
| DirDoesExist ByteString
|
||||||
| IsSymlink ByteString
|
|
||||||
| InvalidOperation String
|
| InvalidOperation String
|
||||||
| InvalidFileName
|
|
||||||
| Can'tOpenDirectory ByteString
|
| Can'tOpenDirectory ByteString
|
||||||
| CopyFailed String
|
| CopyFailed String
|
||||||
| MoveFailed String
|
|
||||||
deriving (Typeable, Eq, Data)
|
deriving (Typeable, Eq, Data)
|
||||||
|
|
||||||
|
|
||||||
@@ -83,26 +117,18 @@ instance Show HPathIOException where
|
|||||||
show (FileDoesNotExist fp) = "File does not exist:" ++ fpToString fp
|
show (FileDoesNotExist fp) = "File does not exist:" ++ fpToString fp
|
||||||
show (DirDoesNotExist fp) = "Directory does not exist: "
|
show (DirDoesNotExist fp) = "Directory does not exist: "
|
||||||
++ fpToString fp
|
++ fpToString fp
|
||||||
show (PathNotAbsolute fp) = "Path not absolute: " ++ fpToString fp
|
|
||||||
show (FileNotExecutable fp) = "File not executable: "
|
|
||||||
++ fpToString fp
|
|
||||||
show (SameFile fp1 fp2) = fpToString fp1
|
show (SameFile fp1 fp2) = fpToString fp1
|
||||||
++ " and " ++ fpToString fp2
|
++ " and " ++ fpToString fp2
|
||||||
++ " are the same file!"
|
++ " are the same file!"
|
||||||
show (NotAFile fp) = "Not a file: " ++ fpToString fp
|
|
||||||
show (NotADir fp) = "Not a directory: " ++ fpToString fp
|
|
||||||
show (DestinationInSource fp1 fp2) = fpToString fp1
|
show (DestinationInSource fp1 fp2) = fpToString fp1
|
||||||
++ " is contained in "
|
++ " is contained in "
|
||||||
++ fpToString fp2
|
++ fpToString fp2
|
||||||
show (FileDoesExist fp) = "File does exist: " ++ fpToString fp
|
show (FileDoesExist fp) = "File does exist: " ++ fpToString fp
|
||||||
show (DirDoesExist fp) = "Directory does exist: " ++ fpToString fp
|
show (DirDoesExist fp) = "Directory does exist: " ++ fpToString fp
|
||||||
show (IsSymlink fp) = "Is a symlink: " ++ fpToString fp
|
|
||||||
show (InvalidOperation str) = "Invalid operation: " ++ str
|
show (InvalidOperation str) = "Invalid operation: " ++ str
|
||||||
show InvalidFileName = "Invalid file name!"
|
|
||||||
show (Can'tOpenDirectory fp) = "Can't open directory: "
|
show (Can'tOpenDirectory fp) = "Can't open directory: "
|
||||||
++ fpToString fp
|
++ fpToString fp
|
||||||
show (CopyFailed str) = "Copying failed: " ++ str
|
show (CopyFailed str) = "Copying failed: " ++ str
|
||||||
show (MoveFailed str) = "Moving failed: " ++ str
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -110,24 +136,23 @@ instance Exception HPathIOException
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
isDestinationInSource :: HPathIOException -> Bool
|
|
||||||
isDestinationInSource (DestinationInSource _ _) = True
|
|
||||||
isDestinationInSource _ = False
|
|
||||||
|
|
||||||
|
|
||||||
isSameFile :: HPathIOException -> Bool
|
-----------------------------
|
||||||
isSameFile (SameFile _ _) = True
|
--[ Exception identifiers ]--
|
||||||
isSameFile _ = False
|
-----------------------------
|
||||||
|
|
||||||
|
isFileDoesNotExist, isDirDoesNotExist, isSameFile, isDestinationInSource, isFileDoesExist, isDirDoesExist, isInvalidOperation, isCan'tOpenDirectory, isCopyFailed :: HPathIOException -> Bool
|
||||||
|
isFileDoesNotExist ex = toConstr (ex :: HPathIOException) == toConstr FileDoesNotExist{}
|
||||||
|
isDirDoesNotExist ex = toConstr (ex :: HPathIOException) == toConstr DirDoesNotExist{}
|
||||||
|
isSameFile ex = toConstr (ex :: HPathIOException) == toConstr SameFile{}
|
||||||
|
isDestinationInSource ex = toConstr (ex :: HPathIOException) == toConstr DestinationInSource{}
|
||||||
|
isFileDoesExist ex = toConstr (ex :: HPathIOException) == toConstr FileDoesExist{}
|
||||||
|
isDirDoesExist ex = toConstr (ex :: HPathIOException) == toConstr DirDoesExist{}
|
||||||
|
isInvalidOperation ex = toConstr (ex :: HPathIOException) == toConstr InvalidOperation{}
|
||||||
|
isCan'tOpenDirectory ex = toConstr (ex :: HPathIOException) == toConstr Can'tOpenDirectory{}
|
||||||
|
isCopyFailed ex = toConstr (ex :: HPathIOException) == toConstr CopyFailed{}
|
||||||
|
|
||||||
isFileDoesExist :: HPathIOException -> Bool
|
|
||||||
isFileDoesExist (FileDoesExist _) = True
|
|
||||||
isFileDoesExist _ = False
|
|
||||||
|
|
||||||
|
|
||||||
isDirDoesExist :: HPathIOException -> Bool
|
|
||||||
isDirDoesExist (DirDoesExist _) = True
|
|
||||||
isDirDoesExist _ = False
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -194,8 +219,7 @@ throwDestinationInSource :: Path Abs -- ^ source dir
|
|||||||
-> IO ()
|
-> IO ()
|
||||||
throwDestinationInSource source dest = do
|
throwDestinationInSource source dest = do
|
||||||
dest' <- (\x -> maybe x (\y -> x </> y) $ basename dest)
|
dest' <- (\x -> maybe x (\y -> x </> y) $ basename dest)
|
||||||
{- <$> (canonicalizePath $ P.dirname dest) -}
|
<$> (canonicalizePath $ dirname dest)
|
||||||
<$> (return $ dirname dest)
|
|
||||||
dids <- forM (getAllParents dest') $ \p -> do
|
dids <- forM (getAllParents dest') $ \p -> do
|
||||||
fs <- PF.getSymbolicLinkStatus (fromAbs p)
|
fs <- PF.getSymbolicLinkStatus (fromAbs p)
|
||||||
return (PF.deviceID fs, PF.fileID fs)
|
return (PF.deviceID fs, PF.fileID fs)
|
||||||
|
|||||||
Reference in New Issue
Block a user