GTK: restructure Callbacks.hs to make it more readable

This commit is contained in:
Julian Ospald 2016-04-20 01:25:40 +02:00
parent 3c6aca04b4
commit 5c57551438
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28

View File

@ -76,6 +76,11 @@ import System.Posix.Env.ByteString
-----------------
---- MAIN CALLBACK ENTRYPOINT ----
-- |Set callbacks, on hotkeys, events and stuff.
setCallbacks :: MyGUI -> MyView -> IO ()
setCallbacks mygui myview = do
@ -279,50 +284,9 @@ setCallbacks mygui myview = do
-- |Go to the url given at the 'urlBar' and visualize it in the given
-- treeView.
--
-- If the url is invalid, does nothing.
urlGoTo :: MyGUI -> MyView -> IO ()
urlGoTo mygui myview = withErrorDialog $ do
fp <- entryGetText (urlBar mygui)
forM_ (P.parseAbs fp :: Maybe (Path Abs)) $ \fp' ->
whenM (canOpenDirectory fp')
(goDir mygui myview =<< (readFile getFileInfo $ fp'))
goHome :: MyGUI -> MyView -> IO ()
goHome mygui myview = withErrorDialog $ do
mhomedir <- getEnv "HOME"
forM_ (P.parseAbs =<< mhomedir :: Maybe (Path Abs)) $ \fp' ->
whenM (canOpenDirectory fp')
(goDir mygui myview =<< (readFile getFileInfo $ fp'))
-- |Supposed to be used with 'withRows'. Opens a file or directory.
open :: [Item] -> MyGUI -> MyView -> IO ()
open [item] mygui myview = withErrorDialog $
case item of
DirOrSym r -> do
nv <- readFile getFileInfo $ path r
goDir mygui myview nv
r ->
void $ openFile r
-- this throws on the first error that occurs
open (FileLikeList fs) _ _ = withErrorDialog $
forM_ fs $ \f -> void $ openFile f
open _ _ _ = withErrorDialog
. throw $ InvalidOperation
"Operation not supported on multiple files"
-- |Execute a given file.
execute :: [Item] -> MyGUI -> MyView -> IO ()
execute [item] _ _ = withErrorDialog $
void $ executeFile item []
execute _ _ _ = withErrorDialog
. throw $ InvalidOperation
"Operation not supported on multiple files"
---- FILE OPERATION CALLBACKS (COPY, MOVE, ...) ----
-- |Supposed to be used with 'withRows'. Deletes a file or directory.
@ -400,14 +364,6 @@ operationFinal mygui myview mitem = withErrorDialog $ do
items -> (show . length $ items) ++ " items"
-- |Go up one directory and visualize it in the treeView.
upDir :: MyGUI -> MyView -> IO ()
upDir mygui myview = withErrorDialog $ do
cdir <- getCurrentDir myview
nv <- goUp cdir
goDir mygui myview nv
-- |Create a new file.
newFile :: MyGUI -> MyView -> IO ()
newFile _ myview = withErrorDialog $ do
@ -444,6 +400,65 @@ renameF _ _ _ = withErrorDialog
"Operation not supported on multiple files"
---- DIRECTORY TRAVERSAL AND FILE OPENING CALLBACKS ----
-- |Go to the url given at the 'urlBar' and visualize it in the given
-- treeView.
--
-- If the url is invalid, does nothing.
urlGoTo :: MyGUI -> MyView -> IO ()
urlGoTo mygui myview = withErrorDialog $ do
fp <- entryGetText (urlBar mygui)
forM_ (P.parseAbs fp :: Maybe (Path Abs)) $ \fp' ->
whenM (canOpenDirectory fp')
(goDir mygui myview =<< (readFile getFileInfo $ fp'))
goHome :: MyGUI -> MyView -> IO ()
goHome mygui myview = withErrorDialog $ do
mhomedir <- getEnv "HOME"
forM_ (P.parseAbs =<< mhomedir :: Maybe (Path Abs)) $ \fp' ->
whenM (canOpenDirectory fp')
(goDir mygui myview =<< (readFile getFileInfo $ fp'))
-- |Execute a given file.
execute :: [Item] -> MyGUI -> MyView -> IO ()
execute [item] _ _ = withErrorDialog $
void $ executeFile item []
execute _ _ _ = withErrorDialog
. throw $ InvalidOperation
"Operation not supported on multiple files"
-- |Supposed to be used with 'withRows'. Opens a file or directory.
open :: [Item] -> MyGUI -> MyView -> IO ()
open [item] mygui myview = withErrorDialog $
case item of
DirOrSym r -> do
nv <- readFile getFileInfo $ path r
goDir mygui myview nv
r ->
void $ openFile r
-- this throws on the first error that occurs
open (FileLikeList fs) _ _ = withErrorDialog $
forM_ fs $ \f -> void $ openFile f
open _ _ _ = withErrorDialog
. throw $ InvalidOperation
"Operation not supported on multiple files"
-- |Go up one directory and visualize it in the treeView.
upDir :: MyGUI -> MyView -> IO ()
upDir mygui myview = withErrorDialog $ do
cdir <- getCurrentDir myview
nv <- goUp cdir
goDir mygui myview nv
-- |Helper that is invoked for any directory change operations.
goDir :: MyGUI -> MyView -> Item -> IO ()
goDir mygui myview item = do