module IDE.Pane.Workspace (
WorkspaceState(..)
, IDEWorkspace
, updateWorkspace
, getWorkspace
, showWorkspace
) where
import Graphics.UI.Gtk hiding (get)
import Graphics.UI.Gtk.Gdk.EventM
import Data.Maybe
import Data.Typeable
import IDE.Core.State
import IDE.Workspaces
import qualified Data.Map as Map (empty)
import Data.List (sortBy)
import IDE.Pane.Files (refreshFiles)
import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO(..))
import IDE.Utils.GUIUtils (treeViewContextMenu, __)
import System.Glib.Properties (newAttrFromMaybeStringProperty)
import Data.Tree (Tree(..))
import System.Log.Logger (debugM)
import qualified Data.Function as F (on)
import System.FilePath (takeDirectory, takeBaseName, takeFileName)
import Data.Text (Text)
import qualified Data.Text as T (pack)
type WorkspaceRecord = (IDEPackage, Maybe Text)
data IDEWorkspace = IDEWorkspace {
scrolledView :: ScrolledWindow
, treeViewC :: TreeView
, workspaceStore :: TreeStore (Bool, WorkspaceRecord)
, topBox :: VBox
} deriving Typeable
instance Pane IDEWorkspace IDEM
where
primPaneName _ = __ "Workspace"
getAddedIndex _ = 0
getTopWidget = castToWidget . topBox
paneId b = "*Workspace"
data WorkspaceState = WorkspaceState
deriving(Eq,Ord,Read,Show,Typeable)
instance RecoverablePane IDEWorkspace WorkspaceState IDEM where
saveState p = return (Just WorkspaceState)
recoverState pp WorkspaceState = do
nb <- getNotebook pp
buildPane pp nb builder
buildPane pp nb builder = do
res <- buildThisPane pp nb builder
when (isJust res) $ updateWorkspace True False
return res
builder pp nb windows = reifyIDE $ \ideR -> do
treeStore <- treeStoreNew []
treeView <- treeViewNew
treeViewSetModel treeView treeStore
renderer0 <- cellRendererPixbufNew
set renderer0 [ newAttrFromMaybeStringProperty "stock-id" := (Nothing :: Maybe Text) ]
renderer1 <- cellRendererTextNew
col1 <- treeViewColumnNew
treeViewColumnSetTitle col1 (__ "Package")
treeViewColumnSetSizing col1 TreeViewColumnAutosize
treeViewColumnSetResizable col1 True
treeViewColumnSetReorderable col1 True
treeViewAppendColumn treeView col1
cellLayoutPackStart col1 renderer0 False
cellLayoutPackStart col1 renderer1 True
cellLayoutSetAttributes col1 renderer0 treeStore
$ \row -> [newAttrFromMaybeStringProperty "stock-id" :=
if fst row
then Just stockYes
else Nothing]
cellLayoutSetAttributes col1 renderer1 treeStore
$ \row -> [ cellText := name row ]
renderer2 <- cellRendererTextNew
col2 <- treeViewColumnNew
treeViewColumnSetTitle col2 (__ "File path")
treeViewColumnSetSizing col2 TreeViewColumnAutosize
treeViewColumnSetResizable col2 True
treeViewColumnSetReorderable col2 True
treeViewAppendColumn treeView col2
cellLayoutPackStart col2 renderer2 True
cellLayoutSetAttributes col2 renderer2 treeStore
$ \row -> [ cellText := T.pack $ file row ]
treeViewSetHeadersVisible treeView True
sel <- treeViewGetSelection treeView
treeSelectionSetMode sel SelectionSingle
sw <- scrolledWindowNew Nothing Nothing
scrolledWindowSetShadowType sw ShadowIn
containerAdd sw treeView
scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic
box <- vBoxNew False 2
boxPackEnd box sw PackGrow 0
let workspacePane = IDEWorkspace sw treeView treeStore box
widgetShowAll box
cid1 <- treeView `after` focusInEvent $ do
liftIO $ reflectIDE (makeActive workspacePane) ideR
return True
(cid2, cid3) <- treeViewContextMenu treeView $ workspaceContextMenu ideR workspacePane
cid4 <- treeView `on` rowActivated $ workspaceSelect ideR workspacePane
return (Just workspacePane, map ConnectC [cid1, cid2, cid3, cid4])
where
name (_, (_, Just exe)) = exe
name (_, (pack, Nothing)) = packageIdentifierToString $ ipdPackageId pack
file (_, (_, Just _)) = ""
file (_, (pack, _)) = ipdCabalFile pack
getWorkspace :: Maybe PanePath -> IDEM IDEWorkspace
getWorkspace Nothing = forceGetPane (Right "*Workspace")
getWorkspace (Just pp) = forceGetPane (Left pp)
showWorkspace :: IDEAction
showWorkspace = do
l <- getWorkspace Nothing
displayPane l False
getSelectionTree :: TreeView
-> TreeStore (Bool, WorkspaceRecord)
-> IO (Maybe (Bool, IDEPackage, Maybe Text))
getSelectionTree treeView treeStore = do
liftIO $ debugM "leksah" "getSelectionTree"
treeSelection <- treeViewGetSelection treeView
rows <- treeSelectionGetSelectedRows treeSelection
case rows of
[path] -> do
val <- treeStoreGetValue treeStore path
case val of
(active, (p, exe)) -> return $ Just (active, p, exe)
_ -> return Nothing
workspaceContextMenu :: IDERef
-> IDEWorkspace
-> Menu
-> IO ()
workspaceContextMenu ideR workspacePane theMenu = do
item1 <- menuItemNewWithLabel (__ "Activate Package")
item2 <- menuItemNewWithLabel (__ "Add Package")
item3 <- menuItemNewWithLabel (__ "Remove Package")
item1 `on` menuItemActivate $ do
sel <- getSelectionTree (treeViewC workspacePane)
(workspaceStore workspacePane)
case sel of
Just (_, ideP,mbExe) -> reflectIDE (workspaceTry $ workspaceActivatePackage ideP mbExe) ideR
otherwise -> return ()
item2 `on` menuItemActivate $ reflectIDE (workspaceTry workspaceAddPackage) ideR
item3 `on` menuItemActivate $ do
sel <- getSelectionTree (treeViewC workspacePane)
(workspaceStore workspacePane)
case sel of
Just (_,ideP,_) -> reflectIDE (workspaceTry $ workspaceRemovePackage ideP) ideR
otherwise -> return ()
menuShellAppend theMenu item1
menuShellAppend theMenu item2
menuShellAppend theMenu item3
workspaceSelect :: IDERef
-> IDEWorkspace
-> TreePath
-> TreeViewColumn
-> IO ()
workspaceSelect ideR workspacePane path _ = do
liftIO $ debugM "leksah" "workspaceSelect"
(_,(ideP,mbExe)) <- treeStoreGetValue (workspaceStore workspacePane) path
reflectIDE (workspaceTry $ workspaceActivatePackage ideP mbExe) ideR
updateWorkspace :: Bool -> Bool -> IDEAction
updateWorkspace showPane updateFileCache = do
liftIO $ debugM "leksah" "updateWorkspace"
mbWs <- readIDE workspace
when updateFileCache $ modifyIDE_ (\ide -> ide{bufferProjCache = Map.empty})
mbMod <- getPane
case mbWs of
Nothing -> do
case mbMod of
Nothing -> return ()
Just (p :: IDEWorkspace) -> do
liftIO $ treeStoreClear (workspaceStore p)
when showPane $ displayPane p False
refreshFiles
Just ws -> do
case mbMod of
Nothing -> return ()
Just (p :: IDEWorkspace) -> do
liftIO $ treeStoreClear (workspaceStore p)
let sorted = sortBy (compare `F.on` ipdPackageId) $ wsPackages ws
forest = map (\ ideP -> Node (
Just (ipdCabalFile ideP) == wsActivePackFile ws,
(ideP, Nothing))
(map (\ pack -> Node (False, (pack, Nothing)) []) (ipdSandboxSources ideP) ++
map (\ test -> Node (
Just (ipdCabalFile ideP) == wsActivePackFile ws &&
Just test == wsActiveExe ws, (ideP, Just test)) [])
(ipdExes ideP ++ ipdTests ideP ++ ipdBenchmarks ideP)))
sorted
liftIO $ treeStoreInsertForest (workspaceStore p) [] 0 forest
when showPane $ displayPane p False
refreshFiles