1 Commits

Author SHA1 Message Date
8a19f54a34 Test 2016-11-16 10:23:14 +01:00
18 changed files with 156 additions and 851 deletions

2
.gitignore vendored
View File

@@ -10,5 +10,3 @@ tags
.stack-work/ .stack-work/
.cabal-sandbox/ .cabal-sandbox/
cabal.sandbox.config cabal.sandbox.config
dist-newstyle/
.ghc.environment.*

View File

@@ -7,18 +7,12 @@ dist: trusty
matrix: matrix:
include: include:
- env: CABALVER=1.18 GHCVER=7.6.3
addons: {apt: {packages: [cabal-install-1.18,ghc-7.6.3], sources: [hvr-ghc]}}
- env: CABALVER=1.22 GHCVER=7.8.4 - env: CABALVER=1.22 GHCVER=7.8.4
addons: {apt: {packages: [cabal-install-1.22,ghc-7.8.4], sources: [hvr-ghc]}} addons: {apt: {packages: [cabal-install-1.22,ghc-7.8.4], sources: [hvr-ghc]}}
- env: CABALVER=1.24 GHCVER=7.10.2 - env: CABALVER=1.24 GHCVER=7.10.2
addons: {apt: {packages: [cabal-install-1.24,ghc-7.10.2], sources: [hvr-ghc]}} addons: {apt: {packages: [cabal-install-1.24,ghc-7.10.2], sources: [hvr-ghc]}}
- env: CABALVER=1.24 GHCVER=8.0.1 - env: CABALVER=1.24 GHCVER=8.0.1
addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}} addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}
- env: CABALVER=2.0 GHCVER=8.2.2
addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.2], sources: [hvr-ghc]}}
- env: CABALVER=2.2 GHCVER=8.4.1
addons: {apt: {packages: [cabal-install-2.2,ghc-8.4.1], sources: [hvr-ghc]}}
- env: CABALVER=head GHCVER=head - env: CABALVER=head GHCVER=head
addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}} addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}}

View File

@@ -1,14 +1,3 @@
0.9.2
* fix build with ghc-7.6
* raise required bytestring version
* Tighten base bound to prevent building before GHC 7.6 (by George Wilson)
0.9.1
* fix build with ghc-7.8 and 7.10
0.9.0
* don't force "Path Abs" anymore in IO module, abstract more over Path types
* add 'toAbs'
0.8.1
* add 'readFile', 'readFileEOF', 'writeFile' and 'appendFile'
0.8.0 0.8.0
* 'copyDirRecursiveOverwrite', 'copyFileOverwrite', 'easyCopyOverwrite' and 'moveFileOverwrite' have been removed, instead use the versions without the *Overwrite suffix and pass in 'Strict' (for default behavior) or 'Overwrite' as the CopyMode argument * 'copyDirRecursiveOverwrite', 'copyFileOverwrite', 'easyCopyOverwrite' and 'moveFileOverwrite' have been removed, instead use the versions without the *Overwrite suffix and pass in 'Strict' (for default behavior) or 'Overwrite' as the CopyMode argument
* introduced a new 'RecursiveErrorMode' type to allow controlling recursive behavior of 'copyDirRecursive' (use 'FailEarly' for default behavior) * introduced a new 'RecursiveErrorMode' type to allow controlling recursive behavior of 'copyDirRecursive' (use 'FailEarly' for default behavior)

View File

@@ -1,6 +1,6 @@
# HPath # HPath
[![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage version](https://img.shields.io/hackage/v/hpath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/hpath.svg)](http://packdeps.haskellers.com/feed?needle=hpath) [![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage version](https://img.shields.io/hackage/v/hpath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath)
Support for well-typed paths in Haskell. Also provides ByteString based filepath Support for well-typed paths in Haskell. Also provides ByteString based filepath
manipulation. manipulation.

View File

@@ -8,7 +8,6 @@ main =
doctest doctest
["-isrc" ["-isrc"
, "-XOverloadedStrings" , "-XOverloadedStrings"
, "-XScopedTypeVariables"
, "src/HPath.hs" , "src/HPath.hs"
] ]

View File

@@ -1,5 +1,5 @@
name: hpath name: hpath
version: 0.9.2 version: 0.8.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: BSD3 license: BSD3
@@ -9,7 +9,7 @@ maintainer: Julian Ospald <hasufell@posteo.de>
copyright: Julian Ospald 2016 copyright: Julian Ospald 2016
category: Filesystem category: Filesystem
build-type: Simple build-type: Simple
cabal-version: 1.14 cabal-version: >=1.14
extra-source-files: README.md extra-source-files: README.md
CHANGELOG CHANGELOG
cbits/dirutils.h cbits/dirutils.h
@@ -17,9 +17,6 @@ extra-source-files: README.md
doctests-posix.hs doctests-posix.hs
library library
if os(windows)
build-depends: unbuildable<0
buildable: False
hs-source-dirs: src/ hs-source-dirs: src/
default-language: Haskell2010 default-language: Haskell2010
if impl(ghc >= 8.0) if impl(ghc >= 8.0)
@@ -35,9 +32,9 @@ library
System.Posix.FD, System.Posix.FD,
System.Posix.FilePath System.Posix.FilePath
other-modules: HPath.Internal other-modules: HPath.Internal
build-depends: base >= 4.6 && <5 build-depends: base >= 4.2 && <5
, IfElse , IfElse
, bytestring >= 0.10.0.0 , bytestring >= 0.9.2.0
, deepseq , deepseq
, exceptions , exceptions
, hspec , hspec
@@ -49,9 +46,6 @@ library
test-suite doctests-hpath test-suite doctests-hpath
if os(windows)
build-depends: unbuildable<0
buildable: False
default-language: Haskell2010 default-language: Haskell2010
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
ghc-options: -threaded ghc-options: -threaded
@@ -63,15 +57,12 @@ test-suite doctests-hpath
, hpath , hpath
test-suite doctests-posix test-suite doctests-posix
if os(windows)
build-depends: unbuildable<0
buildable: False
default-language: Haskell2010 default-language: Haskell2010
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
ghc-options: -threaded ghc-options: -threaded
main-is: doctests-posix.hs main-is: doctests-posix.hs
build-depends: base, build-depends: base,
bytestring >= 0.10.0.0, bytestring,
unix, unix,
hpath, hpath,
doctest >= 0.8, doctest >= 0.8,
@@ -79,23 +70,19 @@ test-suite doctests-posix
QuickCheck QuickCheck
test-suite spec test-suite spec
if os(windows)
build-depends: unbuildable<0
buildable: False
Type: exitcode-stdio-1.0 Type: exitcode-stdio-1.0
Default-Language: Haskell2010 Default-Language: Haskell2010
Hs-Source-Dirs: test Hs-Source-Dirs: test
Main-Is: Main.hs Main-Is: Main.hs
other-modules: other-modules:
HPath.IO.AppendFileSpec
HPath.IO.CanonicalizePathSpec HPath.IO.CanonicalizePathSpec
HPath.IO.CopyDirRecursiveCollectFailuresSpec HPath.IO.CopyDirRecursiveCollectFailuresSpec
HPath.IO.CopyDirRecursiveOverwriteSpec HPath.IO.CopyDirRecursiveOverwriteSpec
HPath.IO.CopyDirRecursiveSpec HPath.IO.CopyDirRecursiveSpec
HPath.IO.CopyFileOverwriteSpec HPath.IO.CopyFileOverwriteSpec
HPath.IO.CopyFileSpec HPath.IO.CopyFileSpec
HPath.IO.CreateDirRecursiveSpec
HPath.IO.CreateDirSpec HPath.IO.CreateDirSpec
HPath.IO.CreateDirRecursiveSpec
HPath.IO.CreateRegularFileSpec HPath.IO.CreateRegularFileSpec
HPath.IO.CreateSymlinkSpec HPath.IO.CreateSymlinkSpec
HPath.IO.DeleteDirRecursiveSpec HPath.IO.DeleteDirRecursiveSpec
@@ -105,20 +92,16 @@ test-suite spec
HPath.IO.GetFileTypeSpec HPath.IO.GetFileTypeSpec
HPath.IO.MoveFileOverwriteSpec HPath.IO.MoveFileOverwriteSpec
HPath.IO.MoveFileSpec HPath.IO.MoveFileSpec
HPath.IO.ReadFileEOFSpec
HPath.IO.ReadFileSpec
HPath.IO.RecreateSymlinkOverwriteSpec HPath.IO.RecreateSymlinkOverwriteSpec
HPath.IO.RecreateSymlinkSpec HPath.IO.RecreateSymlinkSpec
HPath.IO.RenameFileSpec HPath.IO.RenameFileSpec
HPath.IO.ToAbsSpec
HPath.IO.WriteFileSpec
Spec Spec
Utils Utils
GHC-Options: -Wall GHC-Options: -Wall
Build-Depends: base Build-Depends: base
, HUnit , HUnit
, IfElse , IfElse
, bytestring >= 0.10.0.0 , bytestring
, hpath , hpath
, hspec >= 1.3 , hspec >= 1.3
, process , process

0
mo Normal file
View File

View File

@@ -10,14 +10,10 @@
-- Support for well-typed paths. -- Support for well-typed paths.
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE EmptyDataDecls #-}
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PatternSynonyms #-}
#endif
{-# LANGUAGE ScopedTypeVariables #-}
module HPath module HPath
( (
@@ -29,10 +25,8 @@ module HPath
,PathParseException ,PathParseException
,PathException ,PathException
,RelC ,RelC
#if __GLASGOW_HASKELL__ >= 708
-- * PatternSynonyms/ViewPatterns -- * PatternSynonyms/ViewPatterns
,pattern Path ,pattern Path
#endif
-- * Path Parsing -- * Path Parsing
,parseAbs ,parseAbs
,parseFn ,parseFn
@@ -41,8 +35,6 @@ module HPath
,fromAbs ,fromAbs
,fromRel ,fromRel
,toFilePath ,toFilePath
,unsafeToString
,unsafeToString'
-- * Path Operations -- * Path Operations
,(</>) ,(</>)
,basename ,basename
@@ -57,10 +49,8 @@ module HPath
) )
where where
import Control.Exception (IOException, Exception, catch) import Control.Exception (Exception)
import Control.Monad ((<$!>))
import Control.Monad.Catch (MonadThrow(..)) import Control.Monad.Catch (MonadThrow(..))
import Data.ByteString.Unsafe(unsafeUseAsCStringLen)
#if MIN_VERSION_bytestring(0,10,8) #if MIN_VERSION_bytestring(0,10,8)
import Data.ByteString(ByteString, stripPrefix) import Data.ByteString(ByteString, stripPrefix)
#else #else
@@ -71,17 +61,10 @@ import qualified Data.ByteString as BS
import Data.Data import Data.Data
import Data.Maybe import Data.Maybe
import Data.Word8 import Data.Word8
import GHC.Foreign(peekCStringLen)
import GHC.IO.Encoding(getLocaleEncoding, TextEncoding)
import HPath.Internal import HPath.Internal
import System.IO.Unsafe(unsafePerformIO)
import System.Posix.FilePath hiding ((</>)) import System.Posix.FilePath hiding ((</>))
-- $setup
-- >>> import GHC.IO.Encoding(utf8)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Types -- Types
@@ -118,9 +101,7 @@ instance RelC Fn
#if __GLASGOW_HASKELL__ >= 710 #if __GLASGOW_HASKELL__ >= 710
pattern Path :: ByteString -> Path a pattern Path :: ByteString -> Path a
#endif #endif
#if __GLASGOW_HASKELL__ >= 708
pattern Path x <- (MkPath x) pattern Path x <- (MkPath x)
#endif
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Path Parsers -- Path Parsers
@@ -245,41 +226,6 @@ fromAbs = toFilePath
fromRel :: RelC r => Path r -> ByteString fromRel :: RelC r => Path r -> ByteString
fromRel = toFilePath fromRel = toFilePath
-- | This converts the underlying bytestring of the path to an unsafe
-- FilePath by assuming the encoding of the current locale setting. This
-- may be utterly wrong, but isn't particularly worse than what the
-- base library does. Blows up on decoding errors.
--
-- >>> unsafeToString (MkPath "/lal/lad")
-- "/lal/lad"
-- >>> unsafeToString (MkPath "/")
-- "/"
-- >>> unsafeToString (MkPath "lad")
-- "lad"
-- >>> catch (Just <$> unsafeToString (MkPath "<22>")) (\(_ :: IOException) -> pure Nothing)
-- Nothing
unsafeToString :: Path b -> IO FilePath
unsafeToString (MkPath p) = do
enc <- getLocaleEncoding
unsafeUseAsCStringLen p (peekCStringLen enc)
-- | Same as @unsafeToString@, except requires the encoding
-- to be passed explicitly. This uses 'unsafePerformIO' and
-- returns 'Nothing' on decoding errors.
--
-- >>> unsafeToString' (MkPath "/lal/lad") utf8
-- Just "/lal/lad"
-- >>> unsafeToString' (MkPath "/") utf8
-- Just "/"
-- >>> unsafeToString' (MkPath "lad") utf8
-- Just "lad"
-- >>> unsafeToString' (MkPath "<22>") utf8
-- Nothing
unsafeToString' :: Path b -> TextEncoding -> Maybe FilePath
unsafeToString' (MkPath !p) enc =
unsafePerformIO $!
catch (Just <$!> unsafeUseAsCStringLen p (peekCStringLen enc))
(\(_ :: IOException) -> pure Nothing)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@@ -368,6 +314,10 @@ getAllParents (MkPath p)
-- | Extract the directory name of a path. -- | Extract the directory name of a path.
-- --
-- The following properties hold:
--
-- @dirname (p \<\/> a) == dirname p@
--
-- >>> dirname (MkPath "/abc/def/dod") -- >>> dirname (MkPath "/abc/def/dod")
-- "/abc/def" -- "/abc/def"
-- >>> dirname (MkPath "/") -- >>> dirname (MkPath "/")

View File

@@ -8,11 +8,8 @@
-- Portability : portable -- Portability : portable
-- --
-- This module provides high-level IO related file operations like -- This module provides high-level IO related file operations like
-- copy, delete, move and so on. It only operates on /Path x/ which -- copy, delete, move and so on. It only operates on /Path Abs/ which
-- guarantees us well-typed paths. Passing in /Path Abs/ to any -- guarantees us well-typed paths which are absolute.
-- of these functions generally increases safety. Passing /Path Rel/
-- may trigger looking up the current directory via `getcwd` in some
-- cases where it cannot be avoided.
-- --
-- Some functions are just path-safe wrappers around -- Some functions are just path-safe wrappers around
-- unix functions, others have stricter exception handling -- unix functions, others have stricter exception handling
@@ -33,7 +30,6 @@
-- For other functions (like `copyFile`), the behavior on these file types is -- For other functions (like `copyFile`), the behavior on these file types is
-- unreliable/unsafe. Check the documentation of those functions for details. -- unreliable/unsafe. Check the documentation of those functions for details.
{-# LANGUAGE CPP #-}
{-# LANGUAGE PackageImports #-} {-# LANGUAGE PackageImports #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
@@ -64,12 +60,6 @@ module HPath.IO
-- * File renaming/moving -- * File renaming/moving
, renameFile , renameFile
, moveFile , moveFile
-- * File reading
, readFile
, readFileEOF
-- * File writing
, writeFile
, appendFile
-- * File permissions -- * File permissions
, newFilePerms , newFilePerms
, newDirPerms , newDirPerms
@@ -79,7 +69,6 @@ module HPath.IO
, getFileType , getFileType
-- * Others -- * Others
, canonicalizePath , canonicalizePath
, toAbs
) )
where where
@@ -108,21 +97,6 @@ import Data.ByteString
( (
ByteString ByteString
) )
#if MIN_VERSION_bytestring(0,10,2)
import Data.ByteString.Builder
#else
import Data.ByteString.Lazy.Builder
#endif
(
Builder
, byteString
, toLazyByteString
)
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Unsafe
(
unsafePackCStringFinalizer
)
import Data.Foldable import Data.Foldable
( (
for_ for_
@@ -138,11 +112,6 @@ import Data.Maybe
( (
catMaybes catMaybes
) )
import Data.Monoid
(
(<>)
, mempty
)
import Data.Word import Data.Word
( (
Word8 Word8
@@ -176,7 +145,7 @@ import GHC.IO.Exception
import HPath import HPath
import HPath.Internal import HPath.Internal
import HPath.IO.Errors import HPath.IO.Errors
import Prelude hiding (appendFile, readFile, writeFile) import Prelude hiding (readFile)
import System.IO.Error import System.IO.Error
( (
catchIOError catchIOError
@@ -194,7 +163,6 @@ import System.Posix.ByteString
import System.Posix.Directory.ByteString import System.Posix.Directory.ByteString
( (
createDirectory createDirectory
, getWorkingDirectory
, removeDirectory , removeDirectory
) )
import System.Posix.Directory.Traversals import System.Posix.Directory.Traversals
@@ -337,11 +305,9 @@ data CopyMode = Strict -- ^ fail if any target exists
-- Throws in `Strict` CopyMode only: -- Throws in `Strict` CopyMode only:
-- --
-- - `AlreadyExists` if destination already exists -- - `AlreadyExists` if destination already exists
-- copyDirRecursive :: Path Abs -- ^ source dir
-- Note: may call `getcwd` (only if destination is a relative path) -> Path Abs -- ^ destination (parent dirs
copyDirRecursive :: Path b1 -- ^ source dir -- are not automatically created)
-> Path b2 -- ^ destination (parent dirs
-- are not automatically created)
-> CopyMode -> CopyMode
-> RecursiveErrorMode -> RecursiveErrorMode
-> IO () -> IO ()
@@ -357,27 +323,27 @@ copyDirRecursive fromp destdirp cm rm
(throwIO . RecursiveFailure $ collectedExceptions) (throwIO . RecursiveFailure $ collectedExceptions)
where where
go :: IORef [(RecursiveFailureHint, IOException)] go :: IORef [(RecursiveFailureHint, IOException)]
-> Path b1 -> Path b2 -> IO () -> Path Abs -> Path Abs -> IO ()
go ce fromp'@(MkPath fromBS) destdirp'@(MkPath destdirpBS) = do go ce fromp' destdirp' = do
-- NOTE: order is important here, so we don't get empty directories -- NOTE: order is important here, so we don't get empty directories
-- on failure -- on failure
-- get the contents of the source dir -- get the contents of the source dir
contents <- handleIOE (ReadContentsFailed fromBS destdirpBS) ce [] $ do contents <- handleIOE (ReadContentsFailed fromp' destdirp') ce [] $ do
contents <- getDirsFiles fromp' contents <- getDirsFiles fromp'
-- create the destination dir and -- create the destination dir and
-- only return contents if we succeed -- only return contents if we succeed
handleIOE (CreateDirFailed fromBS destdirpBS) ce [] $ do handleIOE (CreateDirFailed fromp' destdirp') ce [] $ do
fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus fromBS fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp')
case cm of case cm of
Strict -> createDirectory destdirpBS fmode' Strict -> createDirectory (fromAbs destdirp') fmode'
Overwrite -> catchIOError (createDirectory destdirpBS Overwrite -> catchIOError (createDirectory (fromAbs destdirp')
fmode') fmode')
$ \e -> $ \e ->
case ioeGetErrorType e of case ioeGetErrorType e of
AlreadyExists -> setFileMode destdirpBS AlreadyExists -> setFileMode (fromAbs destdirp')
fmode' fmode'
_ -> ioError e _ -> ioError e
return contents return contents
@@ -391,10 +357,10 @@ copyDirRecursive fromp destdirp cm rm
ftype <- getFileType f ftype <- getFileType f
newdest <- (destdirp' </>) <$> basename f newdest <- (destdirp' </>) <$> basename f
case ftype of case ftype of
SymbolicLink -> handleIOE (RecreateSymlinkFailed (toFilePath f) (toFilePath newdest)) ce () SymbolicLink -> handleIOE (RecreateSymlinkFailed f newdest) ce ()
$ recreateSymlink f newdest cm $ recreateSymlink f newdest cm
Directory -> go ce f newdest Directory -> go ce f newdest
RegularFile -> handleIOE (CopyFileFailed (toFilePath f) (toFilePath newdest)) ce () RegularFile -> handleIOE (CopyFileFailed f newdest) ce ()
$ copyFile f newdest cm $ copyFile f newdest cm
_ -> return () _ -> return ()
@@ -434,27 +400,24 @@ copyDirRecursive fromp destdirp cm rm
-- --
-- - `UnsatisfiedConstraints` if destination file is non-empty directory -- - `UnsatisfiedConstraints` if destination file is non-empty directory
-- --
-- Notes: -- Note: calls `symlink`
-- recreateSymlink :: Path Abs -- ^ the old symlink file
-- - calls `symlink` -> Path Abs -- ^ destination file
-- - calls `getcwd` in Overwrite mode (if destination is a relative path)
recreateSymlink :: Path b1 -- ^ the old symlink file
-> Path b2 -- ^ destination file
-> CopyMode -> CopyMode
-> IO () -> IO ()
recreateSymlink symsource@(MkPath symsourceBS) newsym@(MkPath newsymBS) cm recreateSymlink symsource newsym cm
= do = do
throwSameFile symsource newsym throwSameFile symsource newsym
sympoint <- readSymbolicLink symsourceBS sympoint <- readSymbolicLink (fromAbs symsource)
case cm of case cm of
Strict -> return () Strict -> return ()
Overwrite -> do Overwrite -> do
writable <- toAbs newsym >>= isWritable writable <- isWritable (dirname newsym)
isfile <- doesFileExist newsym isfile <- doesFileExist newsym
isdir <- doesDirectoryExist newsym isdir <- doesDirectoryExist newsym
when (writable && isfile) (deleteFile newsym) when (writable && isfile) (deleteFile newsym)
when (writable && isdir) (deleteDir newsym) when (writable && isdir) (deleteDir newsym)
createSymbolicLink sympoint newsymBS createSymbolicLink sympoint (fromAbs newsym)
-- |Copies the given regular file to the given destination. -- |Copies the given regular file to the given destination.
@@ -491,12 +454,9 @@ recreateSymlink symsource@(MkPath symsourceBS) newsym@(MkPath newsymBS) cm
-- --
-- - `AlreadyExists` if destination already exists -- - `AlreadyExists` if destination already exists
-- --
-- Notes: -- Note: calls `sendfile` and possibly `read`/`write` as fallback
-- copyFile :: Path Abs -- ^ source file
-- - calls `sendfile` and possibly `read`/`write` as fallback -> Path Abs -- ^ destination file
-- - may call `getcwd` in Overwrite mode (if destination is a relative path)
copyFile :: Path b1 -- ^ source file
-> Path b2 -- ^ destination file
-> CopyMode -> CopyMode
-> IO () -> IO ()
copyFile from to cm = do copyFile from to cm = do
@@ -515,8 +475,8 @@ copyFile from to cm = do
-- figure out if we can still copy by deleting it first -- figure out if we can still copy by deleting it first
PermissionDenied -> do PermissionDenied -> do
exists <- doesFileExist to exists <- doesFileExist to
writable <- toAbs to >>= isWritable writable <- isWritable (dirname to)
if (exists && writable) if exists && writable
then deleteFile to >> copyFile from to Strict then deleteFile to >> copyFile from to Strict
else ioError e else ioError e
_ -> ioError e _ -> ioError e
@@ -524,17 +484,18 @@ copyFile from to cm = do
_copyFile :: [SPDF.Flags] _copyFile :: [SPDF.Flags]
-> [SPDF.Flags] -> [SPDF.Flags]
-> Path b1 -- ^ source file -> Path Abs -- ^ source file
-> Path b2 -- ^ destination file -> Path Abs -- ^ destination file
-> IO () -> IO ()
_copyFile sflags dflags (MkPath fromBS) to@(MkPath toBS) _copyFile sflags dflags from to
= =
-- from sendfile(2) manpage: -- from sendfile(2) manpage:
-- Applications may wish to fall back to read(2)/write(2) in -- Applications may wish to fall back to read(2)/write(2) in
-- the case where sendfile() fails with EINVAL or ENOSYS. -- the case where sendfile() fails with EINVAL or ENOSYS.
catchErrno [eINVAL, eNOSYS] withAbsPath to $ \to' -> withAbsPath from $ \from' ->
(sendFileCopy fromBS toBS) catchErrno [eINVAL, eNOSYS]
(void $ readWriteCopy fromBS toBS) (sendFileCopy from' to')
(void $ readWriteCopy from' to')
where where
copyWith copyAction source dest = copyWith copyAction source dest =
bracket (openFd source SPI.ReadOnly sflags Nothing) bracket (openFd source SPI.ReadOnly sflags Nothing)
@@ -579,10 +540,8 @@ _copyFile sflags dflags (MkPath fromBS) to@(MkPath toBS)
-- --
-- * examines filetypes explicitly -- * examines filetypes explicitly
-- * calls `copyDirRecursive` for directories -- * calls `copyDirRecursive` for directories
-- easyCopy :: Path Abs
-- Note: may call `getcwd` in Overwrite mode (if destination is a relative path) -> Path Abs
easyCopy :: Path b1
-> Path b2
-> CopyMode -> CopyMode
-> RecursiveErrorMode -> RecursiveErrorMode
-> IO () -> IO ()
@@ -611,8 +570,8 @@ easyCopy from to cm rm = do
-- - `InappropriateType` for wrong file type (directory) -- - `InappropriateType` for wrong file type (directory)
-- - `NoSuchThing` if the file does not exist -- - `NoSuchThing` if the file does not exist
-- - `PermissionDenied` if the directory cannot be read -- - `PermissionDenied` if the directory cannot be read
deleteFile :: Path b -> IO () deleteFile :: Path Abs -> IO ()
deleteFile (MkPath p) = removeLink p deleteFile p = withAbsPath p removeLink
-- |Deletes the given directory, which must be empty, never symlinks. -- |Deletes the given directory, which must be empty, never symlinks.
@@ -626,8 +585,8 @@ deleteFile (MkPath p) = removeLink p
-- - `PermissionDenied` if we can't open or write to parent directory -- - `PermissionDenied` if we can't open or write to parent directory
-- --
-- Notes: calls `rmdir` -- Notes: calls `rmdir`
deleteDir :: Path b -> IO () deleteDir :: Path Abs -> IO ()
deleteDir (MkPath p) = removeDirectory p deleteDir p = withAbsPath p removeDirectory
-- |Deletes the given directory recursively. Does not follow symbolic -- |Deletes the given directory recursively. Does not follow symbolic
@@ -649,7 +608,7 @@ deleteDir (MkPath p) = removeDirectory p
-- - `InappropriateType` for wrong file type (regular file) -- - `InappropriateType` for wrong file type (regular file)
-- - `NoSuchThing` if directory does not exist -- - `NoSuchThing` if directory does not exist
-- - `PermissionDenied` if we can't open or write to parent directory -- - `PermissionDenied` if we can't open or write to parent directory
deleteDirRecursive :: Path b -> IO () deleteDirRecursive :: Path Abs -> IO ()
deleteDirRecursive p = deleteDirRecursive p =
catchErrno [eNOTEMPTY, eEXIST] catchErrno [eNOTEMPTY, eEXIST]
(deleteDir p) (deleteDir p)
@@ -674,7 +633,7 @@ deleteDirRecursive p =
-- --
-- * examines filetypes explicitly -- * examines filetypes explicitly
-- * calls `deleteDirRecursive` for directories -- * calls `deleteDirRecursive` for directories
easyDelete :: Path b -> IO () easyDelete :: Path Abs -> IO ()
easyDelete p = do easyDelete p = do
ftype <- getFileType p ftype <- getFileType p
case ftype of case ftype of
@@ -693,18 +652,21 @@ easyDelete p = do
-- |Opens a file appropriately by invoking xdg-open. The file type -- |Opens a file appropriately by invoking xdg-open. The file type
-- is not checked. This forks a process. -- is not checked. This forks a process.
openFile :: Path b openFile :: Path Abs
-> IO ProcessID -> IO ProcessID
openFile (MkPath fp) = openFile p =
SPP.forkProcess $ SPP.executeFile "xdg-open" True [fp] Nothing withAbsPath p $ \fp ->
SPP.forkProcess $ SPP.executeFile "xdg-open" True [fp] Nothing
-- |Executes a program with the given arguments. This forks a process. -- |Executes a program with the given arguments. This forks a process.
executeFile :: Path b -- ^ program executeFile :: Path Abs -- ^ program
-> [ByteString] -- ^ arguments -> [ByteString] -- ^ arguments
-> IO ProcessID -> IO ProcessID
executeFile (MkPath fp) args = executeFile fp args
SPP.forkProcess $ SPP.executeFile fp True args Nothing = withAbsPath fp $ \fpb ->
SPP.forkProcess
$ SPP.executeFile fpb True args Nothing
@@ -723,9 +685,9 @@ executeFile (MkPath fp) args =
-- - `AlreadyExists` if destination already exists -- - `AlreadyExists` if destination already exists
-- - `NoSuchThing` if any of the parent components of the path -- - `NoSuchThing` if any of the parent components of the path
-- do not exist -- do not exist
createRegularFile :: FileMode -> Path b -> IO () createRegularFile :: FileMode -> Path Abs -> IO ()
createRegularFile fm (MkPath destBS) = createRegularFile fm dest =
bracket (SPI.openFd destBS SPI.WriteOnly (Just fm) bracket (SPI.openFd (fromAbs dest) SPI.WriteOnly (Just fm)
(SPI.defaultFileFlags { exclusive = True })) (SPI.defaultFileFlags { exclusive = True }))
SPI.closeFd SPI.closeFd
(\_ -> return ()) (\_ -> return ())
@@ -739,8 +701,8 @@ createRegularFile fm (MkPath destBS) =
-- - `AlreadyExists` if destination already exists -- - `AlreadyExists` if destination already exists
-- - `NoSuchThing` if any of the parent components of the path -- - `NoSuchThing` if any of the parent components of the path
-- do not exist -- do not exist
createDir :: FileMode -> Path b -> IO () createDir :: FileMode -> Path Abs -> IO ()
createDir fm (MkPath destBS) = createDirectory destBS fm createDir fm dest = createDirectory (fromAbs dest) fm
-- |Create an empty directory at the given directory with the given filename. -- |Create an empty directory at the given directory with the given filename.
@@ -761,21 +723,15 @@ createDir fm (MkPath destBS) = createDirectory destBS fm
-- exist and cannot be written to -- exist and cannot be written to
-- - `AlreadyExists` if destination already exists and -- - `AlreadyExists` if destination already exists and
-- is not a directory -- is not a directory
-- createDirRecursive :: FileMode -> Path Abs -> IO ()
-- Note: calls `getcwd` if the input path is a relative path createDirRecursive fm dest =
createDirRecursive :: FileMode -> Path b -> IO () catchIOError (createDirectory (fromAbs dest) fm) $ \e -> do
createDirRecursive fm p = errno <- getErrno
toAbs p >>= go case errno of
where en | en == eEXIST -> unlessM (doesDirectoryExist dest) (ioError e)
go :: Path Abs -> IO () | en == eNOENT -> createDirRecursive fm (dirname dest)
go dest@(MkPath destBS) = do >> createDirectory (fromAbs dest) fm
catchIOError (createDirectory destBS fm) $ \e -> do | otherwise -> ioError e
errno <- getErrno
case errno of
en | en == eEXIST -> unlessM (doesDirectoryExist dest) (ioError e)
| en == eNOENT -> createDirRecursive fm (dirname dest)
>> createDirectory destBS fm
| otherwise -> ioError e
-- |Create a symlink. -- |Create a symlink.
@@ -788,11 +744,11 @@ createDirRecursive fm p =
-- do not exist -- do not exist
-- --
-- Note: calls `symlink` -- Note: calls `symlink`
createSymlink :: Path b -- ^ destination file createSymlink :: Path Abs -- ^ destination file
-> ByteString -- ^ path the symlink points to -> ByteString -- ^ path the symlink points to
-> IO () -> IO ()
createSymlink (MkPath destBS) sympoint createSymlink dest sympoint
= createSymbolicLink sympoint destBS = createSymbolicLink sympoint (fromAbs dest)
@@ -822,12 +778,12 @@ createSymlink (MkPath destBS) sympoint
-- (`HPathIOException`) -- (`HPathIOException`)
-- --
-- Note: calls `rename` (but does not allow to rename over existing files) -- Note: calls `rename` (but does not allow to rename over existing files)
renameFile :: Path b1 -> Path b2 -> IO () renameFile :: Path Abs -> Path Abs -> IO ()
renameFile fromf@(MkPath fromfBS) tof@(MkPath tofBS) = do renameFile fromf tof = do
throwSameFile fromf tof throwSameFile fromf tof
throwFileDoesExist tof throwFileDoesExist tof
throwDirDoesExist tof throwDirDoesExist tof
rename fromfBS tofBS rename (fromAbs fromf) (fromAbs tof)
-- |Move a file. This also works across devices by copy-delete fallback. -- |Move a file. This also works across devices by copy-delete fallback.
@@ -858,12 +814,9 @@ renameFile fromf@(MkPath fromfBS) tof@(MkPath tofBS) = do
-- --
-- - `AlreadyExists` if destination already exists -- - `AlreadyExists` if destination already exists
-- --
-- Notes: -- Note: calls `rename` (but does not allow to rename over existing files)
-- moveFile :: Path Abs -- ^ file to move
-- - calls `rename` (but does not allow to rename over existing files) -> Path Abs -- ^ destination
-- - calls `getcwd` in Overwrite mode if destination is a relative path
moveFile :: Path b1 -- ^ file to move
-> Path b2 -- ^ destination
-> CopyMode -> CopyMode
-> IO () -> IO ()
moveFile from to cm = do moveFile from to cm = do
@@ -874,7 +827,7 @@ moveFile from to cm = do
easyDelete from easyDelete from
Overwrite -> do Overwrite -> do
ft <- getFileType from ft <- getFileType from
writable <- toAbs to >>= isWritable writable <- isWritable $ dirname to
case ft of case ft of
RegularFile -> do RegularFile -> do
exists <- doesFileExist to exists <- doesFileExist to
@@ -892,110 +845,6 @@ moveFile from to cm = do
--------------------
--[ File Reading ]--
--------------------
-- |Read the given file at once into memory as a strict ByteString.
-- Symbolic links are followed, no sanity checks on file size
-- or file type. File must exist.
--
-- Note: the size of the file is determined in advance, as to only
-- have one allocation.
--
-- Safety/reliability concerns:
--
-- * since amount of bytes to read is determined in advance,
-- the file might be read partially only if something else is
-- appending to it while reading
-- * the whole file is read into memory!
--
-- Throws:
--
-- - `InappropriateType` if file is not a regular file or a symlink
-- - `PermissionDenied` if we cannot read the file or the directory
-- containting it
-- - `NoSuchThing` if the file does not exist
readFile :: Path b -> IO ByteString
readFile (MkPath fp) =
bracket (openFd fp SPI.ReadOnly [] Nothing) (SPI.closeFd) $ \fd -> do
stat <- PF.getFdStatus fd
let fsize = PF.fileSize stat
SPB.fdRead fd (fromIntegral fsize)
-- |Read the given file in chunks of size `8192` into memory until
-- `fread` returns 0. Returns a lazy ByteString, because it uses
-- Builders under the hood.
--
-- Safety/reliability concerns:
--
-- * the whole file is read into memory!
--
-- Throws:
--
-- - `InappropriateType` if file is not a regular file or a symlink
-- - `PermissionDenied` if we cannot read the file or the directory
-- containting it
-- - `NoSuchThing` if the file does not exist
readFileEOF :: Path b -> IO L.ByteString
readFileEOF (MkPath fp) =
bracket (openFd fp SPI.ReadOnly [] Nothing) (SPI.closeFd) $ \fd ->
allocaBytes (fromIntegral bufSize) $ \buf -> read' fd buf mempty
where
bufSize :: CSize
bufSize = 8192
read' :: Fd -> Ptr Word8 -> Builder -> IO L.ByteString
read' fd buf builder = do
size <- SPB.fdReadBuf fd buf bufSize
if size == 0
then return $ toLazyByteString builder
else do
readBS <- unsafePackCStringFinalizer buf
(fromIntegral size)
(return ())
read' fd buf (builder <> byteString readBS)
--------------------
--[ File Writing ]--
--------------------
-- |Write a given ByteString to a file, truncating the file beforehand.
-- The file must exist. Follows symlinks.
--
-- Throws:
--
-- - `InappropriateType` if file is not a regular file or a symlink
-- - `PermissionDenied` if we cannot read the file or the directory
-- containting it
-- - `NoSuchThing` if the file does not exist
writeFile :: Path b -> ByteString -> IO ()
writeFile (MkPath fp) bs =
bracket (openFd fp SPI.WriteOnly [SPDF.oTrunc] Nothing) (SPI.closeFd) $ \fd ->
void $ SPB.fdWrite fd bs
-- |Append a given ByteString to a file.
-- The file must exist. Follows symlinks.
--
-- Throws:
--
-- - `InappropriateType` if file is not a regular file or a symlink
-- - `PermissionDenied` if we cannot read the file or the directory
-- containting it
-- - `NoSuchThing` if the file does not exist
appendFile :: Path b -> ByteString -> IO ()
appendFile (MkPath fp) bs =
bracket (openFd fp SPI.WriteOnly [SPDF.oAppend] Nothing)
(SPI.closeFd) $ \fd -> void $ SPB.fdWrite fd bs
----------------------- -----------------------
--[ File Permissions]-- --[ File Permissions]--
@@ -1041,14 +890,15 @@ newDirPerms
-- - `InappropriateType` if file type is wrong (symlink to file) -- - `InappropriateType` if file type is wrong (symlink to file)
-- - `InappropriateType` if file type is wrong (symlink to dir) -- - `InappropriateType` if file type is wrong (symlink to dir)
-- - `PermissionDenied` if directory cannot be opened -- - `PermissionDenied` if directory cannot be opened
getDirsFiles :: Path b -- ^ dir to read getDirsFiles :: Path Abs -- ^ dir to read
-> IO [Path b] -> IO [Path Abs]
getDirsFiles p@(MkPath fp) = do getDirsFiles p =
fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing withAbsPath p $ \fp -> do
return fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing
. catMaybes return
. fmap (\x -> (</>) p <$> (parseMaybe . snd $ x)) . catMaybes
=<< getDirectoryContents' fd . fmap (\x -> (</>) p <$> (parseMaybe . snd $ x))
=<< getDirectoryContents' fd
where where
parseMaybe :: ByteString -> Maybe (Path Fn) parseMaybe :: ByteString -> Maybe (Path Fn)
parseMaybe = parseFn parseMaybe = parseFn
@@ -1068,9 +918,9 @@ getDirsFiles p@(MkPath fp) = do
-- --
-- - `NoSuchThing` if the file does not exist -- - `NoSuchThing` if the file does not exist
-- - `PermissionDenied` if any part of the path is not accessible -- - `PermissionDenied` if any part of the path is not accessible
getFileType :: Path b -> IO FileType getFileType :: Path Abs -> IO FileType
getFileType (MkPath fp) = do getFileType p = do
fs <- PF.getSymbolicLinkStatus fp fs <- PF.getSymbolicLinkStatus (fromAbs p)
decide fs decide fs
where where
decide fs decide fs
@@ -1091,29 +941,13 @@ getFileType (MkPath fp) = do
-- |Applies `realpath` on the given path. -- |Applies `realpath` on the given absolute path.
-- --
-- Throws: -- Throws:
-- --
-- - `NoSuchThing` if the file at the given path does not exist -- - `NoSuchThing` if the file at the given path does not exist
-- - `NoSuchThing` if the symlink is broken -- - `NoSuchThing` if the symlink is broken
canonicalizePath :: Path b -> IO (Path Abs) canonicalizePath :: Path Abs -> IO (Path Abs)
canonicalizePath (MkPath l) = do canonicalizePath (MkPath l) = do
nl <- SPDT.realpath l nl <- SPDT.realpath l
return $ MkPath nl return $ MkPath nl
-- |Converts any path to an absolute path.
-- This is done in the following way:
--
-- - if the path is already an absolute one, just return it
-- - if it's a relative path, prepend the current directory to it
toAbs :: Path b -> IO (Path Abs)
toAbs (MkPath bs) = do
let mabs = parseAbs bs :: Maybe (Path Abs)
case mabs of
Just a -> return a
Nothing -> do
cwd <- getWorkingDirectory >>= parseAbs
rel <- parseRel bs -- we know it must be relative now
return $ cwd </> rel

View File

@@ -3,6 +3,5 @@ module HPath.IO where
import HPath import HPath
canonicalizePath :: Path b -> IO (Path Abs) canonicalizePath :: Path Abs -> IO (Path Abs)
toAbs :: Path b -> IO (Path Abs)

View File

@@ -84,14 +84,9 @@ import GHC.IO.Exception
IOErrorType IOErrorType
) )
import HPath import HPath
import HPath.Internal
(
Path(..)
)
import {-# SOURCE #-} HPath.IO import {-# SOURCE #-} HPath.IO
( (
canonicalizePath canonicalizePath
, toAbs
) )
import System.IO.Error import System.IO.Error
( (
@@ -124,10 +119,10 @@ data HPathIOException = SameFile ByteString ByteString
-- --
-- The first argument to the data constructor is always the -- The first argument to the data constructor is always the
-- source and the second the destination. -- source and the second the destination.
data RecursiveFailureHint = ReadContentsFailed ByteString ByteString data RecursiveFailureHint = ReadContentsFailed (Path Abs) (Path Abs)
| CreateDirFailed ByteString ByteString | CreateDirFailed (Path Abs) (Path Abs)
| CopyFileFailed ByteString ByteString | CopyFileFailed (Path Abs) (Path Abs)
| RecreateSymlinkFailed ByteString ByteString | RecreateSymlinkFailed (Path Abs) (Path Abs)
deriving (Eq, Show) deriving (Eq, Show)
@@ -174,50 +169,51 @@ isRecreateSymlinkFailed _ = False
-- |Throws `AlreadyExists` `IOError` if file exists. -- |Throws `AlreadyExists` `IOError` if file exists.
throwFileDoesExist :: Path b -> IO () throwFileDoesExist :: Path Abs -> IO ()
throwFileDoesExist fp@(MkPath bs) = throwFileDoesExist fp =
whenM (doesFileExist fp) whenM (doesFileExist fp)
(ioError . mkIOError (ioError . mkIOError
alreadyExistsErrorType alreadyExistsErrorType
"File already exists" "File already exists"
Nothing Nothing
$ (Just (toString $ bs)) $ (Just (toString $ fromAbs fp))
) )
-- |Throws `AlreadyExists` `IOError` if directory exists. -- |Throws `AlreadyExists` `IOError` if directory exists.
throwDirDoesExist :: Path b -> IO () throwDirDoesExist :: Path Abs -> IO ()
throwDirDoesExist fp@(MkPath bs) = throwDirDoesExist fp =
whenM (doesDirectoryExist fp) whenM (doesDirectoryExist fp)
(ioError . mkIOError (ioError . mkIOError
alreadyExistsErrorType alreadyExistsErrorType
"Directory already exists" "Directory already exists"
Nothing Nothing
$ (Just (toString $ bs)) $ (Just (toString $ fromAbs fp))
) )
-- |Uses `isSameFile` and throws `SameFile` if it returns True. -- |Uses `isSameFile` and throws `SameFile` if it returns True.
throwSameFile :: Path b1 throwSameFile :: Path Abs
-> Path b2 -> Path Abs
-> IO () -> IO ()
throwSameFile fp1@(MkPath bs1) fp2@(MkPath bs2) = throwSameFile fp1 fp2 =
whenM (sameFile fp1 fp2) whenM (sameFile fp1 fp2)
(throwIO $ SameFile bs1 bs2) (throwIO $ SameFile (fromAbs fp1) (fromAbs fp2))
-- |Check if the files are the same by examining device and file id. -- |Check if the files are the same by examining device and file id.
-- This follows symbolic links. -- This follows symbolic links.
sameFile :: Path b1 -> Path b2 -> IO Bool sameFile :: Path Abs -> Path Abs -> IO Bool
sameFile (MkPath fp1) (MkPath fp2) = sameFile fp1 fp2 =
handleIOError (\_ -> return False) $ do withAbsPath fp1 $ \fp1' -> withAbsPath fp2 $ \fp2' ->
fs1 <- getFileStatus fp1 handleIOError (\_ -> return False) $ do
fs2 <- getFileStatus fp2 fs1 <- getFileStatus fp1'
fs2 <- getFileStatus fp2'
if ((PF.deviceID fs1, PF.fileID fs1) == if ((PF.deviceID fs1, PF.fileID fs1) ==
(PF.deviceID fs2, PF.fileID fs2)) (PF.deviceID fs2, PF.fileID fs2))
then return True then return True
else return False else return False
-- TODO: make this more robust when destination does not exist -- TODO: make this more robust when destination does not exist
@@ -225,54 +221,54 @@ sameFile (MkPath fp1) (MkPath fp2) =
-- within the source directory by comparing the device+file ID of the -- within the source directory by comparing the device+file ID of the
-- source directory with all device+file IDs of the parent directories -- source directory with all device+file IDs of the parent directories
-- of the destination. -- of the destination.
throwDestinationInSource :: Path b1 -- ^ source dir throwDestinationInSource :: Path Abs -- ^ source dir
-> Path b2 -- ^ full destination, @dirname dest@ -> Path Abs -- ^ full destination, @dirname dest@
-- must exist -- must exist
-> IO () -> IO ()
throwDestinationInSource (MkPath sbs) dest@(MkPath dbs) = do throwDestinationInSource source dest = do
destAbs <- toAbs dest
dest' <- (\x -> maybe x (\y -> x </> y) $ basename dest) dest' <- (\x -> maybe x (\y -> x </> y) $ basename dest)
<$> (canonicalizePath $ dirname destAbs) <$> (canonicalizePath $ 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)
sid <- fmap (\x -> (PF.deviceID x, PF.fileID x)) sid <- fmap (\x -> (PF.deviceID x, PF.fileID x))
$ PF.getFileStatus sbs $ PF.getFileStatus (fromAbs source)
when (elem sid dids) when (elem sid dids)
(throwIO $ DestinationInSource dbs sbs) (throwIO $ DestinationInSource (fromAbs dest)
(fromAbs source))
-- |Checks if the given file exists and is not a directory. -- |Checks if the given file exists and is not a directory.
-- Does not follow symlinks. -- Does not follow symlinks.
doesFileExist :: Path b -> IO Bool doesFileExist :: Path Abs -> IO Bool
doesFileExist (MkPath bs) = doesFileExist fp =
handleIOError (\_ -> return False) $ do handleIOError (\_ -> return False) $ do
fs <- PF.getSymbolicLinkStatus bs fs <- PF.getSymbolicLinkStatus (fromAbs fp)
return $ not . PF.isDirectory $ fs return $ not . PF.isDirectory $ fs
-- |Checks if the given file exists and is a directory. -- |Checks if the given file exists and is a directory.
-- Does not follow symlinks. -- Does not follow symlinks.
doesDirectoryExist :: Path b -> IO Bool doesDirectoryExist :: Path Abs -> IO Bool
doesDirectoryExist (MkPath bs) = doesDirectoryExist fp =
handleIOError (\_ -> return False) $ do handleIOError (\_ -> return False) $ do
fs <- PF.getSymbolicLinkStatus bs fs <- PF.getSymbolicLinkStatus (fromAbs fp)
return $ PF.isDirectory fs return $ PF.isDirectory fs
-- |Checks whether a file or folder is writable. -- |Checks whether a file or folder is writable.
isWritable :: Path b -> IO Bool isWritable :: Path Abs -> IO Bool
isWritable (MkPath bs) = isWritable fp =
handleIOError (\_ -> return False) $ handleIOError (\_ -> return False) $
fileAccess bs False True False fileAccess (fromAbs fp) False True False
-- |Checks whether the directory at the given path exists and can be -- |Checks whether the directory at the given path exists and can be
-- opened. This invokes `openDirStream` which follows symlinks. -- opened. This invokes `openDirStream` which follows symlinks.
canOpenDirectory :: Path b -> IO Bool canOpenDirectory :: Path Abs -> IO Bool
canOpenDirectory (MkPath bs) = canOpenDirectory fp =
handleIOError (\_ -> return False) $ do handleIOError (\_ -> return False) $ do
bracket (PFD.openDirStream bs) bracket (PFD.openDirStream . fromAbs $ fp)
PFD.closeDirStream PFD.closeDirStream
(\_ -> return ()) (\_ -> return ())
return True return True

View File

@@ -1,7 +0,0 @@
resolver: lts-12.1
packages:
- '.'
extra-deps:
- IfElse-0.85

View File

@@ -1,108 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.AppendFileSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "AppendFileSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "fileWithContent"
createRegularFile' "fileWithoutContent"
createSymlink' "inputFileSymL" "fileWithContent"
createDir' "alreadyExistsD"
createRegularFile' "noPerms"
noPerms "noPerms"
createDir' "noPermsD"
createRegularFile' "noPermsD/inputFile"
noPerms "noPermsD"
writeFile' "fileWithContent" "BLKASL"
cleanupFiles :: IO ()
cleanupFiles = do
deleteFile' "fileWithContent"
deleteFile' "fileWithoutContent"
deleteFile' "inputFileSymL"
deleteDir' "alreadyExistsD"
normalFilePerms "noPerms"
deleteFile' "noPerms"
normalDirPerms "noPermsD"
deleteFile' "noPermsD/inputFile"
deleteDir' "noPermsD"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.appendFile" $ do
-- successes --
it "appendFile file with content, everything clear" $ do
appendFile' "fileWithContent" "blahfaselllll"
out <- readFile' "fileWithContent"
out `shouldBe` "BLKASLblahfaselllll"
it "appendFile file with content, everything clear" $ do
appendFile' "fileWithContent" "gagagaga"
out <- readFile' "fileWithContent"
out `shouldBe` "BLKASLblahfaselllllgagagaga"
it "appendFile file with content, everything clear" $ do
appendFile' "fileWithContent" ""
out <- readFile' "fileWithContent"
out `shouldBe` "BLKASLblahfaselllllgagagaga"
it "appendFile file without content, everything clear" $ do
appendFile' "fileWithoutContent" "blahfaselllll"
out <- readFile' "fileWithoutContent"
out `shouldBe` "blahfaselllll"
it "appendFile, everything clear" $ do
appendFile' "fileWithoutContent" "gagagaga"
out <- readFile' "fileWithoutContent"
out `shouldBe` "blahfaselllllgagagaga"
it "appendFile symlink, everything clear" $ do
appendFile' "inputFileSymL" "blahfaselllll"
out <- readFile' "inputFileSymL"
out `shouldBe` "BLKASLblahfaselllllgagagagablahfaselllll"
it "appendFile symlink, everything clear" $ do
appendFile' "inputFileSymL" "gagagaga"
out <- readFile' "inputFileSymL"
out `shouldBe` "BLKASLblahfaselllllgagagagablahfaselllllgagagaga"
-- posix failures --
it "appendFile to dir, inappropriate type" $ do
appendFile' "alreadyExistsD" ""
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)
it "appendFile, no permissions to file" $ do
appendFile' "noPerms" ""
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "appendFile, no permissions to file" $ do
appendFile' "noPermsD/inputFile" ""
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "appendFile, file does not exist" $ do
appendFile' "gaga" ""
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)

View File

@@ -1,85 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.ReadFileEOFSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "ReadFileEOFSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "fileWithContent"
createRegularFile' "fileWithoutContent"
createSymlink' "inputFileSymL" "fileWithContent"
createDir' "alreadyExistsD"
createRegularFile' "noPerms"
noPerms "noPerms"
createDir' "noPermsD"
createRegularFile' "noPermsD/inputFile"
noPerms "noPermsD"
writeFile' "fileWithContent" "Blahfaselgagaga"
cleanupFiles :: IO ()
cleanupFiles = do
deleteFile' "fileWithContent"
deleteFile' "fileWithoutContent"
deleteFile' "inputFileSymL"
deleteDir' "alreadyExistsD"
normalFilePerms "noPerms"
deleteFile' "noPerms"
normalDirPerms "noPermsD"
deleteFile' "noPermsD/inputFile"
deleteDir' "noPermsD"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.readFileEOF" $ do
-- successes --
it "readFileEOF (Strict) file with content, everything clear" $ do
out <- readFileEOF' "fileWithContent"
out `shouldBe` "Blahfaselgagaga"
it "readFileEOF (Strict) symlink, everything clear" $ do
out <- readFileEOF' "inputFileSymL"
out `shouldBe` "Blahfaselgagaga"
it "readFileEOF (Strict) empty file, everything clear" $ do
out <- readFileEOF' "fileWithoutContent"
out `shouldBe` ""
-- posix failures --
it "readFileEOF (Strict) directory, wrong file type" $ do
readFileEOF' "alreadyExistsD"
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)
it "readFileEOF (Strict) file, no permissions" $ do
readFileEOF' "noPerms"
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "readFileEOF (Strict) file, no permissions on dir" $ do
readFileEOF' "noPermsD/inputFile"
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "readFileEOF (Strict) file, no such file" $ do
readFileEOF' "lalala"
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)

View File

@@ -1,85 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.ReadFileSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "ReadFileSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "fileWithContent"
createRegularFile' "fileWithoutContent"
createSymlink' "inputFileSymL" "fileWithContent"
createDir' "alreadyExistsD"
createRegularFile' "noPerms"
noPerms "noPerms"
createDir' "noPermsD"
createRegularFile' "noPermsD/inputFile"
noPerms "noPermsD"
writeFile' "fileWithContent" "Blahfaselgagaga"
cleanupFiles :: IO ()
cleanupFiles = do
deleteFile' "fileWithContent"
deleteFile' "fileWithoutContent"
deleteFile' "inputFileSymL"
deleteDir' "alreadyExistsD"
normalFilePerms "noPerms"
deleteFile' "noPerms"
normalDirPerms "noPermsD"
deleteFile' "noPermsD/inputFile"
deleteDir' "noPermsD"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.readFile" $ do
-- successes --
it "readFile (Strict) file with content, everything clear" $ do
out <- readFile' "fileWithContent"
out `shouldBe` "Blahfaselgagaga"
it "readFile (Strict) symlink, everything clear" $ do
out <- readFile' "inputFileSymL"
out `shouldBe` "Blahfaselgagaga"
it "readFile (Strict) empty file, everything clear" $ do
out <- readFile' "fileWithoutContent"
out `shouldBe` ""
-- posix failures --
it "readFile (Strict) directory, wrong file type" $ do
readFile' "alreadyExistsD"
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)
it "readFile (Strict) file, no permissions" $ do
readFile' "noPerms"
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "readFile (Strict) file, no permissions on dir" $ do
readFile' "noPermsD/inputFile"
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "readFile (Strict) file, no such file" $ do
readFile' "lalala"
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)

View File

@@ -1,27 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.ToAbsSpec where
import Test.Hspec
import HPath
import HPath.IO
spec :: Spec
spec = describe "HPath.IO.toAbs" $ do
-- successes --
it "toAbs returns absolute paths unchanged" $ do
p1 <- parseAbs "/a/b/c/d"
to <- toAbs p1
p1 `shouldBe` to
it "toAbs returns even existing absolute paths unchanged" $ do
p1 <- parseAbs "/home"
to <- toAbs p1
p1 `shouldBe` to

View File

@@ -1,108 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.WriteFileSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "WriteFileSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "fileWithContent"
createRegularFile' "fileWithoutContent"
createSymlink' "inputFileSymL" "fileWithContent"
createDir' "alreadyExistsD"
createRegularFile' "noPerms"
noPerms "noPerms"
createDir' "noPermsD"
createRegularFile' "noPermsD/inputFile"
noPerms "noPermsD"
writeFile' "fileWithContent" "BLKASL"
cleanupFiles :: IO ()
cleanupFiles = do
deleteFile' "fileWithContent"
deleteFile' "fileWithoutContent"
deleteFile' "inputFileSymL"
deleteDir' "alreadyExistsD"
normalFilePerms "noPerms"
deleteFile' "noPerms"
normalDirPerms "noPermsD"
deleteFile' "noPermsD/inputFile"
deleteDir' "noPermsD"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.writeFile" $ do
-- successes --
it "writeFile file with content, everything clear" $ do
writeFile' "fileWithContent" "blahfaselllll"
out <- readFile' "fileWithContent"
out `shouldBe` "blahfaselllll"
it "writeFile file with content, everything clear" $ do
writeFile' "fileWithContent" "gagagaga"
out <- readFile' "fileWithContent"
out `shouldBe` "gagagaga"
it "writeFile file with content, everything clear" $ do
writeFile' "fileWithContent" ""
out <- readFile' "fileWithContent"
out `shouldBe` ""
it "writeFile file without content, everything clear" $ do
writeFile' "fileWithoutContent" "blahfaselllll"
out <- readFile' "fileWithoutContent"
out `shouldBe` "blahfaselllll"
it "writeFile, everything clear" $ do
writeFile' "fileWithoutContent" "gagagaga"
out <- readFile' "fileWithoutContent"
out `shouldBe` "gagagaga"
it "writeFile symlink, everything clear" $ do
writeFile' "inputFileSymL" "blahfaselllll"
out <- readFile' "inputFileSymL"
out `shouldBe` "blahfaselllll"
it "writeFile symlink, everything clear" $ do
writeFile' "inputFileSymL" "gagagaga"
out <- readFile' "inputFileSymL"
out `shouldBe` "gagagaga"
-- posix failures --
it "writeFile to dir, inappropriate type" $ do
writeFile' "alreadyExistsD" ""
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)
it "writeFile, no permissions to file" $ do
writeFile' "noPerms" ""
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "writeFile, no permissions to file" $ do
writeFile' "noPermsD/inputFile" ""
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "writeFile, file does not exist" $ do
writeFile' "gaga" ""
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)

View File

@@ -28,7 +28,6 @@ import Data.IORef
) )
import HPath.IO import HPath.IO
import HPath.IO.Errors import HPath.IO.Errors
import Prelude hiding (appendFile, readFile, writeFile)
import Data.Maybe import Data.Maybe
( (
fromJust fromJust
@@ -47,7 +46,6 @@ import Data.ByteString
( (
ByteString ByteString
) )
import qualified Data.ByteString.Lazy as L
import System.Posix.Files.ByteString import System.Posix.Files.ByteString
( (
groupExecuteMode groupExecuteMode
@@ -61,6 +59,9 @@ import System.Posix.Files.ByteString
, unionFileModes , unionFileModes
) )
import qualified "unix" System.Posix.IO.ByteString as SPI
import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB
baseTmpDir :: ByteString baseTmpDir :: ByteString
@@ -242,12 +243,6 @@ normalDirPerms path =
withTmpDir path $ \p -> setFileMode (P.fromAbs p) newDirPerms withTmpDir path $ \p -> setFileMode (P.fromAbs p) newDirPerms
normalFilePerms :: ByteString -> IO ()
{-# NOINLINE normalFilePerms #-}
normalFilePerms path =
withTmpDir path $ \p -> setFileMode (P.fromAbs p) newFilePerms
getFileType' :: ByteString -> IO FileType getFileType' :: ByteString -> IO FileType
{-# NOINLINE getFileType' #-} {-# NOINLINE getFileType' #-}
getFileType' path = withTmpDir path getFileType getFileType' path = withTmpDir path getFileType
@@ -281,13 +276,11 @@ canonicalizePath' p = withTmpDir p canonicalizePath
writeFile' :: ByteString -> ByteString -> IO () writeFile' :: ByteString -> ByteString -> IO ()
{-# NOINLINE writeFile' #-} {-# NOINLINE writeFile' #-}
writeFile' ip bs = writeFile' ip bs =
withTmpDir ip $ \p -> writeFile p bs withTmpDir ip $ \p -> do
fd <- SPI.openFd (P.fromAbs p) SPI.WriteOnly Nothing
SPI.defaultFileFlags
appendFile' :: ByteString -> ByteString -> IO () _ <- SPB.fdWrite fd bs
{-# NOINLINE appendFile' #-} SPI.closeFd fd
appendFile' ip bs =
withTmpDir ip $ \p -> appendFile p bs
allDirectoryContents' :: ByteString -> IO [ByteString] allDirectoryContents' :: ByteString -> IO [ByteString]
@@ -295,13 +288,3 @@ allDirectoryContents' :: ByteString -> IO [ByteString]
allDirectoryContents' ip = allDirectoryContents' ip =
withTmpDir ip $ \p -> DT.allDirectoryContents' (P.fromAbs p) withTmpDir ip $ \p -> DT.allDirectoryContents' (P.fromAbs p)
readFile' :: ByteString -> IO ByteString
{-# NOINLINE readFile' #-}
readFile' p = withTmpDir p readFile
readFileEOF' :: ByteString -> IO L.ByteString
{-# NOINLINE readFileEOF' #-}
readFileEOF' p = withTmpDir p readFileEOF