{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- -- Module : VCSGui.Git.Commit -- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel -- License : GPL -- -- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com -- Stability : -- Portability : -- -- | Every function related to commiting changes to the Git repository is found in this module. -- ----------------------------------------------------------------------------- module VCSGui.Git.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.Git as Git import qualified VCSWrapper.Common as Wrapper import Data.Text (Text) import qualified Data.Text as T (unpack, pack) 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 GI.Gtk (setCellRendererTextText, setCellRendererToggleActive) doCommit :: Text -> [FilePath] -> [Commit.Option] -> Wrapper.Ctx () doCommit commitMsg files _ = do Git.add files (Wrapper.Config _ _ mbAuthor _) <- ask case mbAuthor of Nothing -> Git.commit files Nothing commitMsg [] Just (Wrapper.Author author mbEmail) -> do case mbEmail of Nothing -> Git.commit files (Just (author, "noEmailSet@noEmailSet")) commitMsg [] Just m -> Git.commit files (Just (author, m)) commitMsg [] {- | Calls 'Commit.showCommitGUI' with a 'Data.GI.Gtk.SeqStore' and 'OkCallBack' setup for Git. This will display a window to enter a commit message and select the files to be commited by this commit. -} showCommitGUI :: Git.Ctx () showCommitGUI = do Commit.showCommitGUI setupSeqStore doCommit setupSeqStore :: TreeView -> Wrapper.Ctx (SeqStore Commit.SCFile) setupSeqStore view = do repoStatus <- Git.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 _ _) -> setCellRendererToggleActive cell s) addTextColumnToTreeView' item "File" (\cell (Commit.GITSCFile _ p _) -> setCellRendererTextText cell $ T.pack p) addTextColumnToTreeView' item "File status" (\cell (Commit.GITSCFile _ _ m) -> 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 store