addfile ./DirectoryTree.hs
addfile ./DirectoryOperations.hs
hunk ./DirectoryOperations.hs 1
+{-|
+    This module exports the functionality for graphically interacting
+    with a user previous to interacting with a file. 
+        i.e. Query whether or not a user wants to delete a file.
+        
+    At the back of all the interaction methods are the functions
+    exported by 'SystemOperations', which actually carry out the actions.
+    This module is basically a graphical front ent to 'SystemOperations'.
+    
+    These actions are:
+        
+        * Move a file.
+        
+        * Move a directory.
+        
+        * Rename a file.
+        
+        * Rename a directory.
+        
+        * Copy a file.
+        
+        * Copy a directory.
+        
+        * Delete a file.
+        
+        * Delete a directory.
+        
+        * Create a file.
+        
+        * Create a directory.
+        
+        * Open a file.
+        
+        * Search a directory.
+-}
+
+module DirectoryOperations
+    ( 
+        moveFile, 
+        moveFolder, 
+        renameFile, 
+        renameFolder, 
+        copyFile, 
+        copyFolder, 
+        deleteFile, 
+        deleteFolder, 
+        createFile, 
+        createDir, 
+        openFile,
+        searchDir
+    )
+where
+
+import qualified GHC.IOBase as E
+import qualified SystemOperations as S
+import Graphics.UI.Gtk
+import List ( (\\), sort )
+import Control.Monad( filterM, forM_ )
+import System.FilePath( (</>) )
+import System.Directory ( doesFileExist, getCurrentDirectory, doesDirectoryExist )
+import System.Cmd
+import TreeFunctions
+import Util
+import Types
+import Popup
+import FileSearch
+
+{-|
+    This function takes a list of paths to files, and attempts
+    to move them to a location which will be requested from the user.
+-}
+
+moveFile :: [FilePath] -- ^ The list of files to be moved.
+         -> IO ( )
+moveFile files = operateName files S.moveFile "Move File(s)" "Please enter the destination for the selected file(s): "
+
+{-|
+    This function takes a list of directories, and attempts to
+    move them to a location which will be provided by the user.
+-}
+
+moveFolder :: [FilePath] -- ^ The list of directories to be moved.
+           -> IO ( )
+moveFolder dirs = operateName dirs S.moveDirectory "Move Folder(s)" "Please enter the destination for the selected folder(s): "
+
+{-|
+    This function takes a list of files, and attempts to
+    copy them to a location which will be provided by the user.
+-}
+
+copyFile :: [FilePath] -- ^ The list of files to be copied.
+         -> IO ( )
+copyFile files = operateName files S.copyFile "Copy File(s)" "Please enter the destination for the selected file(s): "
+
+{-|
+    This function takes a list of directories and attempts to
+    copy them to a location which will be provided by the user.
+-}
+
+copyFolder :: [FilePath] -- ^ The list of directories to be copied.
+           -> IO ( )
+copyFolder dirs = operateName dirs S.copyDirectory "Copy Folders" "Please enter the destination for the selected folder(s): "
+
+{-|
+    This function takes a list of files and attempts to
+    delete them all. The user will be queried for confirmation.
+-}
+
+deleteFile :: [FilePath] -- ^ The list of files to be deleted.
+           -> IO ( )
+deleteFile files = delete files S.deleteFile "file"
+
+{-|
+    This function takes a list of directories and attempts to
+    delete them all. The user will be queried for confirmation.
+-}
+
+deleteFolder :: [FilePath] -- ^ The list of directories to be deleted.
+             -> IO ( )
+deleteFolder dirs = delete dirs S.deleteDirectory "folder"
+
+{-|
+    This function takes a list of files and attempts to
+    rename them. The user will be queried for the new names
+    for each element of the list.
+-}
+
+renameFile :: [FilePath] -- ^ The list of files to be renamed.
+           -> IO ( )
+renameFile files = rename files S.renameFile
+
+{-|
+    This function takes a list of directories and attempts to
+    rename them. The user will be queried for the new names
+    for each element of the list.
+-}
+
+renameFolder :: [FilePath] -- ^ The list of directories to be renamed.
+             -> IO ( )
+renameFolder dirs = rename dirs S.renameDirectory
+
+{-|
+    This takes a list of items to be operated upon ( selected 
+    by the user ), and checks that lists length. If the length is
+    0, then it does nothing. For any other length i.e. >= 1, it
+    it querys the user for a result based on a supplied query. It
+    then carries out the requested operation on all the items
+    in the supplied list.
+-}
+
+operateName :: [FilePath] -- ^ The list of items to be operated upon.
+            -> ( FilePath -> FilePath -> IO E.ExitCode ) -- ^ The operation to be carried out on the list.
+            -> String -- ^ The title of the query window.
+            -> String -- ^ The query to be displayed.
+            -> IO ( )
+operateName paths func wtitle wmsg = case ( length paths ) of
+    0 -> return ( )
+    _ -> ( inputWindow wtitle wmsg ) >>= ( \r ->
+            case r of
+                "" -> return ( )
+                name -> forM_ paths $ \path -> func path name )
+
+{-|
+    This function takes a list of items ( selected by the user
+    and attempts to delete them. It the list is empty, it does nothing.
+    If there is one element in the list it asks the user if they would
+    like to delete that item. For a list containing more than 1 element
+    it asks the user if they would like to delete the amount of items.
+    When the user confirms, it will either delete the single item or 
+    iterate through the list deleting each element.
+-}
+
+delete :: [FilePath] -- ^ The list of items to be deleted.
+       -> ( FilePath -> IO E.ExitCode ) -- ^ The deleting function from 'SystemOperations'.
+       -> String -- ^ The type of item to be deleted, either \"file\" or \"folder\".
+       -> IO ( )
+delete paths func ftype = case ( length paths ) of
+    0 -> return ( )
+    1 -> ( confirmWindow ( "OK to delete" ++ ( head paths ) ++ "?" ) ) >>= ( \r ->
+            case r of
+                True -> func ( head paths ) >> return ( )
+                False -> return ( ) )
+    _ -> ( confirmWindow ( "OK to delete " ++ ( show ( length paths ) ) ++ " " ++ ftype ++ "s?" ) ) >>= ( \r ->
+            case r of
+                True -> forM_ paths $ \path -> func path
+                False -> return ( ) )
+
+{-|
+    This function takes a list of items ( selected by the user ) and attempts
+    to rename them. If the amount of items is 0, it does nothing, and for anything
+    else it iterates through the list, querying the user for new names for the item.
+-}
+
+rename :: [FilePath] -- ^ The list of items to be renamed.
+       -> ( FilePath -> FilePath -> IO E.ExitCode ) -- ^ The renaming function from 'SystemOperations'.
+       -> IO ( )
+rename paths func = case ( length paths ) of
+    0 -> return ( )
+    _ -> forM_ paths $ \p -> inputWindow "Rename" ( "Please enter " ++ p ++ "'s new name: " ) >>= ( \r ->
+            case r of
+                "" -> return ( )
+                r -> func p r >> return ( ) )
+
+{-|
+    This function takes a list of files ( selected by the user ) and attempts
+    to open them. It firstly checks the length of the the list, if it is empty
+    i.e. length = 0, it does nothing. For anything else it iterates throught the
+    list using 'openFile' from 'SystemOperations' to open the files.
+-}
+
+openFile :: [FilePath] -- ^ The list of files to be opened.
+         -> IO ( )
+openFile files = case ( length files ) of
+    0 -> return ( )
+    _ -> forM_ files $ \file -> ( ( \d -> S.openFile (d++"/"++file) ) =<< getCurrentDirectory )
+
+{-|
+    Function to request the name of the item to be created. If nothing is entered it exits.
+    If a name is entered it uses 'create' to create the item.
+-}
+
+createNew :: String -- ^ The title type to be created. Either \"File\" or \"Directory\".
+          -> String -- ^ The message type to be created. Either \"file\" or \"directory\".
+          -> String -- ^ The command to be used while creating the item. Either \"touch\" or \"mkdir\".
+          -> ( FilePath -> IO Bool ) -- ^ The function to be used to check whether or not the item exists.
+          -> ( FilePath -> IO E.ExitCode ) -- ^ The function to be used to remove the item if it already exists.
+          -> IO ( )
+createNew bt st cmd bool delf = inputWindow ( bt ++ " Name" ) ( "Please give the " ++ st ++ "'s name " ) >>= ( \n ->
+    case n of
+            "" -> return ( )
+            n -> create bt n cmd bool delf )
+
+{-|
+    Function to create a new file\/directory. It first checks to see whether the file\/directory
+    exists. If so it will alert the user and ask them if they would like to overwrite it using
+    'confirmWindow' from 'Popup'. If the user agrees, it will remove the existing
+    file\/directory and then create a new one. If the file\/directory doesn't exist then
+    it will create the file\/directory.
+-}
+
+create :: String -- ^ The type of item to be created. Either \"File\" or \"Directory\".
+       -> FilePath -- ^ The name of the file\/directory to be created.
+       -> String  -- ^ The command for creating the item. Either \"touch\" or \"mkdir\".
+       -> ( FilePath -> IO Bool ) -- ^ Function for checking whether or not the item exists.
+       -> ( FilePath -> IO E.ExitCode ) -- ^ Function for removing the item if it exists.
+       -> IO ( )
+create ftype path cmd func removeFunc = func path >>= ( \e -> case e of
+    True -> confirmWindow ( ftype ++ path ++ " exists!\nOK to overwrite?" ) >>= ( \r ->
+        case r of
+            True -> do
+                removeFunc path
+                rawSystem cmd [path] >> return ( )
+            False -> return ( ) )
+    False -> rawSystem cmd [path] >> return ( ) )
+
+{-|
+    Creates a file in the current directory and updates
+    the file 'ListStore' to reflect the addition.
+-}
+
+createFile :: ListStore StoreRow -- ^ The file 'ListStore'.
+           -> IO ( )
+createFile fileTree = do
+    createNew "File" "file" "touch" doesFileExist S.deleteFile
+    ( _, files ) <- viewDirectory =<< getCurrentDirectory
+    refreshPane files fileTree >> return ( )
+
+{-|
+    Creates a directory in the current directory and updates
+    the directory 'ListStore' to reflect the addition.
+-}
+
+createDir :: ListStore StoreRow -- ^ The directory 'ListStore'.
+          -> IO ( )
+createDir dirTree = do
+    createNew "Directory" "directory" "mkdir" doesDirectoryExist S.deleteDirectory
+    ( dirs, _ ) <- viewDirectory =<< getCurrentDirectory
+    refreshPane dirs dirTree
+
+{-|
+    This function uses 'FileSearch' to recursively search the contents
+    of a directory and it's sub-directories. It gets the search term from an
+    'Entry' and updates the 'FileBrowser' with the generated list of results.
+    It uses 'TreeFunctions' to update the list.
+-}
+
+searchDir :: Entry -- ^ The 'Entry' containing the search term.
+          -> FileBrowser -- ^ The main 'FileBrowser'.
+          -> IO ( )
+searchDir query browse = do
+    --Get search expression.
+    expression <- entryGetText query
+    cur <- getCurrentDirectory
+    --Search directory contents, recursively for the expression.
+    results <- searchDirectoryFiles cur ( "*" ++ expression )
+    --Split into files & folders.
+    files <- filterM doesFileExist results
+    dirs <- filterM doesDirectoryExist results
+    --Refresh the two TreeViews.
+    refreshPane ( sort ( map ( flip (\\) ( cur ++ "/" ) ) dirs ) ) ( dirStore browse )
+    refreshPane ( sort ( map ( flip (\\) ( cur ++ "/" ) ) files ) ) ( fileStore browse )
hunk ./DirectoryTree.hs 1
+{-|
+    Module to generate an expandible tree of directories
+    contained within the file system.
+-}
+
+module DirectoryTree 
+    (
+        addSubTree,
+        getPathAtActivation,
+        getListing,
+        expandPath
+    ) 
+where
+
+import Graphics.UI.Gtk
+import Data.Tree
+import Util
+import Popup
+import qualified Control.Exception as E
+import System.Directory ( getDirectoryContents, doesDirectoryExist )
+import System.FilePath ( (</>), splitFileName, dropTrailingPathSeparator, splitDirectories )
+import System.Posix.Files ( getSymbolicLinkStatus, isSymbolicLink, fileAccess )
+import Control.Monad ( filterM, forM, forM_ )
+import List ( isPrefixOf, sort )
+
+           
+{-|
+    Calculates a string based on where a user has activated a
+    row of a 'TreeStore'. It recursively scans through the tree path
+    getting the string at each seperate node leading up to the selected
+    node.
+-}
+
+getPathAtActivation :: TreePath -- ^ The path to the node selected at activation.
+                    -> TreeStore String  -- ^ A store of strings.
+                    -> IO String -- ^ The selected string.
+getPathAtActivation path store
+ | null ( init path ) = treeStoreGetValue store path >>= return
+ | otherwise = ( treeStoreGetValue store path ) >>= ( \l ->
+        ( getPathAtActivation ( init path ) store ) >>= ( \f ->
+        return ( "/" ++ ( reverse ( dropTrailingPathSeparator ( reverse ( f ++ l ) ) ) ) ) ) )
+
+{-|
+    Scans to the selected node, that the user has requested be expanded.
+    Once it gets there it checks to see whether or not the node already
+    contains elements. If so, it does nothing, but if it is empty it
+    adds in a sub tree containing the selected folders sub directories.
+-}
+
+addSubTree :: TreePath -- ^ The path to the node to be expanded.
+           -> TreeStore String -- ^ The 'TreeStore' containing the selected node.
+           -> IO ( )
+addSubTree path store = do
+    newtree <- getPathAtActivation path store >>= dirContents
+    tree <- treeStoreGetTree store path
+    case ( ( rootLabel ( ( subForest tree ) !! 0 ) ) == ("") ) of
+            True -> do
+                    forM_ ( reverse ( subForest newtree ) ) $ \sub -> treeStoreInsertTree store path 0 sub
+                    ( treeStoreRemove store ( path ++ [length ( subForest newtree)] ) ) >> return ( )
+            False -> return ( )
+
+{-|
+    Expands the tree to match a supplied file path, if it
+    it exist within the treeStore.
+-}
+
+expandPath :: TreeView -- ^ The treeView containing the treeStore
+           -> TreeStore String -- ^ The tree store containing the directories.
+           -> FilePath -- ^ The path to be expanded to.
+           -> IO ( )
+expandPath tree store path = do
+    treeS <- treeStoreGetTree store [0]
+    let dirs = "/" : ( map ( "/" ++ ) ( tail ( splitDirectories path ) ) )
+        paths = findPath [treeS] dirs
+    case ( length paths == length dirs ) of
+        False -> do
+                 addSubTree paths store
+                 expandPath tree store path
+        True -> do
+                    treeViewCollapseAll tree
+                    treeViewExpandToPath tree paths
+                    treeViewSetCursor tree paths Nothing
+
+{-|
+    Function to find the path to a list 
+    of 'a' contained in a Forest.
+-}
+    
+findPath :: Eq a => Forest a -- ^ Forest of data.
+         -> [a] -- ^ List containing elements to make a path.
+         -> TreePath -- ^ Resulting path to elements of [a]
+findPath [] _ = []
+findPath _ [] = []
+findPath (x:xs) (y:ys)
+ | rootLabel x == y = 0 : findPath ( subForest x ) ys
+ | otherwise = case res of
+                    [] -> []
+                    (x:[]) -> 1 + x : []
+                    (x:xs) -> 1 + x : xs
+    where res = findPath xs (y:ys)
+    
+{-|
+    Function to calculate the amount of directories
+    within a directory.
+-}
+
+subDirSize :: FilePath -- ^ The path to the directory of which size is to be calculated.
+           -> IO Int -- ^ The amount of accessible directories within the directory.
+subDirSize dir = getDirectoryContents dir >>= 
+    ( \c -> filterM doesDirectoryExist ( map ( dir </> ) ( filter ( not . isPrefixOf "." ) c ) ) ) >>= 
+    filterLinks >>= (\d -> return ( length d ) )
+
+{-|
+    Function to get the directory contents and add them to an
+    expanding Tree, with sub-directoryies added as nodes,
+    viewable on expansion. It only shows accessible folders
+    with sub-directories as expandible.
+-}
+
+dirContents :: FilePath -- ^ The path to the folder to be "treed"
+            -> IO ( Tree String ) -- ^ A tree of String type, containing nodes representing sub-directories.
+dirContents path = do
+    let (_, title) = splitFileName path
+    nodes <- ( getDirectoryContents path >>= ( \c -> 
+            filterM doesDirectoryExist ( map ( path </> ) ( filter ( not . isPrefixOf "." ) c ) ) ) ) >>= 
+            filterLinks >>= ( \dirs -> forM ( sort dirs ) $ \d -> do
+                            let (_ , dname) = splitFileName d
+                            subDirSize d >>= ( \s -> 
+                                return ( Node { rootLabel = "/" ++ dname,
+                                                 subForest = case s of
+                                                                   0 -> [] 
+                                                                   _ -> [Node { rootLabel = "",
+                                                                                subForest = [] } ] } ) ) )
+    return ( Node { rootLabel = ( "/" ++ title ),
+                    subForest = nodes } )
+
+{-|
+        Function to generate an expandible tree listing of all directories on 
+        the users machine.
+-}
+
+getListing :: IO ( TreeView, ScrolledWindow, TreeStore String ) -- ^ The 'TreeView', 'ScrolledWindow', 'TreeStore' associated with the expandible tree.
+getListing = do
+        scroll <- scrolledWindowNew Nothing Nothing
+        store <- treeStoreNew [Node { rootLabel  = "/",
+                                             subForest = [Node { rootLabel = "",
+                                                                 subForest = [] } ] }]
+        view <- treeViewNewWithModel store
+        treeViewSetHeadersVisible view True
+        col1 <- treeViewColumnNew
+        treeViewColumnSetTitle col1 "FileSystem"
+        renderer1 <- cellRendererTextNew
+        cellLayoutPackStart col1 renderer1 True 
+        cellLayoutSetAttributes col1 renderer1 store $ \row -> [ cellText := row ]
+        treeViewAppendColumn view col1
+        selection <- treeViewGetSelection view
+        treeSelectionSetMode selection SelectionSingle
+        containerAdd scroll view
+        return ( view, scroll, store )
hunk ./FileManager.cabal 10
+Stability:      Beta
+Category:       GUI
+Synopsis:       A graphical file manager implemented using Gtk2HS.
hunk ./FileManager.cabal 14
-Executable FileManager
-    Main-is:        FileManager.hs
-    Build-Depends:  base, FileManip, unix, array, containers, old-locale, old-time, filepath, directory, process, random, haskell98, mtl, glib, cairo, gtk
+Build-Depends:  
+    base, FileManip, unix, array, containers, old-locale, old-time, filepath, directory, process, random, haskell98, mtl, glib, cairo, gtk
hunk ./FileManager.cabal 17
+Data-Files:
+    Icons/*.png
+    
+Extra-Source-Files:
+    README
+
+Executable:     haskellfm
+Main-is:        FileManager.hs  
+Other-Modules:
+    Browser,
+    Buttons,
+    Components,
+    DirectoryOperations,
+    DirectoryTree,
+    FileSearch,
+    Menu,
+    Popup,
+    SystemOperations,
+    TreeFunctions,
+    TreeViewOperations,
+    Types,
+    Util
+