module IDE.Pane.Files (
IDEFiles(..)
, FilesState(..)
, getFiles
, refreshFiles
) where
import Prelude hiding (catch)
import Graphics.UI.Gtk
(scrolledWindowSetShadowType, treeSelectionSelectionChanged,
treeStoreRemove, treeModelIterNext, treeModelGetRow,
treeStoreInsert, treeModelIterNthChild, treeModelGetPath, TreeIter,
treeModelGetIter, TreePath, treeSelectionGetSelectedRows,
rowActivated, treeStoreGetValue, rowExpanded, on, after,
focusInEvent, scrolledWindowSetPolicy, containerAdd,
scrolledWindowNew, treeSelectionSetMode, treeViewGetSelection,
treeViewSetHeadersVisible, cellText, cellLayoutSetAttributes,
cellLayoutPackStart, treeViewAppendColumn,
treeViewColumnSetReorderable, treeViewColumnSetResizable,
treeViewColumnSetSizing, treeViewColumnSetTitle, treeViewColumnNew,
cellRendererPixbufNew, cellRendererTextNew, treeViewSetModel,
treeViewNew, treeStoreNew, castToWidget, TreeStore, TreeView,
ScrolledWindow, treeViewRowExpanded, treeStoreGetTree)
import Data.Maybe (isJust)
import Control.Monad (forM, void, forM_, when)
import Data.Typeable (Typeable)
import IDE.Core.State
(MessageLevel(..), ipdBuildDir, ipdPackageId, wsPackages,
workspace, readIDE, IDEAction, ideMessage, reflectIDE, reifyIDE,
IDEM, IDEPackage, ipdSandboxSources)
import IDE.Pane.SourceBuffer
(goToSourceDefinition')
import Control.Applicative ((<$>))
import System.FilePath ((</>), takeFileName, dropFileName)
import Distribution.Package (PackageIdentifier(..))
import System.Directory (doesDirectoryExist, getDirectoryContents, getPermissions, readable)
import IDE.Core.CTypes
(Location(..), packageIdentifierToString)
import Graphics.UI.Frame.Panes
(RecoverablePane(..), PanePath, RecoverablePane, Pane(..))
import Graphics.UI.Frame.ViewFrame (getNotebook)
import Graphics.UI.Editor.Basics (Connection(..))
import Graphics.UI.Gtk.General.Enums
(ShadowType(..), PolicyType(..), SelectionMode(..),
TreeViewColumnSizing(..))
import System.Glib.Attributes (AttrOp(..))
import Control.Monad.IO.Class (MonadIO(..))
import IDE.Utils.GUIUtils (__)
import Control.Exception (catch)
import Data.Text (Text)
import qualified Data.Text as T (pack)
import Data.Monoid ((<>))
import Data.List (sortBy, sort)
import Data.Ord (comparing)
import Data.Char (toLower)
import IDE.Core.Types (IDEPackage(..), IDE(..), Prefs(..))
import Data.Tree (Tree(..))
import System.Log.Logger (debugM)
data FileRecord =
FileRecord FilePath
| DirRecord FilePath
| PackageRecord IDEPackage
| PlaceHolder
deriving (Eq)
instance Ord FileRecord where
compare (DirRecord _) (FileRecord _) = LT
compare (FileRecord _) (DirRecord _) = GT
compare (FileRecord p1) (FileRecord p2) = comparing (map toLower) p1 p2
compare (DirRecord p1) (DirRecord p2) = comparing (map toLower) p1 p2
compare _ _ = LT
displayText :: FileRecord -> Text
displayText (FileRecord f) = T.pack $ takeFileName f
displayText (DirRecord f) = T.pack $ takeFileName f
displayText (PackageRecord p) = packageIdentifierToString (ipdPackageId p) <> " " <> T.pack (ipdBuildDir p)
displayText PlaceHolder = ""
data IDEFiles = IDEFiles {
scrolledView :: ScrolledWindow
, treeView :: TreeView
, fileStore :: TreeStore FileRecord
} deriving Typeable
data FilesState = FilesState
deriving(Eq,Ord,Read,Show,Typeable)
instance Pane IDEFiles IDEM where
primPaneName _ = __ "Files"
getAddedIndex _ = 0
getTopWidget = castToWidget . scrolledView
paneId b = "*Files"
instance RecoverablePane IDEFiles FilesState IDEM where
saveState p = return (Just FilesState)
recoverState pp FilesState = do
nb <- getNotebook pp
buildPane pp nb builder
builder pp nb windows = reifyIDE $ \ ideR -> do
fileStore <- treeStoreNew []
treeView <- treeViewNew
treeViewSetModel treeView fileStore
renderer1 <- cellRendererTextNew
renderer10 <- cellRendererPixbufNew
col1 <- treeViewColumnNew
treeViewColumnSetTitle col1 (__ "File")
treeViewColumnSetSizing col1 TreeViewColumnAutosize
treeViewColumnSetResizable col1 True
treeViewColumnSetReorderable col1 True
treeViewAppendColumn treeView col1
cellLayoutPackStart col1 renderer10 False
cellLayoutPackStart col1 renderer1 True
cellLayoutSetAttributes col1 renderer1 fileStore
$ \row -> [ cellText := displayText row]
treeViewSetHeadersVisible treeView False
sel <- treeViewGetSelection treeView
treeSelectionSetMode sel SelectionSingle
scrolledView <- scrolledWindowNew Nothing Nothing
scrolledWindowSetShadowType scrolledView ShadowIn
containerAdd scrolledView treeView
scrolledWindowSetPolicy scrolledView PolicyAutomatic PolicyAutomatic
let files = IDEFiles {..}
cid1 <- after treeView focusInEvent $ do
liftIO $ reflectIDE (makeActive files) ideR
return True
cid2 <- on treeView rowExpanded $ \ iter path -> do
record <- treeStoreGetValue fileStore path
reflectIDE (
case record of
DirRecord f -> refreshDir fileStore path f
PackageRecord p -> refreshPackage fileStore path p
_ -> ideMessage Normal (__ "Unexpected Expansion in Files Pane")) ideR
on treeView rowActivated $ \ path col -> do
record <- treeStoreGetValue fileStore path
reflectIDE (
case record of
FileRecord f -> void (goToSourceDefinition' f (Location "" 1 0 1 0))
DirRecord f -> refreshDir fileStore path f
PackageRecord p -> refreshPackage fileStore path p
_ -> ideMessage Normal (__ "Unexpected Activation in Files Pane")) ideR
on sel treeSelectionSelectionChanged $ do
paths <- treeSelectionGetSelectedRows sel
forM_ paths $ \ path -> do
record <- treeStoreGetValue fileStore path
reflectIDE (
case record of
FileRecord _ -> return ()
DirRecord f -> refreshDir fileStore path f
PackageRecord p -> refreshPackage fileStore path p
_ -> ideMessage Normal (__ "Unexpected Selection in Files Pane")) ideR
return (Just files,[ConnectC cid1])
getFiles :: Maybe PanePath -> IDEM IDEFiles
getFiles Nothing = forceGetPane (Right "*Files")
getFiles (Just pp) = forceGetPane (Left pp)
refreshFiles :: IDEAction
refreshFiles = do
files <- getFiles Nothing
let store = fileStore files
let view = treeView files
mbWS <- readIDE workspace
let packages = maybe [] wsPackages mbWS
setDirectories store Nothing $ map PackageRecord packages
forM_ (zip [0..] packages) $ \(n, package) ->
refreshRecursively store [n] view
dirContents :: FilePath -> IDEM [FileRecord]
dirContents dir = do
prefs <- readIDE prefs
contents <- liftIO $ getDirectoryContents dir
`catch` \ (e :: IOError) -> return []
let filtered = if showHiddenFiles prefs
then filter (`notElem` [".", ".."]) contents
else filter ((/= '.') . head) contents
records <- forM filtered $ \f -> do
let full = dir </> f
isDir <- liftIO $ doesDirectoryExist full
return $ if isDir then DirRecord full else FileRecord full
return (sort records)
refreshRecursively :: TreeStore FileRecord -> TreePath -> TreeView -> IDEAction
refreshRecursively store path view = do
isExpanded <- liftIO $ treeViewRowExpanded view path
record <- liftIO $ treeStoreGetValue store path
when isExpanded $
case record of
DirRecord dir -> do
refreshDir store path dir
nChildren <- length . subForest <$> liftIO (treeStoreGetTree store path)
forM_ [0..nChildren1] (\n -> refreshRecursively store (path ++ [n]) view)
PackageRecord package -> do
refreshPackage store path package
nChildren <- length . subForest <$> liftIO (treeStoreGetTree store path)
forM_ [0..nChildren1] (\n -> refreshRecursively store (path ++ [n]) view)
_ -> return ()
refreshPackage :: TreeStore FileRecord -> TreePath -> IDEPackage -> IDEAction
refreshPackage store path p = do
liftIO $ debugM "leksah" $ "refreshPackage " <> ipdCabalFile p
let dir = ipdBuildDir p
mbIter <- liftIO $ treeModelGetIter store path
when (isJust mbIter) $ do
contents <- dirContents dir
setDirectories store mbIter $ map PackageRecord (ipdSandboxSources p) ++ contents
refreshDir :: TreeStore FileRecord -> TreePath -> FilePath -> IDEAction
refreshDir store path dir = do
liftIO $ debugM "leksah" $ "refreshPackage " <> dir
mbIter <- liftIO $ treeModelGetIter store path
when (isJust mbIter) $ do
contents <- dirContents dir
setDirectories store mbIter contents
setDirectories :: TreeStore FileRecord -> Maybe TreeIter -> [FileRecord] -> IDEAction
setDirectories store parent records = liftIO $ do
parentPath <- case parent of
Just i -> treeModelGetPath store i
_ -> return []
forM_ (zip [0..] records) $ \(n, record) -> do
mbChild <- treeModelIterNthChild store parent n
findResult <- find record store mbChild
case (mbChild, findResult) of
(_, WhereExpected _) -> return ()
(Just iter, Found _) -> do
path <- treeModelGetPath store iter
removeUntil record store path
_ -> do
treeStoreInsert store parentPath n record
case record of
DirRecord _ -> treeStoreInsert store (parentPath++[n]) 0 PlaceHolder
PackageRecord _ -> treeStoreInsert store (parentPath++[n]) 0 PlaceHolder
_ -> return ()
removeRemaining store (parentPath++[length records])
data FindResult = WhereExpected TreeIter | Found TreeIter | NotFound
find :: Eq a => a -> TreeStore a -> Maybe TreeIter -> IO FindResult
find _ _ Nothing = return NotFound
find a store (Just iter) = do
row <- treeModelGetRow store iter
if row == a
then return $ WhereExpected iter
else treeModelIterNext store iter >>= find'
where
find' :: Maybe TreeIter -> IO FindResult
find' Nothing = return NotFound
find' (Just iter) = do
row <- treeModelGetRow store iter
if row == a
then return $ Found iter
else treeModelIterNext store iter >>= find'
removeUntil :: Eq a => a -> TreeStore a -> TreePath -> IO ()
removeUntil a store path = do
row <- treeStoreGetValue store path
when (row /= a) $ do
found <- treeStoreRemove store path
when found $ removeUntil a store path
removeRemaining :: TreeStore a -> TreePath -> IO ()
removeRemaining store path = do
found <- treeStoreRemove store path
when found $ removeRemaining store path