Log.hs

-----------------------------------------------------------------------------
--
-- Module      :  VCSGui.Git.Log
-- Copyright   :  2011 Stephan Fortelny, Harald Jagenteufel
-- License     :  GPL
--
-- Maintainer  :  stephanfortelny at gmail.com, h.jagenteufel at gmail.com
-- Stability   :
-- Portability :
--
-- | Every function related to displaying the history of a Git repository is found in this module.
--
-----------------------------------------------------------------------------

module VCSGui.Git.Log (
    showLogGUI
) where

import qualified Graphics.UI.Gtk as Gtk
import qualified VCSGui.Common.Log as Common
import qualified VCSWrapper.Git as Git
import Control.Monad.Reader (liftIO)
import Data.Maybe (fromMaybe)
import VCSGui.Common.Helpers (emptyListToNothing)


{- | Calls 'Common.showLogGUI' using Git. This will display all log entries. The branch to be displayed can be selected.
    Any commit can be checked out, creating a new branch if the commit is not already the HEAD of any branch.
    -}
showLogGUI :: Git.Ctx ()
showLogGUI = do
        log <- Git.simpleLog Nothing
        branches <- Git.localBranches
        Common.showLogGUI log [] (Just (branches, \branch -> Git.simpleLog (Just branch))) checkout False
    where
    checkout log Nothing = Git.checkout (Just $ Git.commitID log) Nothing
    checkout log (Just selBranch) = do
        revBranch <- Git.revparse selBranch
        case ((Git.commitID log) == revBranch) of
            True -> do
                liftIO $ putStrLn "checking out selected Branch"
                Git.checkout (Just selBranch) Nothing
            False -> do
                liftIO $ putStrLn $ "checking out Commit " ++ (Git.commitID log) ++ ", asking for new branchname"
                mbBranchname <- liftIO $ askForNewBranchname
                Git.checkout (Just $ Git.commitID log) (mbBranchname)

    askForNewBranchname :: IO (Maybe String)
    askForNewBranchname = do
        dialog <- Gtk.dialogNew
        Gtk.dialogAddButton dialog "gtk-ok" Gtk.ResponseOk
        upper <- Gtk.dialogGetContentArea dialog

        inputBranch <- Gtk.entryNew
        lblBranch <- Gtk.labelNew $ Just "Enter a new branchname (empty for anonym branch):"
        box <- Gtk.hBoxNew False 2
        Gtk.containerAdd (Gtk.castToBox upper) box
        Gtk.containerAdd box lblBranch
        Gtk.containerAdd box inputBranch

        Gtk.widgetShowAll dialog
        _ <- Gtk.dialogRun dialog
        branchname <- Gtk.entryGetText inputBranch
        Gtk.widgetDestroy dialog
        return $ emptyListToNothing branchname