LIB/GTK: cleanup compiler warnings

This commit is contained in:
Julian Ospald 2016-03-31 16:19:31 +02:00
parent 65595fa9c5
commit 4da3c92e5e
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
10 changed files with 90 additions and 152 deletions

View File

@ -54,6 +54,7 @@ library
ghc-options:
-O2
-threaded
-Wall
"-with-rtsopts=-N"
executable hsfm-gtk
@ -62,6 +63,7 @@ executable hsfm-gtk
HSFM.GUI.Gtk.Callbacks
HSFM.GUI.Gtk.Data
HSFM.GUI.Gtk.Dialogs
HSFM.GUI.Gtk.Errors
HSFM.GUI.Gtk.Icons
HSFM.GUI.Gtk.MyGUI
HSFM.GUI.Gtk.MyView
@ -97,4 +99,5 @@ executable hsfm-gtk
ghc-options:
-O2
-threaded
-Wall
"-with-rtsopts=-N"

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"

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"

View File

@ -21,11 +21,6 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
module HSFM.GUI.Gtk.Callbacks where
import Control.Applicative
(
(<$>)
, (<*>)
)
import Control.Concurrent.STM
(
readTVarIO
@ -62,11 +57,6 @@ import HSFM.GUI.Gtk.Dialogs
import HSFM.GUI.Gtk.MyView
import HSFM.GUI.Gtk.Utils
import HSFM.Utils.IO
import System.FilePath
(
isAbsolute
, (</>)
)
import System.Glib.UTFString
(
glibToString
@ -225,7 +215,7 @@ open [item] mygui myview = withErrorDialog $
r ->
void $ openFile r
-- this throws on the first error that occurs
open (FileLikeList fs) mygui myview = withErrorDialog $
open (FileLikeList fs) _ _ = withErrorDialog $
forM_ fs $ \f -> void $ openFile f
open _ _ _ = withErrorDialog
. throw $ InvalidOperation
@ -234,7 +224,7 @@ open _ _ _ = withErrorDialog
-- |Execute a given file.
execute :: [Item] -> MyGUI -> MyView -> IO ()
execute [item] mygui myview = withErrorDialog $
execute [item] _ _ = withErrorDialog $
void $ executeFile item []
execute _ _ _ = withErrorDialog
. throw $ InvalidOperation
@ -243,12 +233,12 @@ execute _ _ _ = withErrorDialog
-- |Supposed to be used with 'withRows'. Deletes a file or directory.
del :: [Item] -> MyGUI -> MyView -> IO ()
del [item] mygui myview = withErrorDialog $ do
del [item] _ _ = withErrorDialog $ do
let cmsg = "Really delete \"" ++ fullPathS item ++ "\"?"
withConfirmationDialog cmsg
$ easyDelete item
-- this throws on the first error that occurs
del items@(_:_) mygui myview = withErrorDialog $ do
del items@(_:_) _ _ = withErrorDialog $ do
let cmsg = "Really delete " ++ show (length items) ++ " files?"
withConfirmationDialog cmsg
$ forM_ items $ \item -> easyDelete item
@ -282,7 +272,7 @@ copyInit _ _ _ = withErrorDialog
-- |Finalizes a file operation, such as copy or move.
operationFinal :: MyGUI -> MyView -> IO ()
operationFinal mygui myview = withErrorDialog $ do
operationFinal _ myview = withErrorDialog $ do
op <- readTVarIO (operationBuffer myview)
cdir <- getCurrentDir myview
case op of
@ -305,15 +295,13 @@ operationFinal mygui myview = withErrorDialog $ do
upDir :: MyGUI -> MyView -> IO ()
upDir mygui myview = withErrorDialog $ do
cdir <- getCurrentDir myview
rawModel' <- readTVarIO $ rawModel myview
sortedModel' <- readTVarIO $ sortedModel myview
nv <- goUp cdir
refreshView' mygui myview nv
-- |Go up one directory and visualize it in the treeView.
newFile :: MyGUI -> MyView -> IO ()
newFile mygui myview = withErrorDialog $ do
newFile _ myview = withErrorDialog $ do
mfn <- textInputDialog "Enter file name"
let pmfn = P.parseFn =<< mfn
for_ pmfn $ \fn -> do
@ -322,7 +310,7 @@ newFile mygui myview = withErrorDialog $ do
renameF :: [Item] -> MyGUI -> MyView -> IO ()
renameF [item] mygui myview = withErrorDialog $ do
renameF [item] _ _ = withErrorDialog $ do
mfn <- textInputDialog "Enter new file name"
let pmfn = P.parseFn =<< mfn
for_ pmfn $ \fn -> do

View File

@ -21,10 +21,6 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
module HSFM.GUI.Gtk.Dialogs where
import Control.Applicative
(
(<$>)
)
import Control.Exception
(
catch
@ -35,7 +31,6 @@ import Control.Exception
import Control.Monad
(
when
, void
)
import Data.Version
(
@ -62,7 +57,7 @@ import Distribution.Verbosity
import Graphics.UI.Gtk
import HSFM.FileSystem.Errors
import HSFM.FileSystem.FileOperations
import HSFM.GUI.Gtk.Data
import HSFM.GUI.Gtk.Errors
import Paths_hsfm
(
getDataFileName
@ -113,15 +108,16 @@ showCopyModeDialog = do
MessageQuestion
ButtonsNone
"Target exists, how to proceed?"
dialogAddButton chooserDialog "Cancel" (ResponseUser 0)
dialogAddButton chooserDialog "Merge" (ResponseUser 1)
dialogAddButton chooserDialog "Replace" (ResponseUser 2)
_ <- dialogAddButton chooserDialog "Cancel" (ResponseUser 0)
_ <- dialogAddButton chooserDialog "Merge" (ResponseUser 1)
_ <- dialogAddButton chooserDialog "Replace" (ResponseUser 2)
rID <- dialogRun chooserDialog
widgetDestroy chooserDialog
case rID of
ResponseUser 0 -> return Strict
ResponseUser 1 -> return Merge
ResponseUser 2 -> return Replace
_ -> throw UnknownDialogButton
-- |Attempts to run the given function with the `Strict` copy mode.
@ -134,7 +130,7 @@ withCopyModeDialog fa =
case e of
FileDoesExist _ -> doIt
DirDoesExist _ -> doIt
e -> throw e
e' -> throw e'
where
doIt = do cm <- showCopyModeDialog
case cm of
@ -196,8 +192,8 @@ textInputDialog title = do
title
entry <- entryNew
cbox <- dialogGetActionArea chooserDialog
dialogAddButton chooserDialog "Ok" (ResponseUser 0)
dialogAddButton chooserDialog "Cancel" (ResponseUser 1)
_ <- dialogAddButton chooserDialog "Ok" (ResponseUser 0)
_ <- dialogAddButton chooserDialog "Cancel" (ResponseUser 1)
boxPackStart (castToBox cbox) entry PackNatural 5
widgetShowAll chooserDialog
rID <- dialogRun chooserDialog
@ -205,5 +201,6 @@ textInputDialog title = do
-- TODO: make this more safe
ResponseUser 0 -> Just <$> entryGetText entry
ResponseUser 1 -> return Nothing
_ -> throw UnknownDialogButton
widgetDestroy chooserDialog
return ret

View File

@ -0,0 +1,34 @@
{--
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.
--}
{-# OPTIONS_HADDOCK ignore-exports #-}
-- |Provides error handling for Gtk.
module HSFM.GUI.Gtk.Errors where
import Control.Exception
import Data.Typeable
data GtkException = UnknownDialogButton
deriving (Show, Typeable)
instance Exception GtkException

View File

@ -27,7 +27,6 @@ import Data.Maybe
fromJust
)
import Graphics.UI.Gtk
import Graphics.UI.Gtk.Gdk.Pixbuf
import Paths_hsfm
(
getDataFileName

View File

@ -110,6 +110,7 @@ createMyGUI = do
let mygui = MkMyGUI {..}
-- sets the default icon
windowSetDefaultIconFromFile =<< getDataFileName "data/Gtk/icons/hsfm.png"
_ <- windowSetDefaultIconFromFile
=<< getDataFileName "data/Gtk/icons/hsfm.png"
return mygui

View File

@ -21,10 +21,6 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
module HSFM.GUI.Gtk.MyView where
import Control.Applicative
(
(<$>)
)
import Control.Concurrent.MVar
(
newEmptyMVar
@ -41,10 +37,6 @@ import Control.Exception
try
, SomeException
)
import Control.Monad
(
when
)
import Data.Foldable
(
for_
@ -64,17 +56,12 @@ import HSFM.GUI.Gtk.Data
import HSFM.GUI.Gtk.Icons
import HSFM.GUI.Gtk.Utils
import HSFM.Utils.IO
import System.FilePath
(
isAbsolute
)
import System.INotify
(
addWatch
, initINotify
, killINotify
, EventVariety(..)
, Event(..)
)
import System.IO.Error
(
@ -218,19 +205,19 @@ refreshView mygui myview mfp =
-- readFileWithFileInfo can just outright fail...
ecdir <- tryIOError (HSFM.FileSystem.FileType.readFileWithFileInfo mdir)
case ecdir of
Right cdir -> do
Right cdir ->
-- ...or return an `AnchordFile` with a Failed constructor,
-- both of which need to be handled here
if (failed . file $ cdir)
then refreshView mygui myview =<< getAlternativeDir
else refreshView' mygui myview cdir
Left e -> refreshView mygui myview =<< getAlternativeDir
Left _ -> refreshView mygui myview =<< getAlternativeDir
Nothing -> refreshView mygui myview =<< getAlternativeDir
where
getAlternativeDir = do
ecd <- try (getCurrentDir myview) :: IO (Either SomeException
(AnchoredFile FileInfo))
case (ecd) of
case ecd of
Right dir -> return (Just $ fullPathS dir)
Left _ -> return (Just "/")
@ -285,13 +272,13 @@ constructView mygui myview = do
filePix <- getIcon IFile iT (iconSize settings')
fileSymPix <- getSymlinkIcon IFile iT (iconSize settings')
errorPix <- getIcon IError iT (iconSize settings')
let dirtreePix (Dir {}) = folderPix
dirtreePix (FileLike {}) = filePix
dirtreePix (DirSym _) = folderSymPix
dirtreePix (FileLikeSym {}) = fileSymPix
dirtreePix (Failed {}) = errorPix
dirtreePix (BrokenSymlink _) = errorPix
dirtreePix _ = errorPix
let dirtreePix Dir{} = folderPix
dirtreePix FileLike{} = filePix
dirtreePix DirSym{} = folderSymPix
dirtreePix FileLikeSym{} = fileSymPix
dirtreePix Failed{} = errorPix
dirtreePix BrokenSymlink{} = errorPix
dirtreePix _ = errorPix
view' <- readTVarIO $ view myview
@ -350,7 +337,7 @@ constructView mygui myview = do
mi <- tryTakeMVar (inotify myview)
for_ mi $ \i -> killINotify i
newi <- initINotify
w <- addWatch
_ <- addWatch
newi
[Move, MoveIn, MoveOut, MoveSelf, Create, Delete, DeleteSelf]
(P.fromAbs cdirp)

View File

@ -21,10 +21,6 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
module HSFM.GUI.Gtk.Utils where
import Control.Applicative
(
(<$>)
)
import Control.Concurrent.STM
(
readTVarIO
@ -73,7 +69,7 @@ getSelectedItems' :: MyGUI
-> MyView
-> [TreePath]
-> IO [Item]
getSelectedItems' mygui myview tps = do
getSelectedItems' _ myview tps = do
rawModel' <- readTVarIO $ rawModel myview
sortedModel' <- readTVarIO $ sortedModel myview
filteredModel' <- readTVarIO $ filteredModel myview
@ -107,7 +103,7 @@ withItems mygui myview io = do
fileListStore :: AnchoredFile FileInfo -- ^ current dir
-> MyView
-> IO (ListStore Item)
fileListStore dt myview = do
fileListStore dt _ = do
cs <- HSFM.FileSystem.FileType.getContents dt
listStoreNew cs