Commit.hs

{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
--
-- Module      :  VCSGui.Mercurial.Commit
-- Copyright   :  2011 Stephan Fortelny, Harald Jagenteufel
-- License     :  GPL Nothing
--
-- Maintainer  :  stephanfortelny at gmail.com, h.jagenteufel at gmail.com
-- Stability   :
-- Portability :
--
-- |
--
-----------------------------------------------------------------------------

module VCSGui.Mercurial.Commit (
    showCommitGUI
) where

import Control.Monad.Trans(liftIO)
import Control.Monad.Reader(ask)

import Graphics.UI.Gtk

import VCSGui.Common.GtkHelper
import qualified VCSGui.Common.Commit as Commit

import qualified VCSWrapper.Mercurial as Mercurial
import qualified VCSWrapper.Common as Wrapper
import Data.Text (Text)
import qualified Data.Text as T (pack, unpack)

doCommit :: Text -> [FilePath] -> [Commit.Option] -> Wrapper.Ctx ()
doCommit commitMsg files _ = do
    Mercurial.addremove files
    Mercurial.commit files commitMsg []

{- |
    Calls 'Commit.showCommitGUI' with a 'Graphics.UI.Gtk.ListStore' and 'OkCallBack' setup for Mercurial.
    This will display a window to enter a commit message and select the files to be commited by this commit.
-}
showCommitGUI :: Mercurial.Ctx ()
showCommitGUI = do
    Commit.showCommitGUI setupListStore doCommit

--TODO this is copy&pasted from git implementation refactor it and use abstract version
setupListStore :: TreeView -> Wrapper.Ctx (ListStore Commit.SCFile)
setupListStore view = do
        repoStatus <- Mercurial.status
        --GITSCFile Bool FilePath Text
        let selectedF = [Commit.GITSCFile True fp (T.pack $ show mod) | (Wrapper.GITStatus fp mod) <- repoStatus, mod == Wrapper.Modified || mod == Wrapper.Added]
            notSelectedF = [Commit.GITSCFile False fp (T.pack $ show mod) | (Wrapper.GITStatus fp mod) <- repoStatus, mod /= Wrapper.Modified && mod /= Wrapper.Added]

        liftIO $ do
            store <- listStoreNew (selectedF ++ notSelectedF)
            treeViewSetModel view store
            let item = (store, view)

            toggleRenderer <- cellRendererToggleNew
            addColumnToTreeView' item toggleRenderer "Commit" (\(Commit.GITSCFile s _ _)-> [cellToggleActive := s])
            addTextColumnToTreeView' item "File" (\(Commit.GITSCFile _ p _) -> [cellText := T.pack p])
            addTextColumnToTreeView' item "File status" (\(Commit.GITSCFile _ _ m) -> [cellText := m])

            -- register toggle renderer
            on toggleRenderer cellToggled $ \filepath -> do
                putStrLn ("toggle called: " ++ T.unpack filepath)

                Just treeIter <- treeModelGetIterFromString store filepath
                value <- listStoreGetValue store $ listStoreIterToIndex treeIter
                let newValue = (\(Commit.GITSCFile b fp m) -> Commit.GITSCFile (not b) fp m) value
                listStoreSetValue store (listStoreIterToIndex treeIter) newValue
                return ()
            return store