Breakpoints.hs

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
--
-- Module      :  IDE.Pane.Breakpoints
-- Copyright   :  2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie
-- License     :  GPL
--
-- Maintainer  :  maintainer@leksah.org
-- Stability   :  provisional
-- Portability :
--
-- | A pane to display the set breakpoints
--
-----------------------------------------------------------------------------

module IDE.Pane.Breakpoints (
    IDEBreakpoints
,   BreakpointsState
,   showBreakpoints
,   fillBreakpointList
,   selectBreak
) where

import Prelude ()
import Prelude.Compat
import Data.Typeable (Typeable(..))
import IDE.Core.State
import IDE.Debug
    (debugShowBreakpoints,
     debugDeleteBreakpoint,
     debugDeleteAllBreakpoints)
import IDE.LogRef (showSourceSpan)
import Data.List (elemIndex)
import Control.Monad.IO.Class (MonadIO(..))
import IDE.Utils.GUIUtils (treeViewContextMenu, __)
import qualified Data.Text as T (words, unpack)
import qualified Data.Foldable as F (toList)
import qualified Data.Sequence as Seq (elemIndexL)
import GI.Gtk.Objects.ScrolledWindow
       (scrolledWindowSetPolicy, scrolledWindowSetShadowType,
        scrolledWindowNew, ScrolledWindow(..))
import GI.Gtk.Objects.TreeView
       (onTreeViewRowActivated, treeViewGetSelection,
        treeViewSetHeadersVisible, treeViewAppendColumn, treeViewSetModel,
        treeViewNew, TreeView(..))
import Data.GI.Gtk.ModelView.ForestStore
       (forestStoreGetValue, ForestStore(..),
        forestStoreInsert, forestStoreClear, forestStoreNew)
import GI.Gtk.Objects.Widget (afterWidgetFocusInEvent, toWidget)
import GI.Gtk.Objects.CellRendererText
       (setCellRendererTextText, cellRendererTextNew)
import GI.Gtk.Objects.TreeViewColumn
       (TreeViewColumn(..), treeViewColumnSetReorderable,
        treeViewColumnSetResizable, treeViewColumnSetSizing,
        treeViewColumnSetTitle, treeViewColumnNew)
import GI.Gtk.Enums
       (PolicyType(..), ShadowType(..), SelectionMode(..),
        TreeViewColumnSizing(..))
import GI.Gtk.Interfaces.CellLayout (cellLayoutPackStart)
import Data.GI.Gtk.ModelView.CellLayout
       (cellLayoutSetDataFunction)
import GI.Gtk.Objects.TreeSelection
       (treeSelectionSelectPath, treeSelectionUnselectAll,
        treeSelectionSetMode)
import GI.Gtk.Objects.Adjustment (noAdjustment)
import GI.Gtk.Objects.Container (containerAdd)
import GI.Gtk.Objects.Menu (Menu(..))
import GI.Gtk.Objects.SeparatorMenuItem (separatorMenuItemNew, SeparatorMenuItem(..))
import GI.Gtk.Objects.MenuShell (menuShellAppend)
import GI.Gtk.Structs.TreePath
       (TreePath(..))
import Control.Monad.Reader (MonadReader(..))
import GI.Gtk.Objects.MenuItem
       (toMenuItem, onMenuItemActivate, menuItemNewWithLabel)
import Data.GI.Gtk.ModelView.Types
       (treeSelectionGetSelectedRows', treePathNewFromIndices')


-- | Represents the Breakpoints pane
data IDEBreakpoints    =   IDEBreakpoints {
    scrolledView    ::   ScrolledWindow
,   treeView        ::   TreeView
,   breakpoints     ::   ForestStore LogRef
} deriving Typeable


-- | The additional state used when recovering the pane
data BreakpointsState  =   BreakpointsState
    deriving(Eq,Ord,Read,Show,Typeable)


instance Pane IDEBreakpoints IDEM
    where
    primPaneName _  =   __ "Breakpoints"
    getAddedIndex _ =   0
    getTopWidget    =   liftIO . toWidget . scrolledView
    paneId b        =   "*Breakpoints"


instance RecoverablePane IDEBreakpoints BreakpointsState IDEM where
    saveState p     =   return (Just BreakpointsState)
    recoverState pp BreakpointsState =   do
        nb      <-  getNotebook pp
        buildPane pp nb builder
    builder pp nb windows = do
        ideR <- ask
        breakpoints <-  forestStoreNew []
        treeView    <-  treeViewNew
        treeViewSetModel treeView (Just breakpoints)

        rendererA    <- cellRendererTextNew
        colA         <- treeViewColumnNew
        treeViewColumnSetTitle colA (__ "Location")
        treeViewColumnSetSizing colA TreeViewColumnSizingAutosize
        treeViewColumnSetResizable colA True
        treeViewColumnSetReorderable colA True
        treeViewAppendColumn treeView colA
        cellLayoutPackStart colA rendererA False
        cellLayoutSetDataFunction colA rendererA breakpoints
            $ \row -> setCellRendererTextText rendererA $ showSourceSpan row

        rendererB    <- cellRendererTextNew
        colB         <- treeViewColumnNew
        treeViewColumnSetTitle colB (__ "Breakpoints")
        treeViewColumnSetSizing colB TreeViewColumnSizingAutosize
        treeViewColumnSetResizable colB True
        treeViewColumnSetReorderable colB True
        treeViewAppendColumn treeView colB
        cellLayoutPackStart colB rendererB False
        cellLayoutSetDataFunction colB rendererB breakpoints
            $ setCellRendererTextText rendererB . refDescription

        treeViewSetHeadersVisible treeView True
        selB <- treeViewGetSelection treeView
        treeSelectionSetMode selB SelectionModeSingle
        scrolledView <- scrolledWindowNew noAdjustment noAdjustment
        scrolledWindowSetShadowType scrolledView ShadowTypeIn
        containerAdd scrolledView treeView
        scrolledWindowSetPolicy scrolledView PolicyTypeAutomatic PolicyTypeAutomatic
        let pane = IDEBreakpoints scrolledView treeView breakpoints
        cid1 <- onIDE afterWidgetFocusInEvent treeView $ do
            liftIDE $ makeActive pane
            return True
        cids2 <- treeViewContextMenu treeView $ breakpointsContextMenu ideR breakpoints treeView
        cid4 <- ConnectC treeView <$> onTreeViewRowActivated treeView (breakpointsSelect ideR breakpoints)
        return (Just pane, [cid1, cid4] ++ cids2)


-- | Get the Breakpoints pane
getBreakpoints :: IDEM IDEBreakpoints
getBreakpoints = forceGetPane (Right "*Breakpoints")


-- | Display the Breakpoints pane
showBreakpoints :: IDEAction
showBreakpoints = do
    pane <- getBreakpoints
    displayPane pane False


-- | Fill the pane with the breakpoint 'LogRef's from the IDE state
fillBreakpointList :: IDEAction
fillBreakpointList = do
    mbBreakpoints <- getPane
    case mbBreakpoints of
        Nothing -> return ()
        Just b  -> do
            refs <- readIDE breakpointRefs
            forestStoreClear (breakpoints b)
            emptyPath <- treePathNewFromIndices' []
            mapM_ (\ (lr,index) -> forestStoreInsert (breakpoints b) emptyPath index lr)
                (zip (F.toList refs) [0..])


-- | Try to get the currently selected breakpoint
getSelectedBreakpoint ::  TreeView
    -> ForestStore LogRef
    -> IO (Maybe LogRef)
getSelectedBreakpoint treeView forestStore = do
    treeSelection   <-  treeViewGetSelection treeView
    paths           <-  treeSelectionGetSelectedRows' treeSelection
    case paths of
        a:r ->  do
            val     <-  forestStoreGetValue forestStore a
            return (Just val)
        _  ->  return Nothing


-- | Select a specific 'LogRef' or none at all
selectBreak :: Maybe LogRef  -- If @Nothing@, no breakpoints are selected
            -> IDEAction
selectBreak mbLogRef = do
    breakRefs' <- readIDE breakpointRefs
    breaks     <- forceGetPane (Right "*Breakpoints")
    selection <- treeViewGetSelection (treeView breaks)
    case mbLogRef of
        Nothing -> treeSelectionUnselectAll selection
        Just lr -> case lr `Seq.elemIndexL` breakRefs' of
                    Nothing  -> return ()
                    Just ind -> treeSelectionSelectPath selection =<< treePathNewFromIndices' [fromIntegral ind]


-- | Constructs the context menu for the breakpoint
breakpointsContextMenu :: IDERef
                       -> ForestStore LogRef
                       -> TreeView
                       -> Menu
                       -> IO ()
breakpointsContextMenu ideR store treeView theMenu = do
    item1 <- menuItemNewWithLabel (__ "Remove breakpoint")
    onMenuItemActivate item1 $ do
        sel <- getSelectedBreakpoint treeView store
        case sel of
            Just ref  -> reflectIDE (deleteBreakpoint ref) ideR
            otherwise -> sysMessage Normal (__ "Debugger>> breakpointViewPopup: no selection2")
    sep1 <- separatorMenuItemNew >>= liftIO . toMenuItem
    item2 <- menuItemNewWithLabel (__ "Remove all breakpoints")
    onMenuItemActivate item2 $ reflectIDE debugDeleteAllBreakpoints ideR
    item3 <- menuItemNewWithLabel (__ "Update")
    onMenuItemActivate item3 $ reflectIDE debugShowBreakpoints ideR
    mapM_ (menuShellAppend theMenu) [item1, sep1, item2, item3]


-- | Set the current breakpoint to a specific entry
--   pointed to by the supplied 'TreePath'
breakpointsSelect :: IDERef
                  -> ForestStore LogRef
                  -> TreePath
                  -> TreeViewColumn
                  -> IO ()
breakpointsSelect ideR store path _ = do
    ref <- forestStoreGetValue store path
    reflectIDE (setCurrentBreak (Just ref)) ideR


-- | Remove a breakpoint from the pane
deleteBreakpoint :: LogRef -> IDEAction
deleteBreakpoint logRef =
    case logRefType logRef of
        BreakpointRef -> debugDeleteBreakpoint (T.words (refDescription logRef) !! 1) logRef
        _   -> sysMessage Normal (__ "Debugger>>deleteBreakpoint: Not a breakpoint")