{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- -- 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 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) import GI.Gtk.Objects.TreeView (treeViewSetModel, TreeView(..)) import Data.GI.Gtk.ModelView.SeqStore (seqStoreSetValue, seqStoreGetValue, seqStoreIterToIndex, seqStoreNew, SeqStore(..)) import GI.Gtk.Objects.CellRendererToggle (onCellRendererToggleToggled, cellRendererToggleNew) import GI.Gtk.Interfaces.TreeModel (treeModelGetIterFromString) import qualified GI.Gtk as Gtk (setCellRendererTextText, setCellRendererToggleActive) doCommit :: Text -> [FilePath] -> [Commit.Option] -> Wrapper.Ctx () doCommit commitMsg files _ = do Mercurial.addremove files Mercurial.commit files commitMsg [] {- | Calls 'Commit.showCommitGUI' with a 'Data.GI.Gtk.SeqStore' 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 setupSeqStore doCommit --TODO this is copy&pasted from git implementation refactor it and use abstract version setupSeqStore :: TreeView -> Wrapper.Ctx (SeqStore Commit.SCFile) setupSeqStore 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 <- seqStoreNew (selectedF ++ notSelectedF) treeViewSetModel view (Just store) let item = (store, view) toggleRenderer <- cellRendererToggleNew addColumnToTreeView' item toggleRenderer "Commit" (\cell (Commit.GITSCFile s _ _) -> Gtk.setCellRendererToggleActive cell s) addTextColumnToTreeView' item "File" (\cell (Commit.GITSCFile _ p _) -> Gtk.setCellRendererTextText cell $ T.pack p) addTextColumnToTreeView' item "File status" (\cell (Commit.GITSCFile _ _ m) -> Gtk.setCellRendererTextText cell m) -- register toggle renderer onCellRendererToggleToggled toggleRenderer $ \filepath -> do putStrLn ("toggle called: " ++ T.unpack filepath) treeModelGetIterFromString store filepath >>= \case (True, treeIter) -> do n <- seqStoreIterToIndex treeIter value <- seqStoreGetValue store n let newValue = (\(Commit.GITSCFile b fp m) -> Commit.GITSCFile (not b) fp m) value seqStoreSetValue store n newValue return () _ -> return () return store