hasufell/hsfm
1
1
Fork 0
Code Issues 33 Pull Requests Releases Wiki Activity

LIB/GTK: cleanup compiler warnings

Browse Source
This commit is contained in:
Julian Ospald
2016-03-31 16:19:31 +02:00
parent 65595fa9c5
commit 4da3c92e5e
10 changed files with 90 additions and 152 deletions
Download Patch File Download Diff File Expand all files Collapse all files

32
src/HSFM/FileSystem/FileOperations.hs
View File

@@ -29,10 +29,6 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
module HSFM.FileSystem.FileOperations where
import Control.Applicative
(
(<$>)
)
import Control.Exception
(
throw
@@ -58,11 +54,6 @@ import qualified HPath as P
import HSFM.FileSystem.Errors
import HSFM.FileSystem.FileType
import HSFM.Utils.IO
import HSFM.Utils.MyPrelude
import System.FilePath
(
(</>)
)
import System.Posix.Directory
(
createDirectory
@@ -158,6 +149,7 @@ runFileOp (FMove fo) = return $ Just $ FMove fo
runFileOp (FDelete fp) = easyDelete fp >> return Nothing
runFileOp (FOpen fp) = openFile fp >> return Nothing
runFileOp (FExecute fp args) = executeFile fp args >> return Nothing
runFileOp _ = return Nothing
@@ -175,7 +167,7 @@ copyDir :: CopyMode
-> IO ()
copyDir _ AFileInvFN _ = throw InvalidFileName
copyDir _ _ AFileInvFN = throw InvalidFileName
copyDir cm from@(_ :/ Dir fromn (FileInfo { fileMode = fmode }))
copyDir cm from@(_ :/ Dir fromn FileInfo{ fileMode = fmode })
to@(_ :/ Dir {})
= do
let fromp = fullPath from
@@ -196,20 +188,20 @@ copyDir cm from@(_ :/ Dir fromn (FileInfo { fileMode = fmode }))
(_ :/ RegFile {}) -> copyFileToDir Replace f destdir
_ -> return ()
where
createDestdir destdir fmode =
createDestdir destdir fmode' =
let destdir' = P.toFilePath destdir
in case cm of
Merge ->
unlessM (doesDirectoryExist destdir)
(createDirectory destdir' fmode)
(createDirectory destdir' fmode')
Strict -> do
throwDirDoesExist destdir
createDirectory destdir' fmode
createDirectory destdir' fmode'
Replace -> do
whenM (doesDirectoryExist destdir)
(deleteDirRecursive =<<
HSFM.FileSystem.FileType.readFileWithFileInfo destdir)
createDirectory destdir' fmode
createDirectory destdir' fmode'
copyDir _ _ _ = throw $ InvalidOperation "wrong input type"
@@ -295,14 +287,14 @@ easyCopy :: CopyMode
-> AnchoredFile FileInfo
-> AnchoredFile FileInfo
-> IO ()
easyCopy cm from@(_ :/ SymLink {})
to@(_ :/ Dir {})
easyCopy cm from@(_ :/ SymLink{})
to@(_ :/ Dir{})
= recreateSymlink cm from to
easyCopy cm from@(_ :/ RegFile fn _)
to@(_ :/ Dir {})
easyCopy cm from@(_ :/ RegFile{})
to@(_ :/ Dir{})
= copyFileToDir cm from to
easyCopy cm from@(_ :/ Dir fn _)
to@(_ :/ Dir {})
easyCopy cm from@(_ :/ Dir{})
to@(_ :/ Dir{})
= copyDir cm from to
easyCopy _ _ _ = throw $ InvalidOperation "wrong input type"

79
src/HSFM/FileSystem/FileType.hs
View File

@@ -26,17 +26,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
module HSFM.FileSystem.FileType where
import Control.Applicative
(
(<*>)
, (<$>)
, (<|>)
, pure
)
import Control.Arrow
(
first
)
import Control.Exception
(
handle
@@ -53,86 +43,38 @@ import Control.Monad.State.Lazy
import Data.Default
import Data.List
(
delete
, foldl'
, isPrefixOf
, sort
, sortBy
, (\\)
isPrefixOf
)
import Data.Maybe
(
catMaybes
, fromMaybe
)
import Data.Ord
(
comparing
)
import Data.Time.Clock.POSIX
(
POSIXTime
, posixSecondsToUTCTime
)
import Data.Time
(
UTCTime(..)
)
import Data.Traversable
(
for
)
import Data.Word
(
Word64
)
import Data.Time()
import HPath
(
Abs
, Path
, Fn
, Rel
, pattern Path
)
import qualified HPath as P
import HSFM.Utils.MyPrelude
import Safe
(
atDef
, initDef
)
import System.FilePath
(
combine
, normalise
, equalFilePath
, isAbsolute
, joinPath
isAbsolute
, pathSeparator
, splitDirectories
, takeFileName
, (</>)
)
import System.IO
(
IOMode
, Handle
, openFile
)
import System.IO.Error
(
ioeGetErrorType
, isDoesNotExistErrorType
)
import System.IO.Unsafe
(
unsafeInterleaveIO
)
import System.Locale
(
defaultTimeLocale
, rfc822DateFormat
)
import System.Posix.Types
(
DeviceID
@@ -237,7 +179,7 @@ data FileInfo = FileInfo {
convertViewP :: (File FileInfo -> (Bool, File FileInfo))
-> AnchoredFile FileInfo
-> (Bool, AnchoredFile FileInfo)
convertViewP f af@(bp :/ constr) =
convertViewP f (bp :/ constr) =
let (b, file) = f constr
in (b, bp :/ file)
@@ -260,7 +202,7 @@ sfileLike f = fileLikeSym f
afileLike :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo)
afileLike f@(bp :/ constr) = convertViewP fileLike f
afileLike f = convertViewP fileLike f
fileLike :: File FileInfo -> (Bool, File FileInfo)
@@ -312,7 +254,7 @@ invalidFileName :: Path Fn -> (Bool, Path Fn)
invalidFileName p@(Path "") = (True, p)
invalidFileName p@(Path ".") = (True, p)
invalidFileName p@(Path "..") = (True, p)
invalidFileName p@(Path fn) = (elem pathSeparator fn, p)
invalidFileName p = (elem pathSeparator (P.fromRel p), p)
-- |Matches on invalid filesnames, such as ".", ".." and anything
@@ -472,8 +414,6 @@ readWith ff p = do
-- TODO: could it happen that too many '..' lead
-- to something like '/' after normalization?
let sfp = if isAbsolute x then x else (P.fromAbs bd') </> x
sf <- PF.getFileStatus sfp -- important to break infinite symbolic
-- link cycle
rsfp <- P.realPath sfp
readWith ff =<< P.parseAbs rsfp
return $ SymLink fn' fv resolvedSyml x
@@ -733,7 +673,7 @@ removeNonexistent = filter isOkConstructor
--
-- When called on a non-symlink, returns False.
isBrokenSymlink :: File FileInfo -> Bool
isBrokenSymlink af@(SymLink _ _ (_ :/ Failed {}) _) = True
isBrokenSymlink (SymLink _ _ (_ :/ Failed {}) _) = True
isBrokenSymlink _ = False
@@ -744,7 +684,7 @@ isBrokenSymlink _ = False
hiddenFile :: Path Fn -> Bool
hiddenFile (Path ".") = False
hiddenFile (Path "..") = False
hiddenFile (Path fn) = "." `isPrefixOf` fn
hiddenFile p = "." `isPrefixOf` (P.fromRel p)
-- |Apply a function on the free variable. If there is no free variable
@@ -798,6 +738,7 @@ packPermissions dt = fromFreeVar (pStr . fileMode) dt
CharDev {} -> "c"
NamedPipe {} -> "p"
Socket {} -> "s"
_ -> "?"
ownerModeStr = hasFmStr PF.ownerReadMode "r"
++ hasFmStr PF.ownerWriteMode "w"
++ hasFmStr PF.ownerExecuteMode "x"