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

26
src/HSFM/GUI/Gtk/Callbacks.hs
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

21
src/HSFM/GUI/Gtk/Dialogs.hs
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

34
src/HSFM/GUI/Gtk/Errors.hs Normal file
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

1
src/HSFM/GUI/Gtk/Icons.hs
View File

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

3
src/HSFM/GUI/Gtk/MyGUI.hs
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

35
src/HSFM/GUI/Gtk/MyView.hs
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)

8
src/HSFM/GUI/Gtk/Utils.hs
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