TraceTable.hs

{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE MultiWayIf          #-}
{-# LANGUAGE BinaryLiterals      #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveDataTypeable  #-}

module Phoityne.IO.GUI.GTK.TraceTable (
  TraceData(..)
, TraceDataListStore
, TraceTableDoubleClickedHandler
, createTraceDataListStore
, setupTraceTable
, updateTraceTable
) where

-- モジュール

-- システム
import Graphics.UI.Gtk
import Control.Monad.IO.Class

-- |
--  
-- 
data TraceData = TraceData {
    traceIdTraceData  :: String
  , functionTraceData :: String
  , filePathTraceData :: String
  } deriving (Show, Read, Eq, Ord)

-- |
--  
-- 
type TraceDataListStore  = ListStore TraceData

-- |
--
--
type TraceTableDoubleClickedHandler = TraceData -> IO ()


-- |
--
--
createTraceDataListStore :: IO TraceDataListStore
createTraceDataListStore = listStoreNew ([] :: [TraceData])


-- |
--
--
setupTraceTable :: Builder -> TraceDataListStore  -> TraceTableDoubleClickedHandler -> IO ()
setupTraceTable builder store evh = do

  treeView <- builderGetObject builder castToTreeView "TraceTreeView"

  col <- builderGetObject builder castToTreeViewColumn ("TraceCol1" :: String)
  renderer <- cellRendererTextNew
  cellLayoutPackStart col renderer True
  cellLayoutSetAttributes col renderer store $ \cell -> 
    [ cellText := traceIdTraceData cell
    ]
  _ <- treeViewSetModel treeView store

  col <- builderGetObject builder castToTreeViewColumn ("TraceCol2" :: String)
  renderer <- cellRendererTextNew
  cellLayoutPackStart col renderer True
  cellLayoutSetAttributes col renderer store $ \cell -> 
    [ cellText := functionTraceData cell
    ]
  _ <- treeViewSetModel treeView store

  col <- builderGetObject builder castToTreeViewColumn ("TraceCol3" :: String)
  renderer <- cellRendererTextNew
  cellLayoutPackStart col renderer True
  cellLayoutSetAttributes col renderer store $ \cell -> 
    [ cellText := filePathTraceData cell
    ]
  _ <- treeViewSetModel treeView store

  _ <- on treeView buttonPressEvent $ traceTableDoubleClickedHandler treeView store evh

  sel <- treeViewGetSelection treeView
  treeSelectionSetMode sel SelectionSingle

  widgetShowAll treeView


-- |
--
--
traceTableDoubleClickedHandler :: TreeView -> ListStore TraceData -> TraceTableDoubleClickedHandler -> EventM EButton Bool
traceTableDoubleClickedHandler 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


-- |
--  
-- 
updateTraceTable :: ListStore TraceData -> [TraceData] -> IO ()
updateTraceTable store dats= do
  listStoreClear store
  mapM_ (listStoreAppend store) dats