From 4da3c92e5ed2ad1ad81b2598427aa5181c665db5 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Thu, 31 Mar 2016 16:19:31 +0200 Subject: [PATCH] LIB/GTK: cleanup compiler warnings --- hsfm.cabal | 3 + src/HSFM/FileSystem/FileOperations.hs | 32 ++++------- src/HSFM/FileSystem/FileType.hs | 79 ++++----------------------- src/HSFM/GUI/Gtk/Callbacks.hs | 26 +++------ src/HSFM/GUI/Gtk/Dialogs.hs | 21 +++---- src/HSFM/GUI/Gtk/Errors.hs | 34 ++++++++++++ src/HSFM/GUI/Gtk/Icons.hs | 1 - src/HSFM/GUI/Gtk/MyGUI.hs | 3 +- src/HSFM/GUI/Gtk/MyView.hs | 35 ++++-------- src/HSFM/GUI/Gtk/Utils.hs | 8 +-- 10 files changed, 90 insertions(+), 152 deletions(-) create mode 100644 src/HSFM/GUI/Gtk/Errors.hs diff --git a/hsfm.cabal b/hsfm.cabal index 912521f..749a896 100644 --- a/hsfm.cabal +++ b/hsfm.cabal @@ -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" diff --git a/src/HSFM/FileSystem/FileOperations.hs b/src/HSFM/FileSystem/FileOperations.hs index 4435bdf..93150f2 100644 --- a/src/HSFM/FileSystem/FileOperations.hs +++ b/src/HSFM/FileSystem/FileOperations.hs @@ -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" diff --git a/src/HSFM/FileSystem/FileType.hs b/src/HSFM/FileSystem/FileType.hs index 4a70206..e99fafd 100644 --- a/src/HSFM/FileSystem/FileType.hs +++ b/src/HSFM/FileSystem/FileType.hs @@ -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" diff --git a/src/HSFM/GUI/Gtk/Callbacks.hs b/src/HSFM/GUI/Gtk/Callbacks.hs index d556e39..4290bdd 100644 --- a/src/HSFM/GUI/Gtk/Callbacks.hs +++ b/src/HSFM/GUI/Gtk/Callbacks.hs @@ -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 diff --git a/src/HSFM/GUI/Gtk/Dialogs.hs b/src/HSFM/GUI/Gtk/Dialogs.hs index 54e5f8b..36c9205 100644 --- a/src/HSFM/GUI/Gtk/Dialogs.hs +++ b/src/HSFM/GUI/Gtk/Dialogs.hs @@ -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 diff --git a/src/HSFM/GUI/Gtk/Errors.hs b/src/HSFM/GUI/Gtk/Errors.hs new file mode 100644 index 0000000..b301f9a --- /dev/null +++ b/src/HSFM/GUI/Gtk/Errors.hs @@ -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 + diff --git a/src/HSFM/GUI/Gtk/Icons.hs b/src/HSFM/GUI/Gtk/Icons.hs index d7e241e..76c0aad 100644 --- a/src/HSFM/GUI/Gtk/Icons.hs +++ b/src/HSFM/GUI/Gtk/Icons.hs @@ -27,7 +27,6 @@ import Data.Maybe fromJust ) import Graphics.UI.Gtk -import Graphics.UI.Gtk.Gdk.Pixbuf import Paths_hsfm ( getDataFileName diff --git a/src/HSFM/GUI/Gtk/MyGUI.hs b/src/HSFM/GUI/Gtk/MyGUI.hs index 07057e5..0edb16a 100644 --- a/src/HSFM/GUI/Gtk/MyGUI.hs +++ b/src/HSFM/GUI/Gtk/MyGUI.hs @@ -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 diff --git a/src/HSFM/GUI/Gtk/MyView.hs b/src/HSFM/GUI/Gtk/MyView.hs index fd7b001..7a7575e 100644 --- a/src/HSFM/GUI/Gtk/MyView.hs +++ b/src/HSFM/GUI/Gtk/MyView.hs @@ -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) diff --git a/src/HSFM/GUI/Gtk/Utils.hs b/src/HSFM/GUI/Gtk/Utils.hs index 6dfb23b..d044b6a 100644 --- a/src/HSFM/GUI/Gtk/Utils.hs +++ b/src/HSFM/GUI/Gtk/Utils.hs @@ -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