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: ghc-options:
-O2 -O2
-threaded -threaded
-Wall
"-with-rtsopts=-N" "-with-rtsopts=-N"
executable hsfm-gtk executable hsfm-gtk
@ -62,6 +63,7 @@ executable hsfm-gtk
HSFM.GUI.Gtk.Callbacks HSFM.GUI.Gtk.Callbacks
HSFM.GUI.Gtk.Data HSFM.GUI.Gtk.Data
HSFM.GUI.Gtk.Dialogs HSFM.GUI.Gtk.Dialogs
HSFM.GUI.Gtk.Errors
HSFM.GUI.Gtk.Icons HSFM.GUI.Gtk.Icons
HSFM.GUI.Gtk.MyGUI HSFM.GUI.Gtk.MyGUI
HSFM.GUI.Gtk.MyView HSFM.GUI.Gtk.MyView
@ -97,4 +99,5 @@ executable hsfm-gtk
ghc-options: ghc-options:
-O2 -O2
-threaded -threaded
-Wall
"-with-rtsopts=-N" "-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 module HSFM.FileSystem.FileOperations where
import Control.Applicative
(
(<$>)
)
import Control.Exception import Control.Exception
( (
throw throw
@ -58,11 +54,6 @@ import qualified HPath as P
import HSFM.FileSystem.Errors import HSFM.FileSystem.Errors
import HSFM.FileSystem.FileType import HSFM.FileSystem.FileType
import HSFM.Utils.IO import HSFM.Utils.IO
import HSFM.Utils.MyPrelude
import System.FilePath
(
(</>)
)
import System.Posix.Directory import System.Posix.Directory
( (
createDirectory createDirectory
@ -158,6 +149,7 @@ runFileOp (FMove fo) = return $ Just $ FMove fo
runFileOp (FDelete fp) = easyDelete fp >> return Nothing runFileOp (FDelete fp) = easyDelete fp >> return Nothing
runFileOp (FOpen fp) = openFile fp >> return Nothing runFileOp (FOpen fp) = openFile fp >> return Nothing
runFileOp (FExecute fp args) = executeFile fp args >> return Nothing runFileOp (FExecute fp args) = executeFile fp args >> return Nothing
runFileOp _ = return Nothing
@ -175,7 +167,7 @@ copyDir :: CopyMode
-> IO () -> IO ()
copyDir _ AFileInvFN _ = throw InvalidFileName copyDir _ AFileInvFN _ = throw InvalidFileName
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 {}) to@(_ :/ Dir {})
= do = do
let fromp = fullPath from let fromp = fullPath from
@ -196,20 +188,20 @@ copyDir cm from@(_ :/ Dir fromn (FileInfo { fileMode = fmode }))
(_ :/ RegFile {}) -> copyFileToDir Replace f destdir (_ :/ RegFile {}) -> copyFileToDir Replace f destdir
_ -> return () _ -> return ()
where where
createDestdir destdir fmode = createDestdir destdir fmode' =
let destdir' = P.toFilePath destdir let destdir' = P.toFilePath destdir
in case cm of in case cm of
Merge -> Merge ->
unlessM (doesDirectoryExist destdir) unlessM (doesDirectoryExist destdir)
(createDirectory destdir' fmode) (createDirectory destdir' fmode')
Strict -> do Strict -> do
throwDirDoesExist destdir throwDirDoesExist destdir
createDirectory destdir' fmode createDirectory destdir' fmode'
Replace -> do Replace -> do
whenM (doesDirectoryExist destdir) whenM (doesDirectoryExist destdir)
(deleteDirRecursive =<< (deleteDirRecursive =<<
HSFM.FileSystem.FileType.readFileWithFileInfo destdir) HSFM.FileSystem.FileType.readFileWithFileInfo destdir)
createDirectory destdir' fmode createDirectory destdir' fmode'
copyDir _ _ _ = throw $ InvalidOperation "wrong input type" copyDir _ _ _ = throw $ InvalidOperation "wrong input type"
@ -295,14 +287,14 @@ easyCopy :: CopyMode
-> AnchoredFile FileInfo -> AnchoredFile FileInfo
-> AnchoredFile FileInfo -> AnchoredFile FileInfo
-> IO () -> IO ()
easyCopy cm from@(_ :/ SymLink {}) easyCopy cm from@(_ :/ SymLink{})
to@(_ :/ Dir {}) to@(_ :/ Dir{})
= recreateSymlink cm from to = recreateSymlink cm from to
easyCopy cm from@(_ :/ RegFile fn _) easyCopy cm from@(_ :/ RegFile{})
to@(_ :/ Dir {}) to@(_ :/ Dir{})
= copyFileToDir cm from to = copyFileToDir cm from to
easyCopy cm from@(_ :/ Dir fn _) easyCopy cm from@(_ :/ Dir{})
to@(_ :/ Dir {}) to@(_ :/ Dir{})
= copyDir cm from to = copyDir cm from to
easyCopy _ _ _ = throw $ InvalidOperation "wrong input type" 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 module HSFM.FileSystem.FileType where
import Control.Applicative
(
(<*>)
, (<$>)
, (<|>)
, pure
)
import Control.Arrow
(
first
)
import Control.Exception import Control.Exception
( (
handle handle
@ -53,86 +43,38 @@ import Control.Monad.State.Lazy
import Data.Default import Data.Default
import Data.List import Data.List
( (
delete isPrefixOf
, foldl'
, isPrefixOf
, sort
, sortBy
, (\\)
) )
import Data.Maybe import Data.Maybe
( (
catMaybes catMaybes
, fromMaybe
)
import Data.Ord
(
comparing
) )
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
( (
POSIXTime POSIXTime
, posixSecondsToUTCTime , posixSecondsToUTCTime
) )
import Data.Time import Data.Time()
(
UTCTime(..)
)
import Data.Traversable
(
for
)
import Data.Word
(
Word64
)
import HPath import HPath
( (
Abs Abs
, Path , Path
, Fn , Fn
, Rel
, pattern Path , pattern Path
) )
import qualified HPath as P import qualified HPath as P
import HSFM.Utils.MyPrelude import HSFM.Utils.MyPrelude
import Safe
(
atDef
, initDef
)
import System.FilePath import System.FilePath
( (
combine isAbsolute
, normalise
, equalFilePath
, isAbsolute
, joinPath
, pathSeparator , pathSeparator
, splitDirectories
, takeFileName
, (</>) , (</>)
) )
import System.IO
(
IOMode
, Handle
, openFile
)
import System.IO.Error import System.IO.Error
( (
ioeGetErrorType ioeGetErrorType
, isDoesNotExistErrorType , isDoesNotExistErrorType
) )
import System.IO.Unsafe
(
unsafeInterleaveIO
)
import System.Locale
(
defaultTimeLocale
, rfc822DateFormat
)
import System.Posix.Types import System.Posix.Types
( (
DeviceID DeviceID
@ -237,7 +179,7 @@ data FileInfo = FileInfo {
convertViewP :: (File FileInfo -> (Bool, File FileInfo)) convertViewP :: (File FileInfo -> (Bool, File FileInfo))
-> AnchoredFile FileInfo -> AnchoredFile FileInfo
-> (Bool, AnchoredFile FileInfo) -> (Bool, AnchoredFile FileInfo)
convertViewP f af@(bp :/ constr) = convertViewP f (bp :/ constr) =
let (b, file) = f constr let (b, file) = f constr
in (b, bp :/ file) in (b, bp :/ file)
@ -260,7 +202,7 @@ sfileLike f = fileLikeSym f
afileLike :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo) afileLike :: AnchoredFile FileInfo -> (Bool, AnchoredFile FileInfo)
afileLike f@(bp :/ constr) = convertViewP fileLike f afileLike f = convertViewP fileLike f
fileLike :: File FileInfo -> (Bool, File FileInfo) 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 ".") = (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 -- |Matches on invalid filesnames, such as ".", ".." and anything
@ -472,8 +414,6 @@ readWith ff p = do
-- TODO: could it happen that too many '..' lead -- TODO: could it happen that too many '..' lead
-- to something like '/' after normalization? -- to something like '/' after normalization?
let sfp = if isAbsolute x then x else (P.fromAbs bd') </> x 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 rsfp <- P.realPath sfp
readWith ff =<< P.parseAbs rsfp readWith ff =<< P.parseAbs rsfp
return $ SymLink fn' fv resolvedSyml x return $ SymLink fn' fv resolvedSyml x
@ -733,7 +673,7 @@ removeNonexistent = filter isOkConstructor
-- --
-- When called on a non-symlink, returns False. -- When called on a non-symlink, returns False.
isBrokenSymlink :: File FileInfo -> Bool isBrokenSymlink :: File FileInfo -> Bool
isBrokenSymlink af@(SymLink _ _ (_ :/ Failed {}) _) = True isBrokenSymlink (SymLink _ _ (_ :/ Failed {}) _) = True
isBrokenSymlink _ = False isBrokenSymlink _ = False
@ -744,7 +684,7 @@ isBrokenSymlink _ = False
hiddenFile :: Path Fn -> Bool hiddenFile :: Path Fn -> Bool
hiddenFile (Path ".") = False hiddenFile (Path ".") = False
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 -- |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" CharDev {} -> "c"
NamedPipe {} -> "p" NamedPipe {} -> "p"
Socket {} -> "s" Socket {} -> "s"
_ -> "?"
ownerModeStr = hasFmStr PF.ownerReadMode "r" ownerModeStr = hasFmStr PF.ownerReadMode "r"
++ hasFmStr PF.ownerWriteMode "w" ++ hasFmStr PF.ownerWriteMode "w"
++ hasFmStr PF.ownerExecuteMode "x" ++ 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 module HSFM.GUI.Gtk.Callbacks where
import Control.Applicative
(
(<$>)
, (<*>)
)
import Control.Concurrent.STM import Control.Concurrent.STM
( (
readTVarIO readTVarIO
@ -62,11 +57,6 @@ import HSFM.GUI.Gtk.Dialogs
import HSFM.GUI.Gtk.MyView import HSFM.GUI.Gtk.MyView
import HSFM.GUI.Gtk.Utils import HSFM.GUI.Gtk.Utils
import HSFM.Utils.IO import HSFM.Utils.IO
import System.FilePath
(
isAbsolute
, (</>)
)
import System.Glib.UTFString import System.Glib.UTFString
( (
glibToString glibToString
@ -225,7 +215,7 @@ open [item] mygui myview = withErrorDialog $
r -> r ->
void $ openFile r void $ openFile r
-- this throws on the first error that occurs -- this throws on the first error that occurs
open (FileLikeList fs) mygui myview = withErrorDialog $ open (FileLikeList fs) _ _ = withErrorDialog $
forM_ fs $ \f -> void $ openFile f forM_ fs $ \f -> void $ openFile f
open _ _ _ = withErrorDialog open _ _ _ = withErrorDialog
. throw $ InvalidOperation . throw $ InvalidOperation
@ -234,7 +224,7 @@ open _ _ _ = withErrorDialog
-- |Execute a given file. -- |Execute a given file.
execute :: [Item] -> MyGUI -> MyView -> IO () execute :: [Item] -> MyGUI -> MyView -> IO ()
execute [item] mygui myview = withErrorDialog $ execute [item] _ _ = withErrorDialog $
void $ executeFile item [] void $ executeFile item []
execute _ _ _ = withErrorDialog execute _ _ _ = withErrorDialog
. throw $ InvalidOperation . throw $ InvalidOperation
@ -243,12 +233,12 @@ execute _ _ _ = withErrorDialog
-- |Supposed to be used with 'withRows'. Deletes a file or directory. -- |Supposed to be used with 'withRows'. Deletes a file or directory.
del :: [Item] -> MyGUI -> MyView -> IO () del :: [Item] -> MyGUI -> MyView -> IO ()
del [item] mygui myview = withErrorDialog $ do del [item] _ _ = withErrorDialog $ do
let cmsg = "Really delete \"" ++ fullPathS item ++ "\"?" let cmsg = "Really delete \"" ++ fullPathS item ++ "\"?"
withConfirmationDialog cmsg withConfirmationDialog cmsg
$ easyDelete item $ easyDelete item
-- this throws on the first error that occurs -- 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?" let cmsg = "Really delete " ++ show (length items) ++ " files?"
withConfirmationDialog cmsg withConfirmationDialog cmsg
$ forM_ items $ \item -> easyDelete item $ forM_ items $ \item -> easyDelete item
@ -282,7 +272,7 @@ copyInit _ _ _ = withErrorDialog
-- |Finalizes a file operation, such as copy or move. -- |Finalizes a file operation, such as copy or move.
operationFinal :: MyGUI -> MyView -> IO () operationFinal :: MyGUI -> MyView -> IO ()
operationFinal mygui myview = withErrorDialog $ do operationFinal _ myview = withErrorDialog $ do
op <- readTVarIO (operationBuffer myview) op <- readTVarIO (operationBuffer myview)
cdir <- getCurrentDir myview cdir <- getCurrentDir myview
case op of case op of
@ -305,15 +295,13 @@ operationFinal mygui myview = withErrorDialog $ do
upDir :: MyGUI -> MyView -> IO () upDir :: MyGUI -> MyView -> IO ()
upDir mygui myview = withErrorDialog $ do upDir mygui myview = withErrorDialog $ do
cdir <- getCurrentDir myview cdir <- getCurrentDir myview
rawModel' <- readTVarIO $ rawModel myview
sortedModel' <- readTVarIO $ sortedModel myview
nv <- goUp cdir nv <- goUp cdir
refreshView' mygui myview nv refreshView' mygui myview nv
-- |Go up one directory and visualize it in the treeView. -- |Go up one directory and visualize it in the treeView.
newFile :: MyGUI -> MyView -> IO () newFile :: MyGUI -> MyView -> IO ()
newFile mygui myview = withErrorDialog $ do newFile _ myview = withErrorDialog $ do
mfn <- textInputDialog "Enter file name" mfn <- textInputDialog "Enter file name"
let pmfn = P.parseFn =<< mfn let pmfn = P.parseFn =<< mfn
for_ pmfn $ \fn -> do for_ pmfn $ \fn -> do
@ -322,7 +310,7 @@ newFile mygui myview = withErrorDialog $ do
renameF :: [Item] -> MyGUI -> MyView -> IO () renameF :: [Item] -> MyGUI -> MyView -> IO ()
renameF [item] mygui myview = withErrorDialog $ do renameF [item] _ _ = withErrorDialog $ do
mfn <- textInputDialog "Enter new file name" mfn <- textInputDialog "Enter new file name"
let pmfn = P.parseFn =<< mfn let pmfn = P.parseFn =<< mfn
for_ pmfn $ \fn -> do 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 module HSFM.GUI.Gtk.Dialogs where
import Control.Applicative
(
(<$>)
)
import Control.Exception import Control.Exception
( (
catch catch
@ -35,7 +31,6 @@ import Control.Exception
import Control.Monad import Control.Monad
( (
when when
, void
) )
import Data.Version import Data.Version
( (
@ -62,7 +57,7 @@ import Distribution.Verbosity
import Graphics.UI.Gtk import Graphics.UI.Gtk
import HSFM.FileSystem.Errors import HSFM.FileSystem.Errors
import HSFM.FileSystem.FileOperations import HSFM.FileSystem.FileOperations
import HSFM.GUI.Gtk.Data import HSFM.GUI.Gtk.Errors
import Paths_hsfm import Paths_hsfm
( (
getDataFileName getDataFileName
@ -113,15 +108,16 @@ showCopyModeDialog = do
MessageQuestion MessageQuestion
ButtonsNone ButtonsNone
"Target exists, how to proceed?" "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 rID <- dialogRun chooserDialog
widgetDestroy chooserDialog widgetDestroy chooserDialog
case rID of case rID of
ResponseUser 0 -> return Strict ResponseUser 0 -> return Strict
ResponseUser 1 -> return Merge ResponseUser 1 -> return Merge
ResponseUser 2 -> return Replace ResponseUser 2 -> return Replace
_ -> throw UnknownDialogButton
-- |Attempts to run the given function with the `Strict` copy mode. -- |Attempts to run the given function with the `Strict` copy mode.
@ -134,7 +130,7 @@ withCopyModeDialog fa =
case e of case e of
FileDoesExist _ -> doIt FileDoesExist _ -> doIt
DirDoesExist _ -> doIt DirDoesExist _ -> doIt
e -> throw e e' -> throw e'
where where
doIt = do cm <- showCopyModeDialog doIt = do cm <- showCopyModeDialog
case cm of case cm of
@ -196,8 +192,8 @@ textInputDialog title = do
title title
entry <- entryNew entry <- entryNew
cbox <- dialogGetActionArea chooserDialog 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 boxPackStart (castToBox cbox) entry PackNatural 5
widgetShowAll chooserDialog widgetShowAll chooserDialog
rID <- dialogRun chooserDialog rID <- dialogRun chooserDialog
@ -205,5 +201,6 @@ textInputDialog title = do
-- TODO: make this more safe -- TODO: make this more safe
ResponseUser 0 -> Just <$> entryGetText entry ResponseUser 0 -> Just <$> entryGetText entry
ResponseUser 1 -> return Nothing ResponseUser 1 -> return Nothing
_ -> throw UnknownDialogButton
widgetDestroy chooserDialog widgetDestroy chooserDialog
return ret 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 fromJust
) )
import Graphics.UI.Gtk import Graphics.UI.Gtk
import Graphics.UI.Gtk.Gdk.Pixbuf
import Paths_hsfm import Paths_hsfm
( (
getDataFileName getDataFileName

View File

@ -110,6 +110,7 @@ createMyGUI = do
let mygui = MkMyGUI {..} let mygui = MkMyGUI {..}
-- sets the default icon -- sets the default icon
windowSetDefaultIconFromFile =<< getDataFileName "data/Gtk/icons/hsfm.png" _ <- windowSetDefaultIconFromFile
=<< getDataFileName "data/Gtk/icons/hsfm.png"
return mygui 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 module HSFM.GUI.Gtk.MyView where
import Control.Applicative
(
(<$>)
)
import Control.Concurrent.MVar import Control.Concurrent.MVar
( (
newEmptyMVar newEmptyMVar
@ -41,10 +37,6 @@ import Control.Exception
try try
, SomeException , SomeException
) )
import Control.Monad
(
when
)
import Data.Foldable import Data.Foldable
( (
for_ for_
@ -64,17 +56,12 @@ import HSFM.GUI.Gtk.Data
import HSFM.GUI.Gtk.Icons import HSFM.GUI.Gtk.Icons
import HSFM.GUI.Gtk.Utils import HSFM.GUI.Gtk.Utils
import HSFM.Utils.IO import HSFM.Utils.IO
import System.FilePath
(
isAbsolute
)
import System.INotify import System.INotify
( (
addWatch addWatch
, initINotify , initINotify
, killINotify , killINotify
, EventVariety(..) , EventVariety(..)
, Event(..)
) )
import System.IO.Error import System.IO.Error
( (
@ -218,19 +205,19 @@ refreshView mygui myview mfp =
-- readFileWithFileInfo can just outright fail... -- readFileWithFileInfo can just outright fail...
ecdir <- tryIOError (HSFM.FileSystem.FileType.readFileWithFileInfo mdir) ecdir <- tryIOError (HSFM.FileSystem.FileType.readFileWithFileInfo mdir)
case ecdir of case ecdir of
Right cdir -> do Right cdir ->
-- ...or return an `AnchordFile` with a Failed constructor, -- ...or return an `AnchordFile` with a Failed constructor,
-- both of which need to be handled here -- both of which need to be handled here
if (failed . file $ cdir) if (failed . file $ cdir)
then refreshView mygui myview =<< getAlternativeDir then refreshView mygui myview =<< getAlternativeDir
else refreshView' mygui myview cdir else refreshView' mygui myview cdir
Left e -> refreshView mygui myview =<< getAlternativeDir Left _ -> refreshView mygui myview =<< getAlternativeDir
Nothing -> refreshView mygui myview =<< getAlternativeDir Nothing -> refreshView mygui myview =<< getAlternativeDir
where where
getAlternativeDir = do getAlternativeDir = do
ecd <- try (getCurrentDir myview) :: IO (Either SomeException ecd <- try (getCurrentDir myview) :: IO (Either SomeException
(AnchoredFile FileInfo)) (AnchoredFile FileInfo))
case (ecd) of case ecd of
Right dir -> return (Just $ fullPathS dir) Right dir -> return (Just $ fullPathS dir)
Left _ -> return (Just "/") Left _ -> return (Just "/")
@ -285,12 +272,12 @@ constructView mygui myview = do
filePix <- getIcon IFile iT (iconSize settings') filePix <- getIcon IFile iT (iconSize settings')
fileSymPix <- getSymlinkIcon IFile iT (iconSize settings') fileSymPix <- getSymlinkIcon IFile iT (iconSize settings')
errorPix <- getIcon IError 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
@ -350,7 +337,7 @@ constructView mygui myview = do
mi <- tryTakeMVar (inotify myview) mi <- tryTakeMVar (inotify myview)
for_ mi $ \i -> killINotify i for_ mi $ \i -> killINotify i
newi <- initINotify newi <- initINotify
w <- addWatch _ <- addWatch
newi newi
[Move, MoveIn, MoveOut, MoveSelf, Create, Delete, DeleteSelf] [Move, MoveIn, MoveOut, MoveSelf, Create, Delete, DeleteSelf]
(P.fromAbs cdirp) (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 module HSFM.GUI.Gtk.Utils where
import Control.Applicative
(
(<$>)
)
import Control.Concurrent.STM import Control.Concurrent.STM
( (
readTVarIO readTVarIO
@ -73,7 +69,7 @@ getSelectedItems' :: MyGUI
-> MyView -> MyView
-> [TreePath] -> [TreePath]
-> IO [Item] -> IO [Item]
getSelectedItems' mygui myview tps = do getSelectedItems' _ myview tps = do
rawModel' <- readTVarIO $ rawModel myview rawModel' <- readTVarIO $ rawModel myview
sortedModel' <- readTVarIO $ sortedModel myview sortedModel' <- readTVarIO $ sortedModel myview
filteredModel' <- readTVarIO $ filteredModel myview filteredModel' <- readTVarIO $ filteredModel myview
@ -107,7 +103,7 @@ withItems mygui myview io = do
fileListStore :: AnchoredFile FileInfo -- ^ current dir fileListStore :: AnchoredFile FileInfo -- ^ current dir
-> MyView -> MyView
-> IO (ListStore Item) -> IO (ListStore Item)
fileListStore dt myview = do fileListStore dt _ = do
cs <- HSFM.FileSystem.FileType.getContents dt cs <- HSFM.FileSystem.FileType.getContents dt
listStoreNew cs listStoreNew cs