GtkHelper.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
-----------------------------------------------------------------------------
--
-- Module      :  VCSGui.Common.GtkHelper
-- Copyright   :  2011 Stephan Fortelny, Harald Jagenteufel
-- License     :  GPL
--
-- Maintainer  :  stephanfortelny at gmail.com, h.jagenteufel at gmail.com
-- Stability   :
-- Portability :
--
-- | This module contains functions to help building a GTK GUI using GTKBuilder.
--
-----------------------------------------------------------------------------

module VCSGui.Common.GtkHelper (
-- * Typesynonyms to wrap Gtk objects (*Item)
--
-- | These are built after the following scheme:
--
-- @((Name of the item as in the gladefile), (actual gtk object), (getter, setter))@
--
-- Note however that you can (and should) use the functions 'getName', 'getItem', 'get' and 'set'.

    openGladeFile
    , getWindowFromGlade
    , getActionFromGlade
    , getLabelFromGlade
    , getTextEntryFromGlade
    , getTextViewFromGlade
    , getComboBoxFromGlade
    , getCheckButtonFromGlade
    , getButtonFromGlade
    , getTreeViewFromGlade
    , getTreeViewFromGladeCustomStore
    , addColumnToTreeView
    , addColumnToTreeView'
    , addTextColumnToTreeView
    , addTextColumnToTreeView'


    , getName
    , getItem
    , get
    , set

    , closeWin
    , registerClose
    , registerCloseAction
    , registerQuit
    , registerQuitAction

    , WindowItem
    , ActionItem
    , LabelItem
    , TextEntryItem
    , TextViewItem
    , ComboBoxItem
    , CheckButtonItem
    , TreeViewItem
    , ButtonItem
) where

import System.Directory
import Control.Monad.Trans(liftIO)
import System.IO (hPutStrLn, stderr)
import VCSGui.Common.Helpers (emptyTextToNothing)
import Data.Text (Text)
import qualified Data.Text as T (pack, unpack)
import qualified GI.Gtk.Objects.Window as Gtk (Window(..))
import qualified GI.Gtk.Objects.Action as Gtk
       (onActionActivate, Action(..))
import qualified GI.Gtk.Objects.Label as Gtk
       (labelSetText, Label(..))
import qualified GI.Gtk.Objects.Entry as Gtk
       (entrySetText, entryGetText, Entry(..))
import qualified GI.Gtk.Objects.ComboBox as Gtk (ComboBox(..))
import qualified GI.Gtk.Objects.TextView as Gtk
       (textViewGetBuffer, TextView(..))
import qualified Data.GI.Gtk.ModelView.SeqStore as Gtk
       (seqStoreToList, seqStoreNew, seqStoreAppend, seqStoreClear,
        SeqStore(..))
import qualified GI.Gtk.Objects.TreeView as Gtk
       (treeViewAppendColumn, treeViewSetModel, TreeView(..))
import qualified GI.Gtk.Objects.CheckButton as Gtk
       (CheckButton(..))
import qualified GI.Gtk.Objects.Button as Gtk
       (buttonSetLabel, buttonGetLabel, Button(..))
import qualified GI.Gtk.Objects.Builder as Gtk
       (builderGetObject, builderAddFromFile, builderNew, Builder(..))
import qualified Data.GI.Gtk.ComboBox as Gtk
       (comboBoxGetModelText, comboBoxGetActiveText, comboBoxSetModelText)
import qualified GI.Gtk.Objects.TextBuffer as Gtk
       (textBufferGetText, textBufferGetEndIter, textBufferGetStartIter,
        textBufferSetText)
import qualified GI.Gtk.Structs.TextIter as Gtk (textIterEqual)
import qualified GI.Gtk.Objects.ToggleButton as Gtk
       (toggleButtonSetActive, toggleButtonGetActive)
import qualified GI.Gtk.Objects.Widget as Gtk
       (onWidgetDeleteEvent, widgetHide)
import qualified GI.Gtk.Functions as Gtk (mainQuit)
import qualified GI.Gtk.Objects.CellRenderer as Gtk (IsCellRenderer)
import qualified GI.Gtk.Objects.TreeViewColumn as Gtk
       (treeViewColumnPackStart, setTreeViewColumnTitle,
        treeViewColumnNew)
import qualified Data.GI.Gtk.ModelView.CellLayout as Gtk
       (cellLayoutSetDataFunction)
import qualified GI.Gtk.Objects.CellRendererText as Gtk
       (cellRendererTextNew, CellRendererText(..))
import qualified Data.GI.Base.BasicTypes as Gtk (GObject)
import Data.GI.Base.ManagedPtr (unsafeCastTo)
import Data.GI.Base.BasicTypes (ManagedPtr(..))
import Data.Maybe (fromJust)

-- Typesynonyms
type WindowItem = (Text, Gtk.Window, ())
type ActionItem = (Text, Gtk.Action, ())
type LabelItem = (Text, Gtk.Label, (IO (Maybe Text), Text -> IO ()))
type TextEntryItem = (Text, Gtk.Entry, (IO (Maybe Text), Text -> IO ()))
type ComboBoxItem = (Text, Gtk.ComboBox, (IO (Maybe Text), [Text] -> IO ()))
type TextViewItem = (Text, Gtk.TextView, (IO (Maybe Text), Text -> IO ()))
type TreeViewItem a = (Text, (Gtk.SeqStore a, Gtk.TreeView), (IO (Maybe [a]), [a] -> IO ()))
type CheckButtonItem = (Text, Gtk.CheckButton, (IO Bool, Bool -> IO()))
type ButtonItem = (Text, Gtk.Button, (IO Text, Text -> IO()))

-- Type accessors

-- | return the name of this item (as in the gladefile)
getName :: (Text, a, b) -> Text
getName (n, _, _) = n

-- | return the Gtk object wrapped by given item
getItem :: (Text, a, b) -> a
getItem (_, item, _) = item

-- | call teh get method of an *Item
get :: (Text, a, (b, c)) -> b
get (_, _, (getter, _)) = getter

-- | call the set method of an *Item
set :: (Text, a, (b, c)) -> c
set (_,_, (_, setter)) = setter


----------------------
-- *FromGlade
----------------------

-- | Open a gladefile with a new 'Gtk.Builder'.
openGladeFile :: FilePath -- ^ Gladefile to open.
    -> IO Gtk.Builder
openGladeFile fn = do
    builder <- Gtk.builderNew
    Gtk.builderAddFromFile builder $ T.pack fn
    return builder

-- | Get a 'WindowItem' from a gladefile.
getWindowFromGlade :: Gtk.Builder
    -> Text -- ^ name of the window to get as specified in the gladefile.
    -> IO WindowItem
getWindowFromGlade builder name = do
    (a, b) <- wrapWidget builder Gtk.Window name
    return (a, b, ())

-- | Get an 'ActionItem' from a gladefile.
getActionFromGlade :: Gtk.Builder
    -> Text -- ^ name of the action to get as specified in the gladefile.
    -> IO ActionItem
getActionFromGlade builder name = do
    (a, b) <- wrapWidget builder Gtk.Action name
    return (a, b, ())

-- | Get an 'LabelItem' from a gladefile.
getLabelFromGlade :: Gtk.Builder
    -> Text -- ^ name of the label to get as specified in the gladefile.
    -> IO LabelItem
getLabelFromGlade builder name = do
    (_, entry) <- wrapWidget builder Gtk.Label name
    let getter = error "don't call get on a gtk label!" :: IO (Maybe Text)
        setter val = Gtk.labelSetText entry val :: IO ()
    return (name, entry, (getter, setter))

-- | Get a 'ButtonItem' from a gladefile.
getButtonFromGlade :: Gtk.Builder
    -> Text -- ^ name of the button to get as specified in the gladefile.
    -> IO ButtonItem
getButtonFromGlade builder name = do
    (_,btn) <- wrapWidget builder Gtk.Button name
    let getter = Gtk.buttonGetLabel btn :: IO Text
        setter val = Gtk.buttonSetLabel btn val
    return (name, btn, (getter,setter))

-- | Get a 'TextEntryItem' from a gladefile.
getTextEntryFromGlade :: Gtk.Builder
    -> Text -- ^ name of the text entry to get as specified in the gladefile.
    -> IO TextEntryItem
getTextEntryFromGlade builder name = do
    (_, entry) <- wrapWidget builder Gtk.Entry name
    let getter = fmap emptyTextToNothing $ Gtk.entryGetText entry :: IO (Maybe Text)
        setter val = Gtk.entrySetText entry val :: IO ()
    return (name, entry, (getter, setter))

-- | Get a 'ComboBoxItem' from a gladefile.
getComboBoxFromGlade :: Gtk.Builder
                    -> Text -- ^ name of the combo box to get as specified in the gladefile.
                    -> IO ComboBoxItem
getComboBoxFromGlade builder name = do
    (_, combo) <- wrapWidget builder Gtk.ComboBox name
    Gtk.comboBoxSetModelText combo
    let getter = Gtk.comboBoxGetActiveText combo  :: IO (Maybe Text) -- get selected text
        setter entries = do -- fill with new entries
            store <- Gtk.comboBoxGetModelText combo
            Gtk.seqStoreClear store
            mapM_ (Gtk.seqStoreAppend store) entries
            return ()
    return (name, combo, (getter, setter))

-- | Get a 'TextViewItem' from a gladefile.
getTextViewFromGlade :: Gtk.Builder
    -> Text -- ^ name of the text view to get as specified in the gladefile.
    -> IO TextViewItem
getTextViewFromGlade builder name =  do
        (_, entry)  <- wrapWidget builder Gtk.TextView name
        buffer <- Gtk.textViewGetBuffer entry
        let getter = getLongText buffer :: IO (Maybe Text)
            setter = (\text -> Gtk.textBufferSetText buffer text (-1)) :: Text -> IO ()
        return (name, entry, (getter, setter))
    where
    getLongText buffer = do
        start <- Gtk.textBufferGetStartIter buffer
        end <- Gtk.textBufferGetEndIter buffer
        isEmpty <- (Gtk.textIterEqual start end)
        if isEmpty then return Nothing else do
            s <- Gtk.textBufferGetText buffer start end True -- True to inclue hidden char
            return $ Just s

-- | Get a 'CheckButtonItem' from a gladefile.
getCheckButtonFromGlade :: Gtk.Builder
    -> Text -- ^ name of the check button to get as specified in the gladefile.
    -> IO CheckButtonItem
getCheckButtonFromGlade builder name = do
        (_,bt) <- wrapWidget builder Gtk.CheckButton name
        let getter = Gtk.toggleButtonGetActive bt
            setter = (\bool -> Gtk.toggleButtonSetActive bt bool) :: Bool -> IO()
        return (name,bt, (getter,setter))

---------------------------------
-- TreeView
---------------------------------

-- | Get a 'TreeViewItem' from a gladefile.
getTreeViewFromGlade :: Gtk.Builder
    -> Text -- ^ name of the tree view to get as specified in the gladefile.
    -> [a] -- ^ Content of the new tree view.
    -> IO (TreeViewItem a)
getTreeViewFromGlade builder name rows = do
    (_, tView) <- wrapWidget builder Gtk.TreeView name
    entry@(store, treeView) <- createStoreForTreeView tView rows
    let getter = getFromSeqStore entry
        setter = setToSeqStore entry
    return (name, (store, treeView), (getter, setter))

-- | Get a 'TreeViewItem' from a gladefile.
getTreeViewFromGladeCustomStore :: Gtk.Builder
                        -> Text -- ^ name of the tree view to get as specified in the gladefile.
                        -> (Gtk.TreeView -> IO (Gtk.SeqStore a)) -- ^ fn defining how to setup the liststore
                        -> IO (TreeViewItem a)
getTreeViewFromGladeCustomStore builder name setupSeqStore = do
    (_, tView) <- wrapWidget builder Gtk.TreeView name
    store <- setupSeqStore tView
    Gtk.treeViewSetModel tView (Just store)
    let getter = getFromSeqStore (store, tView)
        setter = setToSeqStore (store, tView)
    return (name, (store, tView), (getter, setter))

-- | Create a new 'Gtk.SeqStore' for a 'Gtk.TreeView'.
createStoreForTreeView :: Gtk.TreeView -- ^ The created list store will be set the model for this TreeView.
    -> [a] -- ^ Content of the new store.
    -> IO (Gtk.SeqStore a, Gtk.TreeView)
createStoreForTreeView listView rows = do
    seqStore <- Gtk.seqStoreNew rows
    Gtk.treeViewSetModel listView (Just seqStore)
    return (seqStore, listView)

-- | Get the content of a SeqStore.
getFromSeqStore :: (Gtk.SeqStore a, Gtk.TreeView)
    -> IO (Maybe [a]) -- ^ Nothing if the SeqStore is empty.
getFromSeqStore (store, _) = do
    list <- Gtk.seqStoreToList store
    if null list
        then return Nothing
        else return $ Just list

-- | Set the content of a SeqStore.
setToSeqStore :: (Gtk.SeqStore a, Gtk.TreeView)
    -> [a] -- ^ New content of the SeqStore.
    -> IO ()
setToSeqStore (store, view) newList = do
    Gtk.seqStoreClear store
    mapM_ (Gtk.seqStoreAppend store) newList
    return ()

--
-- Various helpers
--

-- | Close a window.
closeWin :: WindowItem -> IO ()
closeWin win = (Gtk.widgetHide (getItem win))

-- | Close a window if 'Gtk.deleteEvent' occurs on this 'WindowItem'.
registerClose :: WindowItem -> IO ()
registerClose win = Gtk.onWidgetDeleteEvent (getItem win) (\_ -> liftIO (closeWin win) >> return False) >> return ()

-- | Close a window if the specified action occurs on this 'WindowItem'.
registerCloseAction :: ActionItem -> WindowItem -> IO ()
registerCloseAction act win = Gtk.onActionActivate (getItem act) (liftIO (closeWin win)) >> return ()

-- | Call 'Gtk.mainQuit' if 'Gtk.deleteEvent' occurs on this 'WindowItem'.
registerQuit :: WindowItem -> IO ()
registerQuit win = Gtk.onWidgetDeleteEvent (getItem win) (\_ -> liftIO $ Gtk.mainQuit >> return False) >> return ()

-- | Call 'Gtk.mainQuit' if the specified action occurs on this 'WindowItem'.
registerQuitAction :: ActionItem -> IO ()
registerQuitAction act = Gtk.onActionActivate (getItem act) (liftIO (Gtk.mainQuit)) >> return ()

-- TODO fun argument is not used. what was the purpos of this function?
-- | same as 'registerQuitAction' since second argument is ignored (?)
registerQuitWithCustomFun :: WindowItem
                -> IO () -- ^ custom fun
                -> IO ()
registerQuitWithCustomFun win fun = Gtk.onWidgetDeleteEvent (getItem win) (\_ -> liftIO $ Gtk.mainQuit >> return False) >> return ()

-- | Add a column to given SeqStore and TreeView using a mapping.
-- The mapping consists of a CellRenderer, the title and a function, that maps each row to attributes of the column
addColumnToTreeView :: Gtk.IsCellRenderer r =>
    TreeViewItem a
    -> r -- ^ CellRenderer
    -> Text -- ^ title
    -> (r -> a -> IO ()) -- ^ mapping
    -> IO ()
addColumnToTreeView (_, item, _) = do
    addColumnToTreeView' item
--    newCol <- Gtk.treeViewColumnNew
--    Gtk.set newCol [Gtk.treeViewColumnTitle Gtk.:= title]
--    Gtk.treeViewAppendColumn listView newCol
--    Gtk.treeViewColumnPackStart newCol renderer True
--    Gtk.cellLayoutSetAttributes newCol renderer seqStore value2attributes

-- | Same as 'addColumnToTreeView'. This function can be called without a complete 'TreeViewItem'.
addColumnToTreeView' :: Gtk.IsCellRenderer r =>
    (Gtk.SeqStore a, Gtk.TreeView)
    -> r
    -> Text
    -> (r -> a -> IO ())
    -> IO ()
addColumnToTreeView' (seqStore, listView) renderer title value2attributes = do
    newCol <- Gtk.treeViewColumnNew
    Gtk.setTreeViewColumnTitle newCol title
    Gtk.treeViewAppendColumn listView newCol
    Gtk.treeViewColumnPackStart newCol renderer True
    Gtk.cellLayoutSetDataFunction newCol renderer seqStore (value2attributes renderer)

-- | Shortcut for adding text columns to a TreeView. See 'addColumnToTreeView'.
addTextColumnToTreeView :: TreeViewItem a
    -> Text -- ^ title
    -> (Gtk.CellRendererText -> a -> IO ()) -- ^ mapping
    -> IO ()
addTextColumnToTreeView tree title map = do
    r <- Gtk.cellRendererTextNew
    addColumnToTreeView tree r title map

-- | Shortcut for adding text columns to a TreeView. See 'addColumnToTreeView\''.
addTextColumnToTreeView' :: (Gtk.SeqStore a, Gtk.TreeView)
    -> Text
    -> (Gtk.CellRendererText -> a -> IO ())
    -> IO ()
addTextColumnToTreeView' item title map = do
    r <- Gtk.cellRendererTextNew
    addColumnToTreeView' item r title map

---------------------------
-- internal helpers
---------------------------

wrapWidget :: Gtk.GObject objClass =>
     Gtk.Builder
     -> (ManagedPtr objClass -> objClass)
     -> Text -> IO (Text, objClass)
wrapWidget builder constructor name = do
    hPutStrLn stderr $ " cast " ++ T.unpack name
    gobj <- Gtk.builderGetObject builder name >>= unsafeCastTo constructor . fromJust
    return (name, gobj)