{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE BinaryLiterals #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveDataTypeable #-} module Phoityne.IO.GUI.GTK.BreakPointTable ( BreakPointListStore , BreakPointData(..) , BreakPointDataKey , getBreakCondition , DeleteAllBreakBTClickedEventHandler , BreakPointTableDoubleClickedHandler , setupBreakPointTable , createBreakPointListStore , addBreakPoint2Table , deleteFromBreakPointListStore , getBreakPointList , updateBreakPointTable , findBreakPointData , highLightBreakPointTableRow ) where -- モジュール import Phoityne.Constant import Phoityne.IO.GUI.GTK.Constant import Phoityne.IO.GUI.GTK.Utility -- システム import Graphics.UI.Gtk import Control.Monad.IO.Class import System.Log.Logger import qualified Data.List as L -- | -- -- data BreakPointData = BreakPointData { moduleNameBreakPointData :: String , filePathBreakPointData :: FilePath , lineNoBreakPointData :: Int , breakNoBreakPointData :: Maybe Int , conditionBreakPointData :: String } deriving (Show, Read, Eq, Ord) -- | -- -- type BreakPointTableDoubleClickedHandler = BreakPointData -> IO () -- | -- -- type BreakPointDataKey = (FilePath, Int) -- | -- -- type BreakPointListStore = ListStore BreakPointData -- | -- -- type DeleteAllBreakBTClickedEventHandler = IO () -- | -- -- createBreakPointListStore :: IO BreakPointListStore createBreakPointListStore = listStoreNew ([] :: [BreakPointData]) -- | -- -- setupBreakPointTable :: Builder -> BreakPointListStore -> BreakPointTableDoubleClickedHandler -> DeleteAllBreakBTClickedEventHandler -> IO () setupBreakPointTable builder store evh deleteEvh = do treeView <- builderGetObject builder castToTreeView _WIDGET_NAME_BREAK_POINT_TREE_VIEW _ <- treeViewSetModel treeView store col <- builderGetObject builder castToTreeViewColumn ("BreakPointCol1" :: String) renderer <- cellRendererTextNew cellLayoutPackStart col renderer True cellLayoutSetAttributes col renderer store $ \cell -> [ cellText := moduleNameBreakPointData cell -- , cellTextFont := _FONT_DESC -- , cellTextSize := 9 ] col <- builderGetObject builder castToTreeViewColumn ("BreakPointCol2" :: String) renderer <- cellRendererTextNew cellLayoutPackStart col renderer True cellLayoutSetAttributes col renderer store $ \cell -> [ cellText := filePathBreakPointData cell ] col <- builderGetObject builder castToTreeViewColumn ("BreakPointCol3" :: String) renderer <- cellRendererTextNew cellLayoutPackStart col renderer True cellLayoutSetAttributes col renderer store $ \cell -> [ cellText := show (lineNoBreakPointData cell) ] col <- builderGetObject builder castToTreeViewColumn ("BreakPointCol4" :: String) renderer <- cellRendererTextNew cellLayoutPackStart col renderer True cellLayoutSetAttributes col renderer store $ \cell -> [ cellText := conditionBreakPointData cell ] set renderer [cellTextEditable := True] _ <- on renderer edited $ breakPointsConditionEditedHandler treeView store _ <- on treeView buttonPressEvent $ breakPointTableDoubleClickedHandler treeView store evh sel <- treeViewGetSelection treeView treeSelectionSetMode sel SelectionSingle bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DELETE onToolButtonClicked bt deleteEvh widgetSetSensitive bt True widgetShowAll treeView -- | -- -- breakPointsConditionEditedHandler :: TreeView -> ListStore BreakPointData -> TreePath -> String -> IO () breakPointsConditionEditedHandler treeView listStore treePath value = do treeViewGetModel treeView >>= \case Nothing -> errorM _LOG_NAME $ "[breakPointsConditionEditedHandler]model not found." Just model -> withModel model where withModel model = treeModelGetIter model treePath >>= \case Nothing -> errorM _LOG_NAME $ "[breakPointsConditionEditedHandler]treeIter not found." Just iter -> newData iter >>= listStoreSetValue listStore (listStoreIterToIndex iter) newData iter = do dat <- listStoreGetValue listStore (listStoreIterToIndex iter) return dat{conditionBreakPointData = value} -- | -- -- breakPointTableDoubleClickedHandler :: TreeView -> ListStore BreakPointData -> BreakPointTableDoubleClickedHandler -> EventM EButton Bool breakPointTableDoubleClickedHandler self listStore evh = eventClick >>= \case DoubleClick -> liftIO $ do sel <- treeViewGetSelection self treeSelectionGetSelected sel >>= \case Nothing -> return False Just iter -> do let idx = listStoreIterToIndex iter bpDat <- listStoreGetValue listStore idx evh bpDat return False _ -> return False -- | -- -- addBreakPoint2Table :: BreakPointListStore -> BreakPointData -> IO () addBreakPoint2Table = add2ListStore -- | -- -- deleteFromBreakPointListStore :: ListStore BreakPointData -> BreakPointDataKey -> IO () deleteFromBreakPointListStore store (path, lineNo) = treeModelForeach (castToTreeModel store) deleteData where deleteData iter = do let idx = listStoreIterToIndex iter (BreakPointData _ curPath curLineNo _ _) <- listStoreGetValue store idx if (curPath == path) && (curLineNo == lineNo) then listStoreRemove store idx >> return True else return False -- | -- -- updateBreakPointTable :: ListStore BreakPointData -> BreakPointDataKey -> BreakPointData -> IO () updateBreakPointTable store (path, lineNo) newDat = do treeModelForeach (castToTreeModel store) updateData where updateData iter = do let idx = listStoreIterToIndex iter (BreakPointData _ curPath curLineNo _ _) <- listStoreGetValue store idx if (curPath == path) && (curLineNo == lineNo) then listStoreSetValue store idx newDat >> return True else return False -- | -- -- findBreakPointData :: ListStore BreakPointData -> BreakPointDataKey -> IO (Maybe BreakPointData) findBreakPointData store (path, lineNo) = do xs <- listStoreToList store return $ L.find findData xs where findData (BreakPointData _ curPath curLineNo _ _) = (curPath == path) && (curLineNo == lineNo) -- | -- -- getBreakPointList :: ListStore a -> IO [a] getBreakPointList = listStoreToList -- | -- -- highLightBreakPointTableRow :: Builder -> ListStore BreakPointData -> BreakPointDataKey -> IO () highLightBreakPointTableRow builder listStore (path, lineNo) = do treeView <- builderGetObject builder castToTreeView _WIDGET_NAME_BREAK_POINT_TREE_VIEW sel <- treeViewGetSelection treeView treeViewGetModel treeView >>= \case Nothing -> errorM _LOG_NAME $ "[highLightBreakPointTableRow]invalid highlight break point table." Just model -> treeModelForeach model $ highLight sel where highLight sel iter = do let idx = listStoreIterToIndex iter (BreakPointData _ curPath curLineNo _ _) <- listStoreGetValue listStore idx if (L.isSuffixOf path curPath) && (curLineNo == lineNo) then treeSelectionSelectIter sel iter >> return True else return False -- | -- -- getBreakCondition :: ListStore BreakPointData -> BreakPointDataKey -> IO String getBreakCondition listStore (path, lineNo) = do bps <- listStoreToList listStore case L.find go bps of Nothing -> do errorM _LOG_NAME $ "[getBreakCondition]invalid break point data. " ++ path ++ ":" ++ show lineNo return "" Just (BreakPointData _ _ _ _ condStr) -> return condStr where go (BreakPointData _ curPath curLineNo _ _) = (L.isSuffixOf curPath path) && (curLineNo == lineNo)