LIB/GTK: cleanup compiler warnings

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"

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 {})
+easyCopy cm from@(_ :/ SymLink{})
-              to@(_ :/ Dir {})
+              to@(_ :/ Dir{})
   = recreateSymlink cm from to
-easyCopy cm from@(_ :/ RegFile fn _)
+easyCopy cm from@(_ :/ RegFile{})
-              to@(_ :/ Dir {})
+              to@(_ :/ Dir{})
   = copyFileToDir cm from to
-easyCopy cm from@(_ :/ Dir fn _)
+easyCopy cm from@(_ :/ Dir{})
-              to@(_ :/ Dir {})
+              to@(_ :/ Dir{})
   = copyDir cm from to
 easyCopy _ _ _ = throw $ InvalidOperation "wrong input type"
 

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
+    isPrefixOf
-  , foldl'
-  , isPrefixOf
-  , sort
-  , sortBy
-  , (\\)
   )
 import Data.Maybe
   (
     catMaybes
-  , fromMaybe
-  )
-import Data.Ord
-  (
-    comparing
   )
 import Data.Time.Clock.POSIX
   (
     POSIXTime
   , posixSecondsToUTCTime
   )
-import Data.Time
+import Data.Time()
-  (
-    UTCTime(..)
-  )
-import Data.Traversable
-  (
-    for
-  )
-import Data.Word
-  (
-    Word64
-  )
 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
+    isAbsolute
-  , normalise
-  , equalFilePath
-  , isAbsolute
-  , joinPath
   , 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"

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

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 "Cancel"  (ResponseUser 0)
-  dialogAddButton chooserDialog "Merge"   (ResponseUser 1)
+  _ <- dialogAddButton chooserDialog "Merge"   (ResponseUser 1)
-  dialogAddButton chooserDialog "Replace" (ResponseUser 2)
+  _ <- 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 "Ok"     (ResponseUser 0)
-  dialogAddButton chooserDialog "Cancel" (ResponseUser 1)
+  _ <- 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

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
+

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

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

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
+  let dirtreePix Dir{}           = folderPix
-      dirtreePix (FileLike {})     = filePix
+      dirtreePix FileLike{}      = filePix
-      dirtreePix (DirSym _)        = folderSymPix
+      dirtreePix DirSym{}        = folderSymPix
-      dirtreePix (FileLikeSym {})  = fileSymPix
+      dirtreePix FileLikeSym{}   = fileSymPix
-      dirtreePix (Failed {})       = errorPix
+      dirtreePix Failed{}        = errorPix
-      dirtreePix (BrokenSymlink _) = errorPix
+      dirtreePix BrokenSymlink{} = errorPix
-      dirtreePix _                 = 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)

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