SearchResultTable.hs

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

module Phoityne.IO.GUI.GTK.SearchResultTable (
  SearchResultListStore
, SearchResultOffset
, SearchResultData(..)
, SearchResultTableDoubleClickedHandler
, createSearchResultListStore
, setupSearchResultTable
, addSearchReslutTable
, clearSearchResultTable
, activateSearchResultTab
, prevCurrentSearchResult
, nextCurrentSearchResult
, getCurrentSearchResult
, getSearchResultDataByFilePath
) where

-- モジュール
import Phoityne.IO.GUI.GTK.Constant
import Phoityne.Constant

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

-- |
--  
-- 
data SearchResultData = SearchResultData {
    filePathSearchResultData :: String
  , lineNoSearchResultData :: Int
  , startColSearchResultData :: Int
  , endColSearchResultData :: Int
  , lineSearchResultData :: String
  } deriving (Show, Read, Eq, Ord)


-- |
--  
-- 
type SearchResultOffset = (FilePath, Int)


-- |
--
--
type SearchResultListStore = ListStore SearchResultData


-- |
--
--
type SearchResultTableDoubleClickedHandler = SearchResultData -> IO ()


-- |
--
--
createSearchResultListStore :: IO SearchResultListStore
createSearchResultListStore = listStoreNew ([] :: [SearchResultData])


-- |
--
--
setupSearchResultTable :: Builder
                       -> SearchResultListStore
                       -> SearchResultTableDoubleClickedHandler
                       -> IO ()
setupSearchResultTable builder store evh = do

  treeView <- builderGetObject builder castToTreeView "SearchResultTreeView"

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

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

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

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

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


  _ <- on treeView buttonPressEvent $ searchResultTableDoubleClickedHandler treeView store evh

  sel <- treeViewGetSelection treeView
  treeSelectionSetMode sel SelectionSingle

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEL_SEARCH
  onToolButtonClicked bt $ delSearchBTClickedEventHandler builder store

  widgetShowAll treeView

-- |
--
--
searchResultTableDoubleClickedHandler :: TreeView -> ListStore SearchResultData -> SearchResultTableDoubleClickedHandler -> EventM EButton Bool
searchResultTableDoubleClickedHandler self listStore evh = eventClick >>= \case
  DoubleClick -> do
    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


-- |
--
--
delSearchBTClickedEventHandler :: Builder -> ListStore SearchResultData -> IO ()
delSearchBTClickedEventHandler _ store = clearSearchResultTable store

-- |
--
--
activateSearchResultTab :: Builder -> IO ()
activateSearchResultTab builder = do
  child <- builderGetObject builder castToWidget "SearchResultBox"
  note <- builderGetObject builder castToNotebook "RightSubNote"

  idx <- get note $ notebookChildPosition child
  notebookSetCurrentPage note idx

-- |
--  
-- 
addSearchReslutTable :: ListStore SearchResultData -> SearchResultData -> IO ()
addSearchReslutTable store dat = listStoreAppend store dat >> return ()

-- |
--  
-- 
clearSearchResultTable :: ListStore SearchResultData -> IO ()
clearSearchResultTable = listStoreClear

-- |
--  
-- 
prevCurrentSearchResult :: Builder -> ListStore SearchResultData -> IO ()
prevCurrentSearchResult builder store = do
  treeView <- builderGetObject builder castToTreeView "SearchResultTreeView"
  modelMay <- treeViewGetModel treeView
  prevCurrentSearchResultWithModel treeView store modelMay


-- |
--  
-- 
prevCurrentSearchResultWithModel :: TreeView -> ListStore SearchResultData -> Maybe TreeModel -> IO ()
prevCurrentSearchResultWithModel _ _ Nothing = errorM _LOG_NAME $ "[nextCurrentSearchResultWithModel] invalid search result tree view."
prevCurrentSearchResultWithModel treeView _ (Just model) = do
  sel <- treeViewGetSelection treeView
  treeSelectionGetSelected sel >>= \case
    Nothing -> treeModelGetIterEnd model >>= \case
      Nothing -> return () -- table is empty
      Just iter -> selectRow model sel iter
  
    Just iter -> treeModelIterPrev model iter >>= \case
      Nothing -> treeModelGetIterEnd model >>= \case
        Nothing -> return ()  -- table is empty
        Just iter -> selectRow model sel iter
      Just iter -> selectRow model sel iter

  where
    selectRow model sel iter = do      
      treeSelectionSelectIter sel iter
      treePath <- treeModelGetPath model iter
      treeViewScrollToCell treeView (Just treePath) Nothing Nothing

-- |
--  
-- 
treeModelIterPrev :: TreeModel -> TreeIter -> IO (Maybe TreeIter)
treeModelIterPrev model iter = treeModelGetPath model iter >>= \case
  [] -> return Nothing
  xs -> if 0 == head xs then return Nothing
          else treeModelIterNthChild model Nothing $ (head xs) - 1

-- |
--  
-- 
treeModelGetIterEnd :: TreeModel -> IO (Maybe TreeIter)
treeModelGetIterEnd model = do
  count <- treeModelIterNChildren model Nothing
  treeModelIterNthChild model Nothing $ count - 1



-- |
--  
-- 
nextCurrentSearchResult :: Builder -> ListStore SearchResultData -> Maybe SearchResultOffset -> IO ()
nextCurrentSearchResult builder store offset = do
  treeView <- builderGetObject builder castToTreeView "SearchResultTreeView"
  modelMay <- treeViewGetModel treeView
  nextCurrentSearchResultWithModel treeView store modelMay offset


-- |
--  
-- 
nextCurrentSearchResultWithModel :: TreeView -> ListStore SearchResultData -> Maybe TreeModel -> Maybe SearchResultOffset -> IO ()
nextCurrentSearchResultWithModel _ _ Nothing _ = errorM _LOG_NAME $ "[nextCurrentSearchResultWithModel] invalid search result tree view."
nextCurrentSearchResultWithModel treeView store (Just model) (Just (path, lineNo))= do
  sel <- treeViewGetSelection treeView
  treeModelGetIterFirst model >>= \case
    Nothing -> return ()
    Just firstIter -> findIter firstIter >>= \case
      Nothing -> treeSelectionSelectIter sel firstIter
      Just curIter -> do
        treeSelectionSelectIter sel curIter
        treePath <- treeModelGetPath model curIter
        treeViewScrollToCell treeView (Just treePath) Nothing Nothing
        
  where
    findIter iter = do
      (SearchResultData pathSR lineNoSR _ _ _) <- listStoreGetValue store (listStoreIterToIndex iter)
      if (path == pathSR) && (lineNo <= lineNoSR) then return (Just iter)
        else treeModelIterNext model iter >>= \case
          Nothing -> return Nothing
          Just nextIter -> findIter nextIter

nextCurrentSearchResultWithModel treeView _ (Just model) Nothing = do
  sel <- treeViewGetSelection treeView
  treeSelectionGetSelected sel >>= \case
    Nothing -> treeModelGetIterFirst model >>= \case
      Nothing -> return ()
      Just firstIter -> treeSelectionSelectIter sel firstIter

    Just iter -> do
      treeModelIterNext model iter >>= \case
        Nothing -> treeModelGetIterFirst model >>= \case
          Nothing -> return ()
          Just firstIter -> treeSelectionSelectIter sel firstIter
        Just nextIter -> do
          treeSelectionSelectIter sel nextIter
          treePath <- treeModelGetPath model nextIter
          treeViewScrollToCell treeView (Just treePath) Nothing Nothing

-- |
--  
-- 
getCurrentSearchResult :: Builder -> ListStore SearchResultData -> IO (Maybe SearchResultData)
getCurrentSearchResult builder store = do
  getCurrentSearchResultIter builder store >>= \case
    Nothing -> return Nothing
    Just iter -> Just <$> listStoreGetValue store (listStoreIterToIndex iter)

-- |
--  
-- 
getCurrentSearchResultIter :: Builder -> ListStore SearchResultData -> IO (Maybe TreeIter)
getCurrentSearchResultIter builder store = do
  treeView <- builderGetObject builder castToTreeView "SearchResultTreeView"
  modelMay <- treeViewGetModel treeView
  getCurrentSearchResultIterWithModel treeView store modelMay

-- |
--  
-- 
getCurrentSearchResultIterWithModel :: TreeView -> ListStore SearchResultData -> Maybe TreeModel -> IO (Maybe TreeIter)
getCurrentSearchResultIterWithModel  _ _ Nothing = do
  errorM _LOG_NAME $ "[getCurrentSearchResultIterWithModel] invalid search result tree view."
  return Nothing
getCurrentSearchResultIterWithModel treeView _ (Just model) = do
  sel <- treeViewGetSelection treeView
  treeSelectionGetSelected sel >>= \case
    Just iter -> return $ Just iter
    Nothing   -> treeModelGetIterFirst model >>= \case
      Nothing -> return Nothing
      Just firstIter -> do
        treeSelectionSelectIter sel firstIter
        return $ Just firstIter


-- |
--
--
getSearchResultDataByFilePath :: SearchResultListStore -> FilePath -> IO [SearchResultData]
getSearchResultDataByFilePath store path = do
  datas <- listStoreToList store
  return $ filter ((path ==) . filePathSearchResultData) datas