3 Commits

Author SHA1 Message Date
a452b44cfe Blub 2016-04-26 12:23:47 +02:00
8bcdb84efd LIB: add mkdirP 2016-04-26 01:45:24 +02:00
746daf9ba6 LIB: first try of bookmarks 2016-04-25 02:08:44 +02:00
137 changed files with 667 additions and 2661 deletions

3
.gitmodules vendored
View File

@@ -1,6 +1,9 @@
[submodule "3rdparty/hpath"]
path = 3rdparty/hpath
url = https://github.com/hasufell/hpath.git
[submodule "3rdparty/hinotify"]
path = 3rdparty/hinotify
url = https://github.com/hasufell/hinotify.git
[submodule "3rdparty/simple-sendfile"]
path = 3rdparty/simple-sendfile
url = https://github.com/hasufell/simple-sendfile.git

1
3rdparty/hinotify vendored Submodule

Submodule 3rdparty/hinotify added at 6751bf0cc8

2
3rdparty/hpath vendored

View File

@@ -23,6 +23,7 @@ Installation
```
git submodule update --init --recursive
cabal sandbox init
cabal sandbox add-source 3rdparty/hinotify
cabal sandbox add-source 3rdparty/hpath
cabal sandbox add-source 3rdparty/hpath/3rdparty/posix-paths
cabal sandbox add-source 3rdparty/simple-sendfile

View File

@@ -27,18 +27,21 @@ library
HSFM.FileSystem.Errors
HSFM.FileSystem.FileOperations
HSFM.FileSystem.FileType
HSFM.FileSystem.UtilTypes
HSFM.Settings.Bookmarks
HSFM.Utils.IO
HSFM.Utils.MyPrelude
build-depends:
attoparsec,
base >= 4.7,
bytestring,
containers,
data-default,
errors,
filepath >= 1.3.0.0,
hinotify-bytestring,
hinotify,
hpath,
monad-loops,
mtl >= 2.2,
old-locale >= 1,
posix-paths,
@@ -49,7 +52,8 @@ library
time >= 1.4.2,
unix,
unix-bytestring,
utf8-string
utf8-string,
word8
hs-source-dirs: src
default-language: Haskell2010
Default-Extensions: RecordWildCards
@@ -67,7 +71,6 @@ executable hsfm-gtk
other-modules:
HSFM.GUI.Glib.GlibString
HSFM.GUI.Gtk.Callbacks
HSFM.GUI.Gtk.Callbacks.Utils
HSFM.GUI.Gtk.Data
HSFM.GUI.Gtk.Dialogs
HSFM.GUI.Gtk.Errors
@@ -86,7 +89,7 @@ executable hsfm-gtk
filepath >= 1.3.0.0,
glib >= 0.13,
gtk3 >= 0.14.1,
hinotify-bytestring,
hinotify,
hpath,
hsfm,
mtl >= 2.2,
@@ -113,38 +116,3 @@ executable hsfm-gtk
-threaded
-Wall
"-with-rtsopts=-N"
Test-Suite spec
Type: exitcode-stdio-1.0
Default-Language: Haskell2010
Hs-Source-Dirs: test
Main-Is: Main.hs
other-modules:
Spec
FileSystem.FileOperations.CopyDirRecursiveSpec
FileSystem.FileOperations.CopyDirRecursiveOverwriteSpec
FileSystem.FileOperations.CopyFileSpec
FileSystem.FileOperations.CopyFileOverwriteSpec
FileSystem.FileOperations.CreateDirSpec
FileSystem.FileOperations.CreateRegularFileSpec
FileSystem.FileOperations.DeleteDirRecursiveSpec
FileSystem.FileOperations.DeleteDirSpec
FileSystem.FileOperations.DeleteFileSpec
FileSystem.FileOperations.GetDirsFilesSpec
FileSystem.FileOperations.GetFileTypeSpec
FileSystem.FileOperations.MoveFileSpec
FileSystem.FileOperations.MoveFileOverwriteSpec
FileSystem.FileOperations.RecreateSymlinkSpec
FileSystem.FileOperations.RenameFileSpec
Utils
GHC-Options: -Wall
Build-Depends: base
, HUnit
, bytestring
, hpath
, hsfm
, hspec >= 1.3
, process
, unix
, utf8-string

View File

@@ -17,7 +17,6 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
--}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_HADDOCK ignore-exports #-}
-- |Provides error handling.
@@ -27,27 +26,19 @@ module HSFM.FileSystem.Errors where
import Control.Exception
import Control.Monad
(
forM
, when
when
, forM
)
import Data.ByteString
(
ByteString
)
import Data.Data
(
Data(..)
)
import Data.Typeable
import Foreign.C.Error
(
getErrno
, Errno
)
import GHC.IO.Exception
(
IOErrorType
)
import qualified HPath as P
import HPath
(
@@ -58,15 +49,10 @@ import HSFM.Utils.IO
import System.IO.Error
(
catchIOError
, ioeGetErrorType
)
import qualified System.Posix.Directory.ByteString as PFD
import System.Posix.Files.ByteString
(
fileAccess
, getFileStatus
)
import System.Posix.FilePath
import qualified System.Posix.Files.ByteString as PF
@@ -86,7 +72,7 @@ data FmIOException = FileDoesNotExist ByteString
| Can'tOpenDirectory ByteString
| CopyFailed String
| MoveFailed String
deriving (Typeable, Eq, Data)
deriving (Typeable)
instance Show FmIOException where
@@ -120,26 +106,6 @@ instance Exception FmIOException
isDestinationInSource :: FmIOException -> Bool
isDestinationInSource (DestinationInSource _ _) = True
isDestinationInSource _ = False
isSameFile :: FmIOException -> Bool
isSameFile (SameFile _ _) = True
isSameFile _ = False
isFileDoesExist :: FmIOException -> Bool
isFileDoesExist (FileDoesExist _) = True
isFileDoesExist _ = False
isDirDoesExist :: FmIOException -> Bool
isDirDoesExist (DirDoesExist _) = True
isDirDoesExist _ = False
----------------------------
--[ Path based functions ]--
@@ -160,38 +126,28 @@ throwDirDoesExist fp =
throwFileDoesNotExist :: Path Abs -> IO ()
throwFileDoesNotExist fp =
unlessM (doesFileExist fp) (throw . FileDoesNotExist
. P.fromAbs $ fp)
whenM (doesFileExist fp) (throw . FileDoesExist
. P.fromAbs $ fp)
throwDirDoesNotExist :: Path Abs -> IO ()
throwDirDoesNotExist fp =
unlessM (doesDirectoryExist fp) (throw . DirDoesNotExist
. P.fromAbs $ fp)
whenM (doesDirectoryExist fp) (throw . DirDoesExist
. P.fromAbs $ fp)
-- |Uses `isSameFile` and throws `SameFile` if it returns True.
throwSameFile :: Path Abs
-> Path Abs
throwSameFile :: Path Abs -- ^ will be canonicalized
-> Path Abs -- ^ will be canonicalized
-> IO ()
throwSameFile fp1 fp2 =
whenM (sameFile fp1 fp2)
(throw $ SameFile (P.fromAbs fp1) (P.fromAbs fp2))
-- |Check if the files are the same by examining device and file id.
-- This follows symbolic links.
sameFile :: Path Abs -> Path Abs -> IO Bool
sameFile fp1 fp2 =
P.withAbsPath fp1 $ \fp1' -> P.withAbsPath fp2 $ \fp2' ->
handleIOError (\_ -> return False) $ do
fs1 <- getFileStatus fp1'
fs2 <- getFileStatus fp2'
if ((PF.deviceID fs1, PF.fileID fs1) ==
(PF.deviceID fs2, PF.fileID fs2))
then return True
else return False
throwSameFile fp1 fp2 = do
fp1' <- fmap P.fromAbs $ P.canonicalizePath fp1
-- TODO: clean this up... if canonicalizing fp2 fails we try to
-- canonicalize `dirname fp2`
fp2' <- catchIOError (fmap P.fromAbs $ P.canonicalizePath fp2)
(\_ -> fmap P.fromAbs
$ (\x -> maybe x (\y -> x P.</> y) $ P.basename fp2)
<$> (P.canonicalizePath $ P.dirname fp2))
when (equalFilePath fp1' fp2') (throw $ SameFile fp1' fp2')
-- |Checks whether the destination directory is contained
@@ -203,45 +159,41 @@ throwDestinationInSource :: Path Abs -- ^ source dir
-- must exist
-> IO ()
throwDestinationInSource source dest = do
source' <- P.canonicalizePath source
dest' <- (\x -> maybe x (\y -> x P.</> y) $ P.basename dest)
<$> (P.canonicalizePath $ P.dirname dest)
dids <- forM (P.getAllParents dest') $ \p -> do
fs <- PF.getSymbolicLinkStatus (P.fromAbs p)
return (PF.deviceID fs, PF.fileID fs)
sid <- fmap (\x -> (PF.deviceID x, PF.fileID x))
$ PF.getFileStatus (P.fromAbs source)
$ PF.getSymbolicLinkStatus (P.fromAbs source')
when (elem sid dids)
(throw $ DestinationInSource (P.fromAbs dest)
(P.fromAbs source))
-- |Checks if the given file exists and is not a directory.
-- Does not follow symlinks.
-- |Checks if the given file exists and is not a directory. This follows
-- symlinks, but will return True if the symlink is broken.
doesFileExist :: Path Abs -> IO Bool
doesFileExist fp =
handleIOError (\_ -> return False) $ do
fs <- PF.getSymbolicLinkStatus (P.fromAbs fp)
fp' <- fmap P.fromAbs $ P.canonicalizePath fp
fs <- PF.getFileStatus fp'
return $ not . PF.isDirectory $ fs
-- |Checks if the given file exists and is a directory.
-- Does not follow symlinks.
-- |Checks if the given file exists and is a directory. This follows
-- symlinks, but will return False if the symlink is broken.
doesDirectoryExist :: Path Abs -> IO Bool
doesDirectoryExist fp =
handleIOError (\_ -> return False) $ do
fs <- PF.getSymbolicLinkStatus (P.fromAbs fp)
fp' <- fmap P.fromAbs $ P.canonicalizePath fp
fs <- PF.getFileStatus fp'
return $ PF.isDirectory fs
-- |Checks whether a file or folder is writable.
isWritable :: Path Abs -> IO Bool
isWritable fp =
handleIOError (\_ -> return False) $
fileAccess (P.fromAbs fp) False True False
-- |Checks whether the directory at the given path exists and can be
-- opened. This invokes `openDirStream` which follows symlinks.
-- opened. This invokes `openDirStream`.
canOpenDirectory :: Path Abs -> IO Bool
canOpenDirectory fp =
handleIOError (\_ -> return False) $ do
@@ -297,43 +249,3 @@ rethrowErrnoAs en fmex action = catchErrno en action (throw fmex)
handleIOError :: (IOError -> IO a) -> IO a -> IO a
handleIOError = flip catchIOError
-- |Like `bracket`, but allows to have different clean-up
-- actions depending on whether the in-between computation
-- has raised an exception or not.
bracketeer :: IO a -- ^ computation to run first
-> (a -> IO b) -- ^ computation to run last, when
-- no exception was raised
-> (a -> IO b) -- ^ computation to run last,
-- when an exception was raised
-> (a -> IO c) -- ^ computation to run in-between
-> IO c
bracketeer before after afterEx thing =
mask $ \restore -> do
a <- before
r <- restore (thing a) `onException` afterEx a
_ <- after a
return r
reactOnError :: IO a
-> [(IOErrorType, IO a)] -- ^ reaction on IO errors
-> [(FmIOException, IO a)] -- ^ reaction on FmIOException
-> IO a
reactOnError a ios fmios =
a `catches` [iohandler, fmiohandler]
where
iohandler = Handler $
\(ex :: IOException) ->
foldr (\(t, a') y -> if ioeGetErrorType ex == t
then a'
else y)
(throwIO ex)
ios
fmiohandler = Handler $
\(ex :: FmIOException) ->
foldr (\(t, a') y -> if toConstr ex == toConstr t
then a'
else y)
(throwIO ex)
fmios

File diff suppressed because it is too large Load Diff

View File

@@ -18,44 +18,39 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
{-# OPTIONS_HADDOCK ignore-exports #-}
-- |This module provides a data type for representing directories/files
-- in a well-typed and convenient way. This is useful to gather and
-- save information about a file, so the information can be easily
-- processed in e.g. a GUI.
-- |This module provides data types for representing directories/files
-- and related operations on it, mostly internal stuff.
--
-- However, it's not meant to be used to interact with low-level
-- functions that copy files etc, since there's no guarantee that
-- the in-memory representation of the type still matches what is
-- happening on filesystem level.
--
-- If you interact with low-level libraries, you must not pattern
-- match on the `File a` type. Instead, you should only use the saved
-- `path` and make no assumptions about the file the path might or
-- might not point to.
-- It doesn't allow to represent the whole filesystem, since that's only
-- possible through IO laziness, which introduces too much internal state.
module HSFM.FileSystem.FileType where
import Data.ByteString(ByteString)
import Data.Default
import Data.Maybe
(
catMaybes
)
import Data.Time.Clock.POSIX
(
POSIXTime
, posixSecondsToUTCTime
)
import Data.Time()
import Foreign.C.Error
(
eACCES
)
import HPath
(
Abs
, Path
, Fn
)
import qualified HPath as P
import HSFM.FileSystem.Errors
import HSFM.FileSystem.FileOperations
(
getDirsFiles
)
import HSFM.Utils.MyPrelude
import Prelude hiding(readFile)
import System.IO.Error
@@ -69,7 +64,8 @@ import System.Posix.FilePath
)
import System.Posix.Directory.Traversals
(
realpath
getDirectoryContents
, realpath
)
import qualified System.Posix.Files.ByteString as PF
import System.Posix.Types
@@ -97,7 +93,8 @@ import System.Posix.Types
-- |The String in the path field is always a full path.
-- The free type variable is used in the File/Dir constructor and can hold
-- Handles, Strings representing a file's contents or anything else you can
-- think of. We catch any IO errors in the Failed constructor.
-- think of. We catch any IO errors in the Failed constructor. an Exception
-- can be converted to a String with 'show'.
data File a =
Failed {
path :: !(Path Abs)
@@ -464,7 +461,19 @@ isSocketC _ = False
---- IO HELPERS: ----
-- |Gets all filenames of the given directory. This excludes "." and "..".
getDirsFiles :: Path Abs -- ^ dir to read
-> IO [Path Abs]
getDirsFiles p =
P.withAbsPath p $ \fp ->
rethrowErrnoAs [eACCES] (Can'tOpenDirectory fp)
$ return
. catMaybes
. fmap (\x -> (P.</>) p <$> (parseMaybe . snd $ x))
=<< getDirectoryContents fp
where
parseMaybe :: ByteString -> Maybe (Path Fn)
parseMaybe = P.parseFn
-- |Gets all file information.

View File

@@ -1,84 +0,0 @@
{--
HSFM, a filemanager written in Haskell.
Copyright (C) 2016 Julian Ospald
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
version 2 as published by the Free Software Foundation.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
--}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK ignore-exports #-}
-- |This module provides high-level IO related file operations like
-- copy, delete, move and so on. It only operates on `Path Abs` which
-- guarantees us well-typed paths which are absolute.
--
-- Some functions are just path-safe wrappers around
-- unix functions, others have stricter exception handling
-- and some implement functionality that doesn't have a unix
-- counterpart (like `copyDirRecursive`).
--
-- Some of these operations are due to their nature not _atomic_, which
-- means they may do multiple syscalls which form one context. Some
-- of them also have to examine the filetypes explicitly before the
-- syscalls, so a reasonable decision can be made. That means
-- the result is undefined if another process changes that context
-- while the non-atomic operation is still happening. However, where
-- possible, as few syscalls as possible are used and the underlying
-- exception handling is kept.
module HSFM.FileSystem.UtilTypes where
import Data.ByteString
(
ByteString
)
import HPath
(
Path
, Abs
, Fn
)
-- |Data type describing file operations.
-- Useful to build up a list of operations or delay operations.
data FileOperation = FCopy Copy
| FMove Move
| FDelete [Path Abs]
| FOpen (Path Abs)
| FExecute (Path Abs) [ByteString]
| None
-- |Data type describing partial or complete file copy operation.
data Copy = PartialCopy [Path Abs] -- source files
| Copy [Path Abs] -- source files
(Path Abs) -- base destination directory
-- |Data type describing partial or complete file move operation.
data Move = PartialMove [Path Abs] -- source files
| Move [Path Abs] -- source files
(Path Abs) -- base destination directory
-- |Collision modes that describe the behavior in case a file collision
-- happens.
data FCollisonMode = Strict -- ^ fail if the target already exists
| Overwrite
| OverwriteAll
| Skip
| Rename (Path Fn)

View File

@@ -40,10 +40,6 @@ import Control.Monad.IO.Class
(
liftIO
)
import Data.ByteString
(
ByteString
)
import Data.Foldable
(
for_
@@ -58,8 +54,6 @@ import HPath
import HSFM.FileSystem.Errors
import HSFM.FileSystem.FileOperations
import HSFM.FileSystem.FileType
import HSFM.FileSystem.UtilTypes
import HSFM.GUI.Gtk.Callbacks.Utils
import HSFM.GUI.Gtk.Data
import HSFM.GUI.Gtk.Dialogs
import HSFM.GUI.Gtk.MyView
@@ -333,12 +327,12 @@ del :: [Item] -> MyGUI -> MyView -> IO ()
del [item] _ _ = withErrorDialog $ do
let cmsg = "Really delete \"" ++ getFPasStr item ++ "\"?"
withConfirmationDialog cmsg
$ easyDelete . path $ item
$ easyDelete item
-- this throws on the first error that occurs
del items@(_:_) _ _ = withErrorDialog $ do
let cmsg = "Really delete " ++ show (length items) ++ " files?"
withConfirmationDialog cmsg
$ forM_ items $ \item -> easyDelete . path $ item
$ forM_ items $ \item -> easyDelete item
del _ _ _ = withErrorDialog
. throw $ InvalidOperation
"Operation not supported on multiple files"
@@ -347,7 +341,7 @@ del _ _ _ = withErrorDialog
-- |Initializes a file move operation.
moveInit :: [Item] -> MyGUI -> MyView -> IO ()
moveInit items@(_:_) mygui _ = do
writeTVarIO (operationBuffer mygui) (FMove . PartialMove . map path $ items)
writeTVarIO (operationBuffer mygui) (FMove . MP1 . map path $ items)
let sbmsg = case items of
(item:[]) -> "Move buffer: " ++ getFPasStr item
_ -> "Move buffer: " ++ (show . length $ items)
@@ -361,7 +355,7 @@ moveInit _ _ _ = withErrorDialog
-- |Supposed to be used with 'withRows'. Initializes a file copy operation.
copyInit :: [Item] -> MyGUI -> MyView -> IO ()
copyInit items@(_:_) mygui _ = do
writeTVarIO (operationBuffer mygui) (FCopy . PartialCopy . map path $ items)
writeTVarIO (operationBuffer mygui) (FCopy . CP1 . map path $ items)
let sbmsg = case items of
(item:[]) -> "Copy buffer: " ++ getFPasStr item
_ -> "Copy buffer: " ++ (show . length $ items)
@@ -381,18 +375,21 @@ operationFinal mygui myview mitem = withErrorDialog $ do
Nothing -> path <$> getCurrentDir myview
Just x -> return $ path x
case op of
FMove (PartialMove s) -> do
FMove (MP1 s) -> do
let cmsg = "Really move " ++ imsg s
++ " to \"" ++ P.fpToString (P.fromAbs cdir)
++ "\"?"
withConfirmationDialog cmsg $ doFileOperation (FMove $ Move s cdir)
popStatusbar mygui
writeTVarIO (operationBuffer mygui) None
FCopy (PartialCopy s) -> do
withConfirmationDialog cmsg . withCopyModeDialog
$ \cm -> do
void $ runFileOp (FMove . MC s cdir $ cm)
popStatusbar mygui
writeTVarIO (operationBuffer mygui) None
FCopy (CP1 s) -> do
let cmsg = "Really copy " ++ imsg s
++ " to \"" ++ P.fpToString (P.fromAbs cdir)
++ "\"?"
withConfirmationDialog cmsg $ doFileOperation (FCopy $ Copy s cdir)
withConfirmationDialog cmsg . withCopyModeDialog
$ \cm -> void $ runFileOp (FCopy . CC s cdir $ cm)
_ -> return ()
where
imsg s = case s of
@@ -403,27 +400,26 @@ operationFinal mygui myview mitem = withErrorDialog $ do
-- |Create a new file.
newFile :: MyGUI -> MyView -> IO ()
newFile _ myview = withErrorDialog $ do
mfn <- textInputDialog "Enter file name" ("" :: String)
mfn <- textInputDialog "Enter file name"
let pmfn = P.parseFn =<< P.userStringToFP <$> mfn
for_ pmfn $ \fn -> do
cdir <- getCurrentDir myview
createRegularFile (path cdir P.</> fn)
createFile cdir fn
-- |Create a new directory.
newDir :: MyGUI -> MyView -> IO ()
newDir _ myview = withErrorDialog $ do
mfn <- textInputDialog "Enter directory name" ("" :: String)
mfn <- textInputDialog "Enter directory name"
let pmfn = P.parseFn =<< P.userStringToFP <$> mfn
for_ pmfn $ \fn -> do
cdir <- getCurrentDir myview
createDir (path cdir P.</> fn)
createDir cdir fn
renameF :: [Item] -> MyGUI -> MyView -> IO ()
renameF [item] _ _ = withErrorDialog $ do
iname <- P.fromRel <$> (P.basename $ path item)
mfn <- textInputDialog "Enter new file name" (iname :: ByteString)
mfn <- textInputDialog "Enter new file name"
let pmfn = P.parseFn =<< P.userStringToFP <$> mfn
for_ pmfn $ \fn -> do
let cmsg = "Really rename \"" ++ getFPasStr item
@@ -431,8 +427,7 @@ renameF [item] _ _ = withErrorDialog $ do
++ P.fpToString (P.fromAbs $ (P.dirname . path $ item)
P.</> fn) ++ "\"?"
withConfirmationDialog cmsg $
HSFM.FileSystem.FileOperations.renameFile (path item)
((P.dirname $ path item) P.</> fn)
HSFM.FileSystem.FileOperations.renameFile item fn
renameF _ _ _ = withErrorDialog
. throw $ InvalidOperation
"Operation not supported on multiple files"
@@ -466,7 +461,7 @@ goHome mygui myview = withErrorDialog $ do
-- |Execute a given file.
execute :: [Item] -> MyGUI -> MyView -> IO ()
execute [item] _ _ = withErrorDialog $
void $ executeFile (path item) []
void $ executeFile item []
execute _ _ _ = withErrorDialog
. throw $ InvalidOperation
"Operation not supported on multiple files"
@@ -480,10 +475,10 @@ open [item] mygui myview = withErrorDialog $
nv <- readFile getFileInfo $ path r
goDir mygui myview nv
r ->
void $ openFile . path $ r
void $ openFile r
-- this throws on the first error that occurs
open (FileLikeList fs) _ _ = withErrorDialog $
forM_ fs $ \f -> void $ openFile . path $ f
forM_ fs $ \f -> void $ openFile f
open _ _ _ = withErrorDialog
. throw $ InvalidOperation
"Operation not supported on multiple files"
@@ -497,6 +492,15 @@ upDir mygui myview = withErrorDialog $ do
goDir mygui myview nv
-- |Helper that is invoked for any directory change operations.
goDir :: MyGUI -> MyView -> Item -> IO ()
goDir mygui myview item = do
cdir <- getCurrentDir myview
modifyTVarIO (history myview)
(\(p, _) -> (path cdir `addHistory` p, []))
refreshView' mygui myview item
-- |Go "back" in the history.
goHistoryPrev :: MyGUI -> MyView -> IO ()
goHistoryPrev mygui myview = do

View File

@@ -1,102 +0,0 @@
{--
HSFM, a filemanager written in Haskell.
Copyright (C) 2016 Julian Ospald
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
version 2 as published by the Free Software Foundation.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
--}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_HADDOCK ignore-exports #-}
module HSFM.GUI.Gtk.Callbacks.Utils where
import Control.Monad
(
forM_
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import qualified HPath as P
import HSFM.FileSystem.Errors
import HSFM.FileSystem.FileOperations
import HSFM.FileSystem.FileType
import HSFM.FileSystem.UtilTypes
import HSFM.GUI.Gtk.Data
import HSFM.GUI.Gtk.Dialogs
import HSFM.GUI.Gtk.MyView
import HSFM.GUI.Gtk.Utils
import HSFM.Utils.IO
(
modifyTVarIO
)
import Prelude hiding(readFile)
-- |Carries out a file operation with the appropriate error handling
-- allowing the user to react to various exceptions with further input.
doFileOperation :: FileOperation -> IO ()
doFileOperation (FCopy (Copy (f':fs') to)) =
_doFileOperation (f':fs') to easyCopyOverwrite easyCopy
$ doFileOperation (FCopy $ Copy fs' to)
doFileOperation (FMove (Move (f':fs') to)) =
_doFileOperation (f':fs') to moveFileOverwrite moveFile
$ doFileOperation (FMove $ Move fs' to)
where
doFileOperation _ = return ()
_doFileOperation :: [P.Path b1]
-> P.Path P.Abs
-> (P.Path b1 -> P.Path P.Abs -> IO b)
-> (P.Path b1 -> P.Path P.Abs -> IO a)
-> IO ()
-> IO ()
_doFileOperation [] _ _ _ _ = return ()
_doFileOperation (f:fs) to mcOverwrite mc rest = do
toname <- P.basename f
let topath = to P.</> toname
reactOnError (mc f topath >> rest)
[(AlreadyExists , collisionAction fileCollisionDialog topath)]
[(FileDoesExist{}, collisionAction fileCollisionDialog topath)
,(DirDoesExist{} , collisionAction fileCollisionDialog topath)
,(SameFile{} , collisionAction renameDialog topath)]
where
collisionAction diag topath = do
mcm <- diag . P.fromAbs $ topath
forM_ mcm $ \cm -> case cm of
Overwrite -> mcOverwrite f topath >> rest
OverwriteAll -> forM_ (f:fs) $ \x -> do
toname' <- P.basename x
mcOverwrite x (to P.</> toname')
Skip -> rest
Rename newn -> mc f (to P.</> newn) >> rest
_ -> return ()
-- |Helper that is invoked for any directory change operations.
goDir :: MyGUI -> MyView -> Item -> IO ()
goDir mygui myview item = do
cdir <- getCurrentDir myview
modifyTVarIO (history myview)
(\(p, _) -> (path cdir `addHistory` p, []))
refreshView' mygui myview item

View File

@@ -35,9 +35,9 @@ import HPath
Abs
, Path
)
import HSFM.FileSystem.FileOperations
import HSFM.FileSystem.FileType
import HSFM.FileSystem.UtilTypes
import System.INotify
import System.INotify.ByteString
(
INotify
)

View File

@@ -23,7 +23,8 @@ module HSFM.GUI.Gtk.Dialogs where
import Control.Exception
(
displayException
catch
, displayException
, throw
, IOException
, catches
@@ -35,15 +36,7 @@ import Control.Monad
, when
, void
)
import Data.ByteString
(
ByteString
)
import qualified Data.ByteString as BS
import Data.ByteString.UTF8
(
fromString
)
import Data.Version
(
showVersion
@@ -69,8 +62,8 @@ import Distribution.Verbosity
import Graphics.UI.Gtk
import qualified HPath as P
import HSFM.FileSystem.Errors
import HSFM.FileSystem.FileOperations
import HSFM.FileSystem.FileType
import HSFM.FileSystem.UtilTypes
import HSFM.GUI.Glib.GlibString()
import HSFM.GUI.Gtk.Data
import HSFM.GUI.Gtk.Errors
@@ -78,18 +71,6 @@ import Paths_hsfm
(
getDataFileName
)
import System.Glib.UTFString
(
GlibString
)
import System.Posix.FilePath
(
takeFileName
)
@@ -127,60 +108,78 @@ showConfirmationDialog str = do
_ -> return False
fileCollisionDialog :: ByteString -> IO (Maybe FCollisonMode)
fileCollisionDialog t = do
-- |Asks the user which directory copy mode he wants via dialog popup
-- and returns 'DirCopyMode'. Default is always Strict, so this allows
-- switching to Merge/Replace/Rename.
showCopyModeDialog :: IO (Maybe CopyMode)
showCopyModeDialog = do
chooserDialog <- messageDialogNew Nothing
[DialogDestroyWithParent]
MessageQuestion
ButtonsNone
(fromString "Target \"" `BS.append`
t `BS.append`
fromString "\" exists, how to proceed?")
_ <- dialogAddButton chooserDialog "Cancel" (ResponseUser 0)
_ <- dialogAddButton chooserDialog "Overwrite" (ResponseUser 1)
_ <- dialogAddButton chooserDialog "Overwrite all" (ResponseUser 2)
_ <- dialogAddButton chooserDialog "Skip" (ResponseUser 3)
_ <- dialogAddButton chooserDialog "Rename" (ResponseUser 4)
"Target exists, how to proceed?"
_ <- dialogAddButton chooserDialog "Cancel" (ResponseUser 0)
_ <- dialogAddButton chooserDialog "Merge" (ResponseUser 1)
_ <- dialogAddButton chooserDialog "Replace" (ResponseUser 2)
_ <- dialogAddButton chooserDialog "Rename" (ResponseUser 3)
rID <- dialogRun chooserDialog
widgetDestroy chooserDialog
case rID of
ResponseUser 0 -> return Nothing
ResponseUser 1 -> return (Just Overwrite)
ResponseUser 2 -> return (Just OverwriteAll)
ResponseUser 3 -> return (Just Skip)
ResponseUser 4 -> do
mfn <- textInputDialog (fromString "Enter new name") (takeFileName t)
ResponseUser 1 -> return (Just Merge)
ResponseUser 2 -> return (Just Replace)
ResponseUser 3 -> do
mfn <- textInputDialog "Enter new name"
forM mfn $ \fn -> do
pfn <- P.parseFn (P.userStringToFP fn)
return $ Rename pfn
_ -> throw UnknownDialogButton
renameDialog :: ByteString -> IO (Maybe FCollisonMode)
renameDialog t = do
-- |Stipped version of `showCopyModeDialog` that only allows cancelling
-- or Renaming.
showRenameDialog :: IO (Maybe CopyMode)
showRenameDialog = do
chooserDialog <- messageDialogNew Nothing
[DialogDestroyWithParent]
MessageQuestion
ButtonsNone
(fromString "Target \"" `BS.append`
t `BS.append`
fromString "\" exists, how to proceed?")
_ <- dialogAddButton chooserDialog "Cancel" (ResponseUser 0)
_ <- dialogAddButton chooserDialog "Skip" (ResponseUser 1)
_ <- dialogAddButton chooserDialog "Rename" (ResponseUser 2)
"Target exists, how to proceed?"
_ <- dialogAddButton chooserDialog "Cancel" (ResponseUser 0)
_ <- dialogAddButton chooserDialog "Rename" (ResponseUser 1)
rID <- dialogRun chooserDialog
widgetDestroy chooserDialog
case rID of
ResponseUser 0 -> return Nothing
ResponseUser 1 -> return (Just Skip)
ResponseUser 2 -> do
mfn <- textInputDialog (fromString "Enter new name") (takeFileName t)
ResponseUser 1 -> do
mfn <- textInputDialog "Enter new name"
forM mfn $ \fn -> do
pfn <- P.parseFn (P.userStringToFP fn)
return $ Rename pfn
_ -> throw UnknownDialogButton
-- |Attempts to run the given function with the `Strict` copy mode.
-- If that raises a `FileDoesExist` or `DirDoesExist`, then it prompts
-- the user for action via `showCopyModeDialog` and then carries out
-- the given function again.
withCopyModeDialog :: (CopyMode -> IO ()) -> IO ()
withCopyModeDialog fa =
catch (fa Strict) $ \e ->
case e of
FileDoesExist _ -> doIt showCopyModeDialog
DirDoesExist _ -> doIt showCopyModeDialog
SameFile _ _ -> doIt showRenameDialog
e' -> throw e'
where
doIt getCm = do
mcm <- getCm
case mcm of
(Just Strict) -> return () -- don't try again
(Just cm) -> fa cm
Nothing -> return ()
-- |Shows the about dialog from the help menu.
showAboutDialog :: IO ()
showAboutDialog = do
@@ -228,18 +227,14 @@ withErrorDialog io =
-- |Asks the user which directory copy mode he wants via dialog popup
-- and returns 'DirCopyMode'.
textInputDialog :: GlibString string
=> string -- ^ window title
-> string -- ^ initial text in input widget
-> IO (Maybe String)
textInputDialog title inittext = do
textInputDialog :: String -> IO (Maybe String)
textInputDialog title = do
chooserDialog <- messageDialogNew Nothing
[DialogDestroyWithParent]
MessageQuestion
ButtonsNone
title
entry <- entryNew
entrySetText entry inittext
cbox <- dialogGetActionArea chooserDialog
_ <- dialogAddButton chooserDialog "Ok" (ResponseUser 0)
_ <- dialogAddButton chooserDialog "Cancel" (ResponseUser 1)

View File

@@ -27,7 +27,7 @@ import Control.Concurrent.STM
newTVarIO
)
import Graphics.UI.Gtk
import HSFM.FileSystem.UtilTypes
import HSFM.FileSystem.FileOperations
import HSFM.GUI.Gtk.Data
import Paths_hsfm
(

View File

@@ -16,6 +16,7 @@ along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
--}
{-# OPTIONS_HADDOCK ignore-exports #-}
module HSFM.GUI.Gtk.MyView where
@@ -69,7 +70,7 @@ import Paths_hsfm
getDataFileName
)
import Prelude hiding(readFile)
import System.INotify
import System.INotify.ByteString
(
addWatch
, initINotify
@@ -314,9 +315,7 @@ refreshView' :: MyGUI
-> MyView
-> Item
-> IO ()
refreshView' mygui myview SymLink { sdest = d@Dir{} } =
refreshView' mygui myview d
refreshView' mygui myview item@Dir{} = do
refreshView' mygui myview item@(DirOrSym _) = do
newRawModel <- fileListStore item myview
writeTVarIO (rawModel myview) newRawModel

View File

@@ -0,0 +1,139 @@
{--
HSFM, a filemanager written in Haskell.
Copyright (C) 2016 Julian Ospald
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
version 2 as published by the Free Software Foundation.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
--}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK ignore-exports #-}
module HSFM.Settings.Bookmarks where
import Control.Monad
(
void
)
import Data.Attoparsec.ByteString
import qualified Data.ByteString as BS
import Data.ByteString
(
ByteString
)
import Data.Maybe
(
catMaybes
, fromJust
)
import Data.Word8
(
_nul
)
import qualified HPath as P
import HPath
(
Abs
, Fn
, Path
)
import HSFM.FileSystem.FileOperations
import HSFM.FileSystem.FileType
import Prelude hiding (readFile, writeFile)
import System.Posix.Env.ByteString
(
getEnv
)
-- |A bookmark. `bkName` is principally a description of the bookmark
-- but must satisfy the constraints of a filename.
data Bookmark = MkBookmark {
bkName :: Path Fn
, bkPath :: Path Abs
} deriving (Show)
-- |Parses bookmarks from a ByteString that has pairs of
-- name and path. Name and path are separated by one null character
-- and the pairs itself are separated by two null characters from
-- each other.
bkParser :: Parser [Bookmark]
bkParser =
fmap catMaybes $ many' (fmap toBm $ bookmark <* word8 _nul <* word8 _nul)
where
toBm :: (ByteString, ByteString) -> Maybe Bookmark
toBm (name, path) = MkBookmark <$> P.parseFn name
<*> P.parseAbs path
bookmark :: Parser (ByteString, ByteString)
bookmark =
(\x y -> (BS.pack x, BS.pack y))
<$> many1' char
<* (word8 _nul)
<*> many1' char
char = satisfy (`notElem` [_nul])
-- |Writes bookmarks to a given file.
writeBookmarks :: [Bookmark] -> IO ()
writeBookmarks [] = return ()
writeBookmarks bs = do
bf <- bookmarksFile
bfd <- bookmarksDir
mkdirP bfd
readFile getFileInfo bfd >>= (\x -> createFile x bookmarksFileName)
let str = foldr1 (\x y -> x `BS.append` BS.pack [_nul, _nul]
`BS.append`
y `BS.append` BS.pack [_nul, _nul])
(fmap toByteString bs)
file <- readFile getFileInfo bf
void $ writeFile file str
where
toByteString :: Bookmark -> ByteString
toByteString b = (P.fromRel $ bkName b)
`BS.append` BS.singleton _nul
`BS.append` (P.fromAbs $ bkPath b)
-- |Reads bookmarks from a given file.
readBookmarks :: IO [Bookmark]
readBookmarks = do
p <- bookmarksFile
file <- readFile getFileInfo p
c <- readFileContents file
case parseOnly bkParser c of
Left _ -> return []
Right x -> return x
bookmarksDir :: IO (Path Abs)
bookmarksDir = do
mhomedir <- getEnv "HOME"
case mhomedir of
Nothing -> ioError (userError "No valid homedir?!")
Just home -> do
phome <- P.parseAbs home
reldir <- P.parseRel ".config/hsfm"
return $ phome P.</> reldir
bookmarksFile :: IO (Path Abs)
bookmarksFile = do
path <- bookmarksDir
return $ path P.</> bookmarksFileName
bookmarksFileName :: Path Fn
bookmarksFileName = fromJust $ P.parseFn "bookmarks"

View File

@@ -1,110 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module FileSystem.FileOperations.CopyDirRecursiveOverwriteSpec where
import Test.Hspec
import HSFM.FileSystem.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import System.Exit
import System.Process
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/"
specDir' :: String
specDir' = toString specDir
spec :: Spec
spec =
describe "HSFM.FileSystem.FileOperations.copyDirRecursiveOverwrite" $ do
-- successes --
it "copyDirRecursiveOverwrite, all fine" $ do
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
(specDir `ba` "outputDir")
removeDirIfExists $ specDir `ba` "outputDir"
it "copyDirRecursiveOverwrite, all fine and compare" $ do
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
(specDir `ba` "outputDir")
(system $ "diff -r --no-dereference "
++ specDir' ++ "inputDir" ++ " "
++ specDir' ++ "outputDir")
`shouldReturn` ExitSuccess
removeDirIfExists $ specDir `ba` "outputDir"
it "copyDirRecursiveOverwrite, destination dir already exists" $
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
(specDir `ba` "alreadyExistsD")
-- posix failures --
it "copyDirRecursiveOverwrite, source directory does not exist" $
copyDirRecursiveOverwrite' (specDir `ba` "doesNotExist")
(specDir `ba` "outputDir")
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "copyDirRecursiveOverwrite, no write permission on output dir" $
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
(specDir `ba` "noWritePerm/foo")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursiveOverwrite, cannot open output dir" $
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
(specDir `ba` "noPerms/foo")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursiveOverwrite, cannot open source dir" $
copyDirRecursiveOverwrite' (specDir `ba` "noPerms/inputDir")
(specDir `ba` "foo")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursiveOverwrite, destination already exists and is a file" $
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
(specDir `ba` "alreadyExists")
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursiveOverwrite, wrong input (regular file)" $
copyDirRecursiveOverwrite' (specDir `ba` "wrongInput")
(specDir `ba` "outputDir")
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursiveOverwrite, wrong input (symlink to directory)" $
copyDirRecursiveOverwrite' (specDir `ba` "wrongInputSymL")
(specDir `ba` "outputDir")
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
-- custom failures
it "copyDirRecursiveOverwrite, destination in source" $
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
(specDir `ba` "inputDir/foo")
`shouldThrow`
isDestinationInSource
it "copyDirRecursiveOverwrite, destination and source same directory" $
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
(specDir `ba` "inputDir")
`shouldThrow`
isSameFile

View File

@@ -1,112 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module FileSystem.FileOperations.CopyDirRecursiveSpec where
import Test.Hspec
import HSFM.FileSystem.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import System.Exit
import System.Process
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/FileSystem/FileOperations/copyDirRecursiveSpec/"
specDir' :: String
specDir' = toString specDir
spec :: Spec
spec =
describe "HSFM.FileSystem.FileOperations.copyDirRecursive" $ do
-- successes --
it "copyDirRecursive, all fine" $ do
copyDirRecursive' (specDir `ba` "inputDir")
(specDir `ba` "outputDir")
removeDirIfExists (specDir `ba` "outputDir")
it "copyDirRecursive, all fine and compare" $ do
copyDirRecursive' (specDir `ba` "inputDir")
(specDir `ba` "outputDir")
(system $ "diff -r --no-dereference "
++ specDir' ++ "inputDir" ++ " "
++ specDir' ++ "outputDir")
`shouldReturn` ExitSuccess
removeDirIfExists (specDir `ba` "outputDir")
-- posix failures --
it "copyDirRecursive, source directory does not exist" $
copyDirRecursive' (specDir `ba` "doesNotExist")
(specDir `ba` "outputDir")
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "copyDirRecursive, no write permission on output dir" $
copyDirRecursive' (specDir `ba` "inputDir")
(specDir `ba` "noWritePerm/foo")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive, cannot open output dir" $
copyDirRecursive' (specDir `ba` "inputDir")
(specDir `ba` "noPerms/foo")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive, cannot open source dir" $
copyDirRecursive' (specDir `ba` "noPerms/inputDir")
(specDir `ba` "foo")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive, destination dir already exists" $
copyDirRecursive' (specDir `ba` "inputDir")
(specDir `ba` "alreadyExistsD")
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
it "copyDirRecursive, destination already exists and is a file" $
copyDirRecursive' (specDir `ba` "inputDir")
(specDir `ba` "alreadyExists")
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
it "copyDirRecursive, wrong input (regular file)" $
copyDirRecursive' (specDir `ba` "wrongInput")
(specDir `ba` "outputDir")
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursive, wrong input (symlink to directory)" $
copyDirRecursive' (specDir `ba` "wrongInputSymL")
(specDir `ba` "outputDir")
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
-- custom failures
it "copyDirRecursive, destination in source" $
copyDirRecursive' (specDir `ba` "inputDir")
(specDir `ba` "inputDir/foo")
`shouldThrow`
isDestinationInSource
it "copyDirRecursive, destination and source same directory" $
copyDirRecursive' (specDir `ba` "inputDir")
(specDir `ba` "inputDir")
`shouldThrow`
isSameFile

View File

@@ -1,109 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module FileSystem.FileOperations.CopyFileOverwriteSpec where
import Test.Hspec
import HSFM.FileSystem.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import System.Exit
import System.Process
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/FileSystem/FileOperations/copyFileOverwriteSpec/"
specDir' :: String
specDir' = toString specDir
spec :: Spec
spec =
describe "HSFM.FileSystem.FileOperations.copyFileOverwrite" $ do
-- successes --
it "copyFileOverwrite, everything clear" $ do
copyFileOverwrite' (specDir `ba` "inputFile")
(specDir `ba` "outputFile")
removeFileIfExists (specDir `ba` "outputFile")
it "copyFileOverwrite, output file already exists, all clear" $ do
copyFile' (specDir `ba` "alreadyExists") (specDir `ba` "alreadyExists.bak")
copyFileOverwrite' (specDir `ba` "inputFile")
(specDir `ba` "alreadyExists")
(system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " "
++ specDir' ++ "alreadyExists")
`shouldReturn` ExitSuccess
removeFileIfExists (specDir `ba` "alreadyExists")
copyFile' (specDir `ba` "alreadyExists.bak") (specDir `ba` "alreadyExists")
removeFileIfExists (specDir `ba` "alreadyExists.bak")
it "copyFileOverwrite, and compare" $ do
copyFileOverwrite' (specDir `ba` "inputFile")
(specDir `ba` "outputFile")
(system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " "
++ specDir' ++ "outputFile")
`shouldReturn` ExitSuccess
removeFileIfExists (specDir `ba` "outputFile")
-- posix failures --
it "copyFileOverwrite, input file does not exist" $
copyFileOverwrite' (specDir `ba` "noSuchFile")
(specDir `ba` "outputFile")
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "copyFileOverwrite, no permission to write to output directory" $
copyFileOverwrite' (specDir `ba` "inputFile")
(specDir `ba` "outputDirNoWrite/outputFile")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyFileOverwrite, cannot open output directory" $
copyFileOverwrite' (specDir `ba` "inputFile")
(specDir `ba` "noPerms/outputFile")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyFileOverwrite, cannot open source directory" $
copyFileOverwrite' (specDir `ba` "noPerms/inputFile")
(specDir `ba` "outputFile")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyFileOverwrite, wrong input type (symlink)" $
copyFileOverwrite' (specDir `ba` "inputFileSymL")
(specDir `ba` "outputFile")
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "copyFileOverwrite, wrong input type (directory)" $
copyFileOverwrite' (specDir `ba` "wrongInput")
(specDir `ba` "outputFile")
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "copyFileOverwrite, output file already exists and is a dir" $
copyFileOverwrite' (specDir `ba` "inputFile")
(specDir `ba` "alreadyExistsD")
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
-- custom failures --
it "copyFileOverwrite, output and input are same file" $
copyFileOverwrite' (specDir `ba` "inputFile")
(specDir `ba` "inputFile")
`shouldThrow` isSameFile

View File

@@ -1,105 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module FileSystem.FileOperations.CopyFileSpec where
import Test.Hspec
import HSFM.FileSystem.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import System.Exit
import System.Process
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/FileSystem/FileOperations/copyFileSpec/"
specDir' :: String
specDir' = toString specDir
spec :: Spec
spec =
describe "HSFM.FileSystem.FileOperations.copyFile" $ do
-- successes --
it "copyFile, everything clear" $ do
copyFile' (specDir `ba` "inputFile")
(specDir `ba` "outputFile")
removeFileIfExists (specDir `ba` "outputFile")
it "copyFile, and compare" $ do
copyFile' (specDir `ba` "inputFile")
(specDir `ba` "outputFile")
(system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " "
++ specDir' ++ "outputFile")
`shouldReturn` ExitSuccess
removeFileIfExists (specDir `ba` "outputFile")
-- posix failures --
it "copyFile, input file does not exist" $
copyFile' (specDir `ba` "noSuchFile")
(specDir `ba` "outputFile")
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "copyFile, no permission to write to output directory" $
copyFile' (specDir `ba` "inputFile")
(specDir `ba` "outputDirNoWrite/outputFile")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile, cannot open output directory" $
copyFile' (specDir `ba` "inputFile")
(specDir `ba` "noPerms/outputFile")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile, cannot open source directory" $
copyFile' (specDir `ba` "noPerms/inputFile")
(specDir `ba` "outputFile")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile, wrong input type (symlink)" $
copyFile' (specDir `ba` "inputFileSymL")
(specDir `ba` "outputFile")
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "copyFile, wrong input type (directory)" $
copyFile' (specDir `ba` "wrongInput")
(specDir `ba` "outputFile")
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "copyFile, output file already exists" $
copyFile' (specDir `ba` "inputFile")
(specDir `ba` "alreadyExists")
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
it "copyFile, output file already exists and is a dir" $
copyFile' (specDir `ba` "inputFile")
(specDir `ba` "alreadyExistsD")
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
-- custom failures --
it "copyFile, output and input are same file" $
copyFile' (specDir `ba` "inputFile")
(specDir `ba` "inputFile")
`shouldThrow`
isSameFile

View File

@@ -1,54 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module FileSystem.FileOperations.CreateDirSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/FileSystem/FileOperations/createDirSpec/"
specDir' :: String
specDir' = toString specDir
spec :: Spec
spec =
describe "HSFM.FileSystem.FileOperations.createDir" $ do
-- successes --
it "createDir, all fine" $ do
createDir' (specDir `ba` "newDir")
removeDirIfExists (specDir `ba` "newDir")
-- posix failures --
it "createDir, can't write to output directory" $
createDir' (specDir `ba` "noWritePerms/newDir")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createDir, can't open output directory" $
createDir' (specDir `ba` "noPerms/newDir")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createDir, destination directory already exists" $
createDir' (specDir `ba` "alreadyExists")
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)

View File

@@ -1,54 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module FileSystem.FileOperations.CreateRegularFileSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/FileSystem/FileOperations/createRegularFileSpec/"
specDir' :: String
specDir' = toString specDir
spec :: Spec
spec =
describe "HSFM.FileSystem.FileOperations.createRegularFile" $ do
-- successes --
it "createRegularFile, all fine" $ do
createRegularFile' (specDir `ba` "newDir")
removeFileIfExists (specDir `ba` "newDir")
-- posix failures --
it "createRegularFile, can't write to destination directory" $
createRegularFile' (specDir `ba` "noWritePerms/newDir")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createRegularFile, can't write to destination directory" $
createRegularFile' (specDir `ba` "noPerms/newDir")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createRegularFile, destination file already exists" $
createRegularFile' (specDir `ba` "alreadyExists")
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)

View File

@@ -1,97 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module FileSystem.FileOperations.DeleteDirRecursiveSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import System.Posix.Files.ByteString
(
getSymbolicLinkStatus
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/FileSystem/FileOperations/deleteDirRecursiveSpec/"
specDir' :: String
specDir' = toString specDir
spec :: Spec
spec =
describe "HSFM.FileSystem.FileOperations.deleteDirRecursive" $ do
-- successes --
it "deleteDirRecursive, empty directory, all fine" $ do
createDir' (specDir `ba` "testDir")
deleteDirRecursive' (specDir `ba` "testDir")
getSymbolicLinkStatus (specDir `ba` "testDir")
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "deleteDirRecursive, empty directory with null permissions, all fine" $ do
createDir' (specDir `ba` "noPerms/testDir")
noPerms (specDir `ba` "noPerms/testDir")
deleteDirRecursive' (specDir `ba` "noPerms/testDir")
it "deleteDirRecursive, non-empty directory, all fine" $ do
createDir' (specDir `ba` "nonEmpty")
createDir' (specDir `ba` "nonEmpty/dir1")
createDir' (specDir `ba` "nonEmpty/dir2")
createDir' (specDir `ba` "nonEmpty/dir2/dir3")
createRegularFile' (specDir `ba` "nonEmpty/file1")
createRegularFile' (specDir `ba` "nonEmpty/dir1/file2")
deleteDirRecursive' (specDir `ba` "nonEmpty")
getSymbolicLinkStatus (specDir `ba` "nonEmpty")
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
-- posix failures --
it "deleteDirRecursive, can't open parent directory" $ do
createDir' (specDir `ba` "noPerms/foo")
noPerms (specDir `ba` "noPerms")
(deleteDirRecursive' (specDir `ba` "noPerms/foo")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied))
>> normalDirPerms (specDir `ba` "noPerms")
>> deleteDir' (specDir `ba` "noPerms/foo")
it "deleteDirRecursive, can't write to parent directory" $ do
createDir' (specDir `ba` "noWritable/foo")
noWritableDirPerms (specDir `ba` "noWritable")
(deleteDirRecursive' (specDir `ba` "noWritable/foo")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied))
normalDirPerms (specDir `ba` "noWritable")
deleteDir' (specDir `ba` "noWritable/foo")
it "deleteDirRecursive, wrong file type (symlink to directory)" $
deleteDirRecursive' (specDir `ba` "dirSym")
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "deleteDirRecursive, wrong file type (regular file)" $
deleteDirRecursive' (specDir `ba` "file")
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "deleteDirRecursive, directory does not exist" $
deleteDirRecursive' (specDir `ba` "doesNotExist")
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)

View File

@@ -1,94 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module FileSystem.FileOperations.DeleteDirSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import System.Posix.Files.ByteString
(
getSymbolicLinkStatus
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/FileSystem/FileOperations/deleteDirSpec/"
specDir' :: String
specDir' = toString specDir
spec :: Spec
spec =
describe "HSFM.FileSystem.FileOperations.deleteDir" $ do
-- successes --
it "deleteDir, empty directory, all fine" $ do
createDir' (specDir `ba` "testDir")
deleteDir' (specDir `ba` "testDir")
getSymbolicLinkStatus (specDir `ba` "testDir")
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "deleteDir, directory with null permissions, all fine" $ do
createDir' (specDir `ba` "noPerms/testDir")
noPerms (specDir `ba` "noPerms/testDir")
deleteDir' (specDir `ba` "noPerms/testDir")
getSymbolicLinkStatus (specDir `ba` "testDir")
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
-- posix failures --
it "deleteDir, wrong file type (symlink to directory)" $
deleteDir' (specDir `ba` "dirSym")
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "deleteDir, wrong file type (regular file)" $
deleteDir' (specDir `ba` "file")
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "deleteDir, directory does not exist" $
deleteDir' (specDir `ba` "doesNotExist")
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "deleteDir, directory not empty" $
deleteDir' (specDir `ba` "dir")
`shouldThrow`
(\e -> ioeGetErrorType e == UnsatisfiedConstraints)
it "deleteDir, can't open parent directory" $ do
createDir' (specDir `ba` "noPerms/foo")
noPerms (specDir `ba` "noPerms")
(deleteDir' (specDir `ba` "noPerms/foo")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied))
>> normalDirPerms (specDir `ba` "noPerms")
>> deleteDir' (specDir `ba` "noPerms/foo")
it "deleteDir, can't write to parent directory, still fine" $ do
createDir' (specDir `ba` "noWritable/foo")
noWritableDirPerms (specDir `ba` "noWritable")
(deleteDir' (specDir `ba` "noWritable/foo")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied))
normalDirPerms (specDir `ba` "noWritable")
deleteDir' (specDir `ba` "noWritable/foo")

View File

@@ -1,69 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module FileSystem.FileOperations.DeleteFileSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import System.Posix.Files.ByteString
(
getSymbolicLinkStatus
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/FileSystem/FileOperations/deleteFileSpec/"
specDir' :: String
specDir' = toString specDir
spec :: Spec
spec =
describe "HSFM.FileSystem.FileOperations.deleteFile" $ do
-- successes --
it "deleteFile, regular file, all fine" $ do
createRegularFile' (specDir `ba` "testFile")
deleteFile' (specDir `ba` "testFile")
getSymbolicLinkStatus (specDir `ba` "testFile")
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "deleteFile, symlink, all fine" $ do
recreateSymlink' (specDir `ba` "syml")
(specDir `ba` "testFile")
deleteFile' (specDir `ba` "testFile")
getSymbolicLinkStatus (specDir `ba` "testFile")
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
-- posix failures --
it "deleteFile, wrong file type (directory)" $
deleteFile' (specDir `ba` "dir")
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "deleteFile, file does not exist" $
deleteFile' (specDir `ba` "doesNotExist")
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "deleteFile, can't read directory" $
deleteFile' (specDir `ba` "noPerms/blah")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)

View File

@@ -1,88 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module FileSystem.FileOperations.GetDirsFilesSpec where
import Data.List
(
sort
)
import Data.Maybe
(
fromJust
)
import qualified HPath as P
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import System.Posix.Env.ByteString
(
getEnv
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/FileSystem/FileOperations/getDirsFilesSpec/"
specDir' :: String
specDir' = toString specDir
spec :: Spec
spec =
describe "HSFM.FileSystem.FileOperations.getDirsFiles" $ do
-- successes --
it "getDirsFiles, all fine" $ do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
expectedFiles <- mapM P.parseRel [(specDir `ba ` ".hidden")
,(specDir `ba ` "Lala")
,(specDir `ba ` "dir")
,(specDir `ba ` "dirsym")
,(specDir `ba ` "file")
,(specDir `ba ` "noPerms")
,(specDir `ba ` "syml")]
(fmap sort $ getDirsFiles' specDir)
`shouldReturn` fmap (pwd P.</>) expectedFiles
-- posix failures --
it "getDirsFiles, nonexistent directory" $
getDirsFiles' (specDir `ba ` "nothingHere")
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "getDirsFiles, wrong file type (file)" $
getDirsFiles' (specDir `ba ` "file")
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "getDirsFiles, wrong file type (symlink to file)" $
getDirsFiles' (specDir `ba ` "syml")
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "getDirsFiles, wrong file type (symlink to dir)" $
getDirsFiles' (specDir `ba ` "dirsym")
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "getDirsFiles, can't open directory" $
getDirsFiles' (specDir `ba ` "noPerms")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)

View File

@@ -1,70 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module FileSystem.FileOperations.GetFileTypeSpec where
import HSFM.FileSystem.FileOperations
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/FileSystem/FileOperations/getFileTypeSpec/"
specDir' :: String
specDir' = toString specDir
spec :: Spec
spec =
describe "HSFM.FileSystem.FileOperations.getFileType" $ do
-- successes --
it "getFileType, regular file" $
getFileType' (specDir `ba` "regularfile")
`shouldReturn` RegularFile
it "getFileType, directory" $
getFileType' (specDir `ba` "directory")
`shouldReturn` Directory
it "getFileType, directory with null permissions" $
getFileType' (specDir `ba` "noPerms")
`shouldReturn` Directory
it "getFileType, symlink to file" $
getFileType' (specDir `ba` "symlink")
`shouldReturn` SymbolicLink
it "getFileType, symlink to directory" $
getFileType' (specDir `ba` "symlinkD")
`shouldReturn` SymbolicLink
it "getFileType, broken symlink" $
getFileType' (specDir `ba` "brokenSymlink")
`shouldReturn` SymbolicLink
-- posix failures --
it "getFileType, file does not exist" $
getFileType' (specDir `ba` "nothingHere")
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "getFileType, can't open directory" $
getFileType' (specDir `ba` "noPerms/forz")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)

View File

@@ -1,93 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module FileSystem.FileOperations.MoveFileOverwriteSpec where
import Test.Hspec
import HSFM.FileSystem.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/FileSystem/FileOperations/moveFileOverwriteSpec/"
specDir' :: String
specDir' = toString specDir
spec :: Spec
spec =
describe "HSFM.FileSystem.FileOperations.moveFileOverwrite" $ do
-- successes --
it "moveFileOverwrite, all fine" $
moveFileOverwrite' (specDir `ba` "myFile")
(specDir `ba` "movedFile")
it "moveFileOverwrite, all fine" $
moveFileOverwrite' (specDir `ba` "myFile")
(specDir `ba` "dir/movedFile")
it "moveFileOverwrite, all fine on symlink" $
moveFileOverwrite' (specDir `ba` "myFileL")
(specDir `ba` "movedFile")
it "moveFileOverwrite, all fine on directory" $
moveFileOverwrite' (specDir `ba` "dir")
(specDir `ba` "movedFile")
it "moveFileOverwrite, destination file already exists" $
moveFileOverwrite' (specDir `ba` "myFile")
(specDir `ba` "alreadyExists")
-- posix failures --
it "moveFileOverwrite, source file does not exist" $
moveFileOverwrite' (specDir `ba` "fileDoesNotExist")
(specDir `ba` "movedFile")
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "moveFileOverwrite, can't write to destination directory" $
moveFileOverwrite' (specDir `ba` "myFile")
(specDir `ba` "noWritePerm/movedFile")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "moveFileOverwrite, can't open destination directory" $
moveFileOverwrite' (specDir `ba` "myFile")
(specDir `ba` "noPerms/movedFile")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "moveFileOverwrite, can't open source directory" $
moveFileOverwrite' (specDir `ba` "noPerms/myFile")
(specDir `ba` "movedFile")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
-- custom failures --
it "moveFileOverwrite, move from file to dir" $
moveFileOverwrite' (specDir `ba` "myFile")
(specDir `ba` "alreadyExistsD")
`shouldThrow`
isDirDoesExist
it "moveFileOverwrite, source and dest are same file" $
moveFileOverwrite' (specDir `ba` "myFile")
(specDir `ba` "myFile")
`shouldThrow`
isSameFile

View File

@@ -1,95 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module FileSystem.FileOperations.MoveFileSpec where
import Test.Hspec
import HSFM.FileSystem.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/FileSystem/FileOperations/moveFileSpec/"
specDir' :: String
specDir' = toString specDir
spec :: Spec
spec =
describe "HSFM.FileSystem.FileOperations.moveFile" $ do
-- successes --
it "moveFile, all fine" $
moveFile' (specDir `ba` "myFile")
(specDir `ba` "movedFile")
it "moveFile, all fine" $
moveFile' (specDir `ba` "myFile")
(specDir `ba` "dir/movedFile")
it "moveFile, all fine on symlink" $
moveFile' (specDir `ba` "myFileL")
(specDir `ba` "movedFile")
it "moveFile, all fine on directory" $
moveFile' (specDir `ba` "dir")
(specDir `ba` "movedFile")
-- posix failures --
it "moveFile, source file does not exist" $
moveFile' (specDir `ba` "fileDoesNotExist")
(specDir `ba` "movedFile")
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "moveFile, can't write to destination directory" $
moveFile' (specDir `ba` "myFile")
(specDir `ba` "noWritePerm/movedFile")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "moveFile, can't open destination directory" $
moveFile' (specDir `ba` "myFile")
(specDir `ba` "noPerms/movedFile")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "moveFile, can't open source directory" $
moveFile' (specDir `ba` "noPerms/myFile")
(specDir `ba` "movedFile")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
-- custom failures --
it "moveFile, destination file already exists" $
moveFile' (specDir `ba` "myFile")
(specDir `ba` "alreadyExists")
`shouldThrow`
isFileDoesExist
it "moveFile, move from file to dir" $
moveFile' (specDir `ba` "myFile")
(specDir `ba` "alreadyExistsD")
`shouldThrow`
isDirDoesExist
it "moveFile, source and dest are same file" $
moveFile' (specDir `ba` "myFile")
(specDir `ba` "myFile")
`shouldThrow`
isSameFile

View File

@@ -1,95 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module FileSystem.FileOperations.RecreateSymlinkSpec where
import Test.Hspec
import HSFM.FileSystem.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/FileSystem/FileOperations/recreateSymlinkSpec/"
specDir' :: String
specDir' = toString specDir
spec :: Spec
spec =
describe "HSFM.FileSystem.FileOperations.recreateSymlink" $ do
-- successes --
it "recreateSymLink, all fine" $ do
recreateSymlink' (specDir `ba` "myFileL")
(specDir `ba` "movedFile")
removeFileIfExists (specDir `ba` "movedFile")
it "recreateSymLink, all fine" $ do
recreateSymlink' (specDir `ba` "myFileL")
(specDir `ba` "dir/movedFile")
removeFileIfExists (specDir `ba` "dir/movedFile")
-- posix failures --
it "recreateSymLink, wrong input type (file)" $
recreateSymlink' (specDir `ba` "myFile")
(specDir `ba` "movedFile")
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "recreateSymLink, wrong input type (directory)" $
recreateSymlink' (specDir `ba` "dir")
(specDir `ba` "movedFile")
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "recreateSymLink, can't write to destination directory" $
recreateSymlink' (specDir `ba` "myFileL")
(specDir `ba` "noWritePerm/movedFile")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink, can't open destination directory" $
recreateSymlink' (specDir `ba` "myFileL")
(specDir `ba` "noPerms/movedFile")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink, can't open source directory" $
recreateSymlink' (specDir `ba` "noPerms/myFileL")
(specDir `ba` "movedFile")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink, destination file already exists" $
recreateSymlink' (specDir `ba` "myFileL")
(specDir `ba` "alreadyExists")
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
it "recreateSymLink, destination already exists and is a dir" $
recreateSymlink' (specDir `ba` "myFileL")
(specDir `ba` "alreadyExistsD")
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
-- custom failures --
it "recreateSymLink, source and destination are the same file" $
recreateSymlink' (specDir `ba` "myFileL")
(specDir `ba` "myFileL")
`shouldThrow`
isSameFile

View File

@@ -1,95 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module FileSystem.FileOperations.RenameFileSpec where
import Test.Hspec
import HSFM.FileSystem.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/FileSystem/FileOperations/renameFileSpec/"
specDir' :: String
specDir' = toString specDir
spec :: Spec
spec =
describe "HSFM.FileSystem.FileOperations.renameFile" $ do
-- successes --
it "renameFile, all fine" $
renameFile' (specDir `ba` "myFile")
(specDir `ba` "renamedFile")
it "renameFile, all fine" $
renameFile' (specDir `ba` "myFile")
(specDir `ba` "dir/renamedFile")
it "renameFile, all fine on symlink" $
renameFile' (specDir `ba` "myFileL")
(specDir `ba` "renamedFile")
it "renameFile, all fine on directory" $
renameFile' (specDir `ba` "dir")
(specDir `ba` "renamedFile")
-- posix failures --
it "renameFile, source file does not exist" $
renameFile' (specDir `ba` "fileDoesNotExist")
(specDir `ba` "renamedFile")
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "renameFile, can't write to output directory" $
renameFile' (specDir `ba` "myFile")
(specDir `ba` "noWritePerm/renamedFile")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "renameFile, can't open output directory" $
renameFile' (specDir `ba` "myFile")
(specDir `ba` "noPerms/renamedFile")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "renameFile, can't open source directory" $
renameFile' (specDir `ba` "noPerms/myFile")
(specDir `ba` "renamedFile")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
-- custom failures --
it "renameFile, destination file already exists" $
renameFile' (specDir `ba` "myFile")
(specDir `ba` "alreadyExists")
`shouldThrow`
isFileDoesExist
it "renameFile, move from file to dir" $
renameFile' (specDir `ba` "myFile")
(specDir `ba` "alreadyExistsD")
`shouldThrow`
isDirDoesExist
it "renameFile, source and dest are same file" $
renameFile' (specDir `ba` "myFile")
(specDir `ba` "myFile")
`shouldThrow`
isSameFile

View File

@@ -1,8 +0,0 @@
dadasasddas
sda
!!1
sda
11

View File

@@ -1,4 +0,0 @@
dadasasddas
das
sda
sda

View File

@@ -1,8 +0,0 @@
dadasasddas
sda
!!1
sda
11

View File

@@ -1,4 +0,0 @@
dadasasddas
das
sda
sda

View File

@@ -1,8 +0,0 @@
dadasasddas
sda
!!1
sda
11

View File

@@ -1,4 +0,0 @@
dadasasddas
das
sda
sda

View File

@@ -1,16 +0,0 @@
adaöölsdaöl
dsalö
ölsda
ääödsf
äsdfä
öä453
öä
435
ä45343
5
453
453453453
das
asd
das

View File

@@ -1,4 +0,0 @@
abc
def
dsadasdsa

View File

@@ -1,2 +0,0 @@
abc
def

View File

@@ -1 +0,0 @@
inputFile

Some files were not shown because too many files have changed in this diff Show More