Interface.hs

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

module Phoityne.IO.GUI.GTK.Interface (
  module Phoityne.IO.GUI.GTK.ConsoleView
, module Phoityne.IO.GUI.GTK.BindingTable
, module Phoityne.IO.GUI.GTK.BreakPointTable 
, module Phoityne.IO.GUI.GTK.TextEditor
, module Phoityne.IO.GUI.GTK.TraceTable
, module Phoityne.IO.GUI.GTK.FolderTree
, module Phoityne.IO.GUI.GTK.SearchResultTable

-- Main
, WidgetStore
, MainWindowCloseEventHandler
, MainWindowKeyPressEventHandler
, CallbackHandlerId
, getBuilder
, start
, setupMainWindow
, addCallback
, delCallback
, putStrStatusBar

-- ToolButton
, DebugStartBTClickedEventHandler
, DebugStopBTClickedEventHandler
, StepOverBTClickedEventHandler
, StepInBTClickedEventHandler
, BuildBTClickedEventHandler
, SaveBTClickedEventHandler
, IndentBTClickedEventHandler
, UnIndentBTClickedEventHandler
, CommentBTClickedEventHandler
, UnCommentBTClickedEventHandler
, setupToolButton
, changeTBsOnGHCiStartting
, changeTBsOnGHCiStarted
, changeTBsOnGHCiStopped
, changeTBsOnDebugStarted
, changeTBsOnDebugStopped
, changeTBsOnBuildStart
, changeTBsOnBuildFinish
, isDebugStart
, isBuildStart
, isGHCiStarted

-- Dialog
, getNameByFolderTreeDialog
, getSearchKeyBySearchDialog
, getSearchKeyFromSearchDialog
, getReplaceByReplaceDialog
, initSearchDialog
, initReplaceDialog
) where

-- モジュール
import Phoityne.IO.GUI.GTK.Constant
import Phoityne.IO.GUI.GTK.BreakPointTable
import Phoityne.IO.GUI.GTK.TextEditor
import Phoityne.IO.GUI.GTK.BindingTable
import Phoityne.IO.GUI.GTK.TraceTable
import Phoityne.IO.GUI.GTK.FolderTree
import Phoityne.IO.GUI.GTK.SearchResultTable
import Phoityne.IO.GUI.GTK.ConsoleView

-- システム
import Paths_phoityne
import Data.Maybe
import Control.Monad.IO.Class
import Graphics.UI.Gtk
import qualified Data.Text as T

-- |
--
--
type WidgetStore = Builder

type DebugStartBTClickedEventHandler = IO ()

type DebugStopBTClickedEventHandler = IO ()

type StepOverBTClickedEventHandler = IO ()

type StepInBTClickedEventHandler = IO ()

type ContinueBTClickedEventHandler = IO ()

type BuildBTClickedEventHandler = IO ()

type SaveBTClickedEventHandler = IO ()

type IndentBTClickedEventHandler = IO ()

type UnIndentBTClickedEventHandler = IO ()

type CommentBTClickedEventHandler = IO ()

type UnCommentBTClickedEventHandler = IO ()

type StartGHCiBTClickedEventHandler = IO ()

type StopGHCiBTClickedEventHandler = IO ()

-- |
--
--
type CallbackHandlerId = HandlerId



-- |=====================================================================
--  Main
--

-- |
--   priorityHighIdle
--   priorityDefaultIdle
--
addCallback :: IO Bool -> IO CallbackHandlerId
addCallback f = idleAdd f priorityDefaultIdle


-- |
--
--
delCallback :: CallbackHandlerId -> IO ()
delCallback = idleRemove 


-- |
--
--
getGladeFile :: IO String
getGladeFile = getDataFileName _GLADE_FILE


-- |
--
--
getBuilder :: IO Builder
getBuilder = do
  initGUI

  builder <- builderNew
  gfile   <- getGladeFile
  builderAddFromFile builder gfile

  return builder


-- |
--
--
start :: Builder -> IO ()
start builder = do
  window <- builderGetObject builder castToWindow _WINDOW_NAME
  widgetShowAll window
  mainGUI


-- |
--
--
type MainWindowCloseEventHandler = IO ()
type MainWindowKeyPressEventHandler = String -> Bool -> Bool -> IO Bool

-- |
--
--
setupMainWindow :: Builder
                -> String
                -> MainWindowCloseEventHandler
                -> MainWindowKeyPressEventHandler
                -> IO ()
setupMainWindow builder title closeEvt keyEvt = do

  settings <- fromJust <$> settingsGetDefault
  settingsSetStringProperty settings "gtk-font-name" _FONT_DESC ""
  settingsSetStringProperty settings "gtk-menu-bar-accel" "" ""

  window <- builderGetObject builder castToWindow _WINDOW_NAME

  set window [windowTitle := title]

  on window deleteEvent   $ mainWindowCloseEventHandler window closeEvt
  on window keyPressEvent $ mainWindowKeyPressEventHandler window keyEvt

  mainPaned <- builderGetObject builder castToPaned _NAME_MAIN_PANED
  panedSetPosition mainPaned 200

  codePaned <- builderGetObject builder castToPaned _NAME_CODE_PANED
  panedSetPosition codePaned 350

  note <- builderGetObject builder castToNotebook _NAME_CODE_NOTE
  on note switchPage $ switchPageEventHandler note builder

  return ()

-- |
--  Event Handler
--
mainWindowCloseEventHandler :: Window -> MainWindowCloseEventHandler -> EventM EAny Bool
mainWindowCloseEventHandler self proc = liftIO $ do
  proc
  widgetDestroy self
  mainQuit

  return True


-- |
--  Event Handler
--
mainWindowKeyPressEventHandler :: Window -> MainWindowKeyPressEventHandler -> EventM EKey Bool
mainWindowKeyPressEventHandler _ evh = do
  name <- eventKeyName
  mods <- eventModifier

  liftIO $ evh (T.unpack name) (elem Shift mods) (elem Control mods)

-- |
--
--
isGHCiStarted :: Builder -> IO Bool
isGHCiStarted builder = do
  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STOP_GHCI
  widgetGetSensitive bt

-- |
--
--
isDebugStart :: Builder -> IO Bool
isDebugStart builder = do
  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_STOP
  widgetGetSensitive bt

-- |
--
--
isBuildStart :: Builder -> IO Bool
isBuildStart builder = do
  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_BUILD
  isBuild <- widgetGetSensitive bt

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STOP_GHCI
  isGHCiStop <- widgetGetSensitive bt

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_START_GHCI
  isGHCiStart <- widgetGetSensitive bt

  return $ (False == isBuild) && (True == isGHCiStop) && (False == isGHCiStart)

-- |
--
--
switchPageEventHandler :: Notebook -> Builder -> Int -> IO ()
switchPageEventHandler note builder pageId = do
  path <- notebookGetNthPage note pageId >>= \case
    Nothing -> return "[ERROR] text editor not found."
    Just child -> notebookGetMenuLabelText note child >>= \case
      Nothing -> return "[ERROR] text editor not found."
      Just a  -> return a    
  
  putStrStatusBar builder path


-- |
--
--
putStrStatusBar :: Builder -> String -> IO ()
putStrStatusBar builder msg = do
  bar <- builderGetObject builder castToStatusbar _NAME_STATUS_BAR
  contId <- statusbarGetContextId bar _STATUS_BAR_CONTEXT_ID
  statusbarRemoveAll bar (fromIntegral (toInteger contId))
  statusbarPush bar contId msg
  return ()


-- |=====================================================================
--  Dialog 
--

-- |
--
--
getNameByFolderTreeDialog :: Builder -> String -> String -> String -> Bool -> IO (Maybe String)
getNameByFolderTreeDialog builder title msg value isEnabled = do
  dialog <- builderGetObject builder castToDialog "TreeFolderCreateFolderDialog"
  entry  <- builderGetObject builder castToEntry "TreeFolderCreateFolderEntry"
  label  <- builderGetObject builder castToLabel "TreeFolderCreateFolderLabel"

  entrySetText entry value
  set dialog [windowTitle := title]
  set entry [entryEditable := isEnabled]

  if isEnabled then widgetShowAll entry else widgetHide entry

  labelSetText label msg

  res <- dialogRun dialog >>= \case
    ResponseUser 0 -> do
                      name <- entryGetText entry
                      return $ if null name then Nothing else Just name
    _              -> return Nothing

  widgetHide dialog

  return res


-- |
--
--
getSearchKeyBySearchDialog :: Builder -> String -> IO (Maybe String)
getSearchKeyBySearchDialog builder defaultStr = do
  dialog <- builderGetObject builder castToDialog "SearchDialog"
  entry  <- builderGetObject builder castToEntry "SearchDialogEntry"
  entrySetText entry defaultStr

  widgetGrabFocus entry
  res <- dialogRun dialog >>= \case
    ResponseUser 0 -> do
                      value <- entryGetText entry
                      return $ if null value then Nothing else Just value
    _              -> return Nothing

  widgetHide dialog

  return res

-- |
--
--
getSearchKeyFromSearchDialog :: Builder -> IO String
getSearchKeyFromSearchDialog builder = do
  entry  <- builderGetObject builder castToEntry "SearchDialogEntry"
  entryGetText entry

-- |
--
--
getReplaceByReplaceDialog :: Builder  -> IO (Maybe (String, String))
getReplaceByReplaceDialog builder = do
  initReplaceDialog builder
  dialog <- builderGetObject builder castToDialog "ReplaceDialog"
  searchEntry  <- builderGetObject builder castToEntry "ReplaceDialogSearchEntry"
  replaceEntry <- builderGetObject builder castToEntry "ReplaceDialogReplaceEntry"

  res <- dialogRun dialog >>= \case
    ResponseUser 0 -> do
                      searchVal <- entryGetText searchEntry
                      replaceVal <- entryGetText replaceEntry
                      getResult searchVal replaceVal
    _              -> return Nothing

  widgetHide dialog
  return res
  
  where
    getResult sVal rVal
      | null sVal && null rVal = return Nothing
      | otherwise = return $ Just (sVal, rVal)

-- |
--
--
initSearchDialog :: Builder -> IO ()
initSearchDialog builder = do
  entry  <- builderGetObject builder castToEntry "SearchDialogEntry"
  entrySetText entry ""

-- |
--
--
initReplaceDialog :: Builder -> IO ()
initReplaceDialog builder = do
  searchEntry  <- builderGetObject builder castToEntry "ReplaceDialogSearchEntry"
  replaceEntry <- builderGetObject builder castToEntry "ReplaceDialogReplaceEntry"
  entrySetText searchEntry ""
  entrySetText replaceEntry ""


-- |=====================================================================
--  
--


-- |
--
--
setupToolButton :: Builder
                -> DebugStartBTClickedEventHandler
                -> DebugStopBTClickedEventHandler
                -> StepOverBTClickedEventHandler
                -> StepInBTClickedEventHandler
                -> ContinueBTClickedEventHandler
                -> BuildBTClickedEventHandler
                -> SaveBTClickedEventHandler
                -> IndentBTClickedEventHandler
                -> UnIndentBTClickedEventHandler
                -> CommentBTClickedEventHandler
                -> UnCommentBTClickedEventHandler
                -> StartGHCiBTClickedEventHandler
                -> StopGHCiBTClickedEventHandler
                -> IO ()
setupToolButton builder debugStartEvh debugStopEvh stepOverEvh stepInEvh continueEvh buildEvh saveEvh indentEvh unIndentEvh commentEvh unCommentEvh startGHCi stopGHCi= do

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_SAVE
  onToolButtonClicked bt saveEvh
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_BUILD
  onToolButtonClicked bt buildEvh
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_START_GHCI
  onToolButtonClicked bt startGHCi
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STOP_GHCI
  onToolButtonClicked bt stopGHCi
  widgetSetSensitive bt False

  ------------------------------------

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_START
  onToolButtonClicked bt debugStartEvh
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_STOP
  onToolButtonClicked bt debugStopEvh
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_CONTINUE
  onToolButtonClicked bt continueEvh
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_OVER
  onToolButtonClicked bt stepOverEvh
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_IN
  onToolButtonClicked bt stepInEvh
  widgetSetSensitive bt False

  ------------------------------------

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_INDENT
  onToolButtonClicked bt indentEvh
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_UNINDENT
  onToolButtonClicked bt unIndentEvh
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_COMMENT
  onToolButtonClicked bt commentEvh
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_UNCOMMENT
  onToolButtonClicked bt unCommentEvh
  widgetSetSensitive bt True


-- |
--
--
changeTBsOnGHCiStartting :: Builder -> IO ()
changeTBsOnGHCiStartting builder = do

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_BUILD
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_START_GHCI
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STOP_GHCI
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_START
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_STOP
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_CONTINUE
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_OVER
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_IN
  widgetSetSensitive bt False


-- |
--
--
changeTBsOnGHCiStarted :: Builder -> IO ()
changeTBsOnGHCiStarted builder = do

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_BUILD
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_START_GHCI
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STOP_GHCI
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_START
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_STOP
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_CONTINUE
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_OVER
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_IN
  widgetSetSensitive bt False


-- |
--
--
changeTBsOnGHCiStopped :: Builder -> IO ()
changeTBsOnGHCiStopped builder = do

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_BUILD
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_START_GHCI
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STOP_GHCI
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_START
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_STOP
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_CONTINUE
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_OVER
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_IN
  widgetSetSensitive bt False


-- |
--
--
changeTBsOnBuildStart :: Builder -> IO ()
changeTBsOnBuildStart builder = do

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_BUILD
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_START_GHCI
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STOP_GHCI
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_START
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_STOP
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_CONTINUE
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_OVER
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_IN
  widgetSetSensitive bt False

-- |
--
--
changeTBsOnBuildFinish :: Builder -> IO ()
changeTBsOnBuildFinish builder = do

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_BUILD
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_START_GHCI
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STOP_GHCI
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_START
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_STOP
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_CONTINUE
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_OVER
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_IN
  widgetSetSensitive bt False


-- |
--
--
changeTBsOnDebugStarted :: Builder -> IO ()
changeTBsOnDebugStarted builder = do

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_BUILD
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_START_GHCI
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STOP_GHCI
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_START
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_STOP
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_CONTINUE
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_OVER
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_IN
  widgetSetSensitive bt True


-- |
--
--
changeTBsOnDebugStopped :: Builder -> IO ()
changeTBsOnDebugStopped builder = do

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_BUILD
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_START_GHCI
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STOP_GHCI
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_START
  widgetSetSensitive bt True

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_DEBUG_STOP
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_CONTINUE
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_OVER
  widgetSetSensitive bt False

  bt <- builderGetObject builder castToToolButton _NAME_TOOL_BT_STEP_IN
  widgetSetSensitive bt False