Compare commits
3 Commits
developmen
...
bookmarks
| Author | SHA1 | Date | |
|---|---|---|---|
| a452b44cfe | |||
| 8bcdb84efd | |||
| 746daf9ba6 |
3
.gitmodules
vendored
3
.gitmodules
vendored
@@ -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
1
3rdparty/hinotify
vendored
Submodule
Submodule 3rdparty/hinotify added at 6751bf0cc8
2
3rdparty/hpath
vendored
2
3rdparty/hpath
vendored
Submodule 3rdparty/hpath updated: 1263fac7ec...45b515d1db
@@ -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
|
||||
|
||||
48
hsfm.cabal
48
hsfm.cabal
@@ -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
|
||||
|
||||
@@ -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
@@ -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.
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
)
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
(
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
139
src/HSFM/Settings/Bookmarks.hs
Normal file
139
src/HSFM/Settings/Bookmarks.hs
Normal 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"
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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
|
||||
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -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")
|
||||
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -1,8 +0,0 @@
|
||||
dadasasddas
|
||||
sda
|
||||
|
||||
!!1
|
||||
sda
|
||||
|
||||
|
||||
11
|
||||
@@ -1 +0,0 @@
|
||||
dadasasddas
|
||||
@@ -1,4 +0,0 @@
|
||||
dadasasddas
|
||||
das
|
||||
sda
|
||||
sda
|
||||
@@ -1,8 +0,0 @@
|
||||
dadasasddas
|
||||
sda
|
||||
|
||||
!!1
|
||||
sda
|
||||
|
||||
|
||||
11
|
||||
@@ -1 +0,0 @@
|
||||
dadasasddas
|
||||
@@ -1,4 +0,0 @@
|
||||
dadasasddas
|
||||
das
|
||||
sda
|
||||
sda
|
||||
@@ -1,8 +0,0 @@
|
||||
dadasasddas
|
||||
sda
|
||||
|
||||
!!1
|
||||
sda
|
||||
|
||||
|
||||
11
|
||||
@@ -1 +0,0 @@
|
||||
dadasasddas
|
||||
@@ -1,4 +0,0 @@
|
||||
dadasasddas
|
||||
das
|
||||
sda
|
||||
sda
|
||||
@@ -1 +0,0 @@
|
||||
inputDir/
|
||||
@@ -1,8 +0,0 @@
|
||||
dadasasddas
|
||||
sda
|
||||
|
||||
!!1
|
||||
sda
|
||||
|
||||
|
||||
11
|
||||
@@ -1 +0,0 @@
|
||||
dadasasddas
|
||||
@@ -1,4 +0,0 @@
|
||||
dadasasddas
|
||||
das
|
||||
sda
|
||||
sda
|
||||
@@ -1,8 +0,0 @@
|
||||
dadasasddas
|
||||
sda
|
||||
|
||||
!!1
|
||||
sda
|
||||
|
||||
|
||||
11
|
||||
@@ -1 +0,0 @@
|
||||
dadasasddas
|
||||
@@ -1,4 +0,0 @@
|
||||
dadasasddas
|
||||
das
|
||||
sda
|
||||
sda
|
||||
@@ -1 +0,0 @@
|
||||
inputDir/
|
||||
@@ -1,16 +0,0 @@
|
||||
adaöölsdaöl
|
||||
dsalö
|
||||
ölsda
|
||||
ääödsf
|
||||
äsdfä
|
||||
öä453
|
||||
öä
|
||||
435
|
||||
ä45343
|
||||
5
|
||||
453
|
||||
453453453
|
||||
das
|
||||
asd
|
||||
das
|
||||
|
||||
@@ -1,4 +0,0 @@
|
||||
abc
|
||||
def
|
||||
|
||||
dsadasdsa
|
||||
@@ -1 +0,0 @@
|
||||
inputFile
|
||||
@@ -1,2 +0,0 @@
|
||||
abc
|
||||
def
|
||||
@@ -1 +0,0 @@
|
||||
inputFile
|
||||
@@ -1 +0,0 @@
|
||||
dir
|
||||
@@ -1 +0,0 @@
|
||||
dir
|
||||
@@ -1 +0,0 @@
|
||||
foo
|
||||
@@ -1 +0,0 @@
|
||||
dir
|
||||
@@ -1 +0,0 @@
|
||||
Lala
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user