Use new hpath API
This commit is contained in:
parent
46334687c9
commit
64fb9fbea0
@ -36,7 +36,7 @@ library
|
|||||||
data-default,
|
data-default,
|
||||||
filepath >= 1.3.0.0,
|
filepath >= 1.3.0.0,
|
||||||
hinotify-bytestring,
|
hinotify-bytestring,
|
||||||
hpath >= 0.7.3,
|
hpath >= 0.8.0,
|
||||||
safe,
|
safe,
|
||||||
stm,
|
stm,
|
||||||
time >= 1.4.2,
|
time >= 1.4.2,
|
||||||
@ -75,7 +75,7 @@ executable hsfm-gtk
|
|||||||
glib >= 0.13,
|
glib >= 0.13,
|
||||||
gtk3 >= 0.14.1,
|
gtk3 >= 0.14.1,
|
||||||
hinotify-bytestring,
|
hinotify-bytestring,
|
||||||
hpath >= 0.7.3,
|
hpath >= 0.8.0,
|
||||||
hsfm,
|
hsfm,
|
||||||
monad-loops,
|
monad-loops,
|
||||||
old-locale >= 1,
|
old-locale >= 1,
|
||||||
|
@ -485,7 +485,7 @@ newFile _ myview = withErrorDialog $ do
|
|||||||
let pmfn = P.parseFn =<< fromString <$> mfn
|
let pmfn = P.parseFn =<< fromString <$> mfn
|
||||||
for_ pmfn $ \fn -> do
|
for_ pmfn $ \fn -> do
|
||||||
cdir <- getCurrentDir myview
|
cdir <- getCurrentDir myview
|
||||||
createRegularFile (path cdir P.</> fn)
|
createRegularFile newFilePerms (path cdir P.</> fn)
|
||||||
|
|
||||||
|
|
||||||
-- |Create a new directory.
|
-- |Create a new directory.
|
||||||
@ -495,7 +495,7 @@ newDir _ myview = withErrorDialog $ do
|
|||||||
let pmfn = P.parseFn =<< fromString <$> mfn
|
let pmfn = P.parseFn =<< fromString <$> mfn
|
||||||
for_ pmfn $ \fn -> do
|
for_ pmfn $ \fn -> do
|
||||||
cdir <- getCurrentDir myview
|
cdir <- getCurrentDir myview
|
||||||
createDir (path cdir P.</> fn)
|
createDir newDirPerms (path cdir P.</> fn)
|
||||||
|
|
||||||
|
|
||||||
renameF :: [Item] -> MyGUI -> MyView -> IO ()
|
renameF :: [Item] -> MyGUI -> MyView -> IO ()
|
||||||
|
@ -46,7 +46,7 @@ import qualified HPath as P
|
|||||||
import HPath.IO
|
import HPath.IO
|
||||||
import HPath.IO.Errors
|
import HPath.IO.Errors
|
||||||
import HSFM.FileSystem.FileType
|
import HSFM.FileSystem.FileType
|
||||||
import HSFM.FileSystem.UtilTypes
|
import qualified HSFM.FileSystem.UtilTypes as UT
|
||||||
import HSFM.GUI.Gtk.Data
|
import HSFM.GUI.Gtk.Data
|
||||||
import HSFM.GUI.Gtk.Dialogs
|
import HSFM.GUI.Gtk.Dialogs
|
||||||
import HSFM.GUI.Gtk.MyView
|
import HSFM.GUI.Gtk.MyView
|
||||||
@ -63,27 +63,26 @@ import Control.Concurrent.MVar
|
|||||||
|
|
||||||
-- |Carries out a file operation with the appropriate error handling
|
-- |Carries out a file operation with the appropriate error handling
|
||||||
-- allowing the user to react to various exceptions with further input.
|
-- allowing the user to react to various exceptions with further input.
|
||||||
doFileOperation :: FileOperation -> IO ()
|
doFileOperation :: UT.FileOperation -> IO ()
|
||||||
doFileOperation (FCopy (Copy (f':fs') to)) =
|
doFileOperation (UT.FCopy (UT.Copy (f':fs') to)) =
|
||||||
_doFileOperation (f':fs') to easyCopyOverwrite easyCopy
|
_doFileOperation (f':fs') to (\p1 p2 cm -> easyCopy p1 p2 cm FailEarly)
|
||||||
$ doFileOperation (FCopy $ Copy fs' to)
|
$ doFileOperation (UT.FCopy $ UT.Copy fs' to)
|
||||||
doFileOperation (FMove (Move (f':fs') to)) =
|
doFileOperation (UT.FMove (UT.Move (f':fs') to)) =
|
||||||
_doFileOperation (f':fs') to moveFileOverwrite moveFile
|
_doFileOperation (f':fs') to moveFile
|
||||||
$ doFileOperation (FMove $ Move fs' to)
|
$ doFileOperation (UT.FMove $ UT.Move fs' to)
|
||||||
doFileOperation _ = return ()
|
doFileOperation _ = return ()
|
||||||
|
|
||||||
|
|
||||||
_doFileOperation :: [P.Path b1]
|
_doFileOperation :: [P.Path b1]
|
||||||
-> P.Path P.Abs
|
-> P.Path P.Abs
|
||||||
-> (P.Path b1 -> P.Path P.Abs -> IO b)
|
-> (P.Path b1 -> P.Path P.Abs -> CopyMode -> IO b)
|
||||||
-> (P.Path b1 -> P.Path P.Abs -> IO a)
|
|
||||||
-> IO ()
|
-> IO ()
|
||||||
-> IO ()
|
-> IO ()
|
||||||
_doFileOperation [] _ _ _ _ = return ()
|
_doFileOperation [] _ _ _ = return ()
|
||||||
_doFileOperation (f:fs) to mcOverwrite mc rest = do
|
_doFileOperation (f:fs) to mc rest = do
|
||||||
toname <- P.basename f
|
toname <- P.basename f
|
||||||
let topath = to P.</> toname
|
let topath = to P.</> toname
|
||||||
reactOnError (mc f topath >> rest)
|
reactOnError (mc f topath Strict >> rest)
|
||||||
[(AlreadyExists , collisionAction fileCollisionDialog topath)]
|
[(AlreadyExists , collisionAction fileCollisionDialog topath)]
|
||||||
[(FileDoesExist{}, collisionAction fileCollisionDialog topath)
|
[(FileDoesExist{}, collisionAction fileCollisionDialog topath)
|
||||||
,(DirDoesExist{} , collisionAction fileCollisionDialog topath)
|
,(DirDoesExist{} , collisionAction fileCollisionDialog topath)
|
||||||
@ -92,12 +91,12 @@ _doFileOperation (f:fs) to mcOverwrite mc rest = do
|
|||||||
collisionAction diag topath = do
|
collisionAction diag topath = do
|
||||||
mcm <- diag . P.fromAbs $ topath
|
mcm <- diag . P.fromAbs $ topath
|
||||||
forM_ mcm $ \cm -> case cm of
|
forM_ mcm $ \cm -> case cm of
|
||||||
Overwrite -> mcOverwrite f topath >> rest
|
UT.Overwrite -> mc f topath Overwrite >> rest
|
||||||
OverwriteAll -> forM_ (f:fs) $ \x -> do
|
UT.OverwriteAll -> forM_ (f:fs) $ \x -> do
|
||||||
toname' <- P.basename x
|
toname' <- P.basename x
|
||||||
mcOverwrite x (to P.</> toname')
|
mc x (to P.</> toname') Overwrite
|
||||||
Skip -> rest
|
UT.Skip -> rest
|
||||||
Rename newn -> mc f (to P.</> newn) >> rest
|
UT.Rename newn -> mc f (to P.</> newn) Strict >> rest
|
||||||
_ -> return ()
|
_ -> return ()
|
||||||
|
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user