module VCSGui.Common.FilesInConflict (
showFilesInConflictGUI
) where
import qualified VCSWrapper.Common as Wrapper
import qualified VCSGui.Common.GtkHelper as H
import qualified VCSGui.Common.Commit as Commit
import qualified VCSGui.Common.MergeTool as Merge
import qualified VCSGui.Common.Process as Process
import qualified VCSGui.Common.ConflictsResolved as ConflictsResolvedGUI
import qualified VCSGui.Common.Error as Error
import Graphics.UI.Gtk
import Control.Monad.Trans(liftIO)
import Control.Monad
import Control.Monad.Reader
import Paths_vcsgui(getDataFileName)
getGladepath = getDataFileName "data/guiCommonFilesInConflict.glade"
accessorWindowFilesInConflict = "windowFilesInConflict"
accessorTreeViewFiles = "treeViewFiles"
accessorActResolved = "actResolved"
accessorActCancel = "actCancel"
accessorActBrowsePath = "actBrowsePath"
accessorEntPath = "entPath"
type Handler = Wrapper.Ctx()
type TreeViewSetter = (Maybe FilePath)
-> [FilePath]
-> (FilePath -> Wrapper.Ctx [FilePath])
-> (FilePath -> Wrapper.Ctx ())
-> (Either Merge.MergeTool Merge.MergeToolSetter)
-> H.TextEntryItem
-> TreeView
-> Wrapper.Ctx (ListStore SCFile)
data GUI = GUI {
windowFilesInConflict :: H.WindowItem
, treeViewFiles :: H.TreeViewItem SCFile
, actResolved :: H.ActionItem
, actCancel :: H.ActionItem
, actBrowsePath :: H.ActionItem
, entPath :: H.TextEntryItem
}
data SCFile = SCFile {
filePath :: FilePath
, isResolved :: Bool
}
deriving (Show)
showFilesInConflictGUI :: (Maybe TreeViewSetter)
-> [FilePath]
-> (FilePath -> Wrapper.Ctx [FilePath])
-> (FilePath -> Wrapper.Ctx ())
-> (Either Merge.MergeTool Merge.MergeToolSetter)
-> Handler
-> Wrapper.Ctx ()
showFilesInConflictGUI Nothing f g m e a =
showFilesInConflictGUI (Just defaultSetUpTreeView) f g m e a
showFilesInConflictGUI (Just setUpTreeView) filesInConflict filesToResolveGetter resolveMarker eMergeToolSetter actResolvedHandler = do
liftIO $ putStrLn "Starting files in conflict gui ..."
config <- ask
let cwd = (Wrapper.configCwd config)
gui <- loadGUI $ setUpTreeView cwd filesInConflict filesToResolveGetter resolveMarker eMergeToolSetter
mbMergeToolSetter <- case eMergeToolSetter of
Left (Merge.MergeTool path) -> do
liftIO $ H.set (entPath gui) path
return Nothing
Right setter -> return $ Just setter
liftIO $ H.registerClose $ windowFilesInConflict gui
liftIO $ H.registerCloseAction (actCancel gui) (windowFilesInConflict gui)
config <- ask
liftIO $ on (H.getItem (actResolved gui)) actionActivated $ do
Wrapper.runVcs config $ actResolvedHandler
H.closeWin (windowFilesInConflict gui)
liftIO $ on (H.getItem (actBrowsePath gui)) actionActivated $ do
mbPath <- showFolderChooserDialog "Select executable" (H.getItem $ windowFilesInConflict gui) FileChooserActionOpen
case mbPath of
Nothing -> return ()
Just path -> do
H.set (entPath gui) path
case mbMergeToolSetter of
Nothing -> return ()
Just setter -> setter (Merge.MergeTool path)
return ()
liftIO $ widgetShowAll $ H.getItem $ windowFilesInConflict gui
return ()
loadGUI :: (H.TextEntryItem -> TreeView -> Wrapper.Ctx (ListStore SCFile))
-> Wrapper.Ctx GUI
loadGUI setUpTreeView = do
gladepath <- liftIO getGladepath
builder <- liftIO $ H.openGladeFile gladepath
win <- liftIO $ H.getWindowFromGlade builder accessorWindowFilesInConflict
entPath <- liftIO $ H.getTextEntryFromGlade builder accessorEntPath
treeViewFiles <- getTreeViewFromGladeCustomStore builder accessorTreeViewFiles (setUpTreeView entPath)
actResolved <- liftIO $ H.getActionFromGlade builder accessorActResolved
actCancel <- liftIO $ H.getActionFromGlade builder accessorActCancel
actBrowsePath <- liftIO $ H.getActionFromGlade builder accessorActBrowsePath
return $ GUI win treeViewFiles actResolved actCancel actBrowsePath entPath
defaultSetUpTreeView :: TreeViewSetter
defaultSetUpTreeView mbcwd conflictingFiles filesToResolveGetter resolveMarker eMergeToolSetter entPath listView = do
config <- ask
liftIO $ do
listStore <- listStoreNew [
(SCFile fileName
(False))
| fileName <- conflictingFiles]
treeViewSetModel listView listStore
let treeViewItem = (listStore, listView)
renderer <- cellRendererTextNew
H.addColumnToTreeView' treeViewItem
renderer
"File"
$ \scf -> [cellText := filePath scf]
renderer <- cellRendererToggleNew
H.addColumnToTreeView' treeViewItem
renderer
"Resolved"
$ \scf -> [cellToggleActive := isResolved scf]
on renderer cellToggled $ \columnId -> do
putStrLn $ "Checkbutton clicked at column " ++ (show columnId)
let callTool' = (\path -> Wrapper.runVcs config $ callTool columnId listStore path)
mbPath <- H.get entPath
case mbPath of
Nothing -> Error.showErrorGUI "MergeTool not set. Set MergeTool first."
Just path -> callTool' path
return ()
return listStore
where
callTool columnId listStore pathToTool = do
config <- ask
Just treeIter <- liftIO $ treeModelGetIterFromString listStore columnId
value <- liftIO $ listStoreGetValue listStore $ listStoreIterToIndex treeIter
filesToResolve <- filesToResolveGetter $ filePath value
resolvedByTool <- liftIO $ Process.exec mbcwd pathToTool filesToResolve
let setResolved' = setResolved listStore treeIter value
case resolvedByTool of
False -> ConflictsResolvedGUI.showConflictsResolvedGUI
(\resolved -> setResolved' resolved)
True -> setResolved listStore treeIter value True
return()
setResolved listStore treeIter oldValue isResolved = do
let fp = filePath oldValue
case isResolved of
False -> return ()
True -> resolveMarker fp
let newValue = (\(SCFile fp b) -> SCFile fp isResolved)
oldValue
liftIO $ listStoreSetValue listStore (listStoreIterToIndex treeIter) newValue
return ()
getTreeViewFromGladeCustomStore :: Builder
-> String
-> (TreeView -> Wrapper.Ctx (ListStore SCFile))
-> Wrapper.Ctx (H.TreeViewItem SCFile)
getTreeViewFromGladeCustomStore builder name setupListStore = do
(_, tView) <- liftIO $ wrapWidget builder castToTreeView name
store <- setupListStore tView
let getter = getFromListStore (store, tView)
setter = setToListStore (store, tView)
return (name, (store, tView), (getter, setter))
wrapWidget :: GObjectClass objClass =>
Builder
-> (GObject -> objClass)
-> String -> IO (String, objClass)
wrapWidget builder cast name = do
putStrLn $ " cast " ++ name
gobj <- builderGetObject builder cast name
return (name, gobj)
getFromListStore :: (ListStore a, TreeView)
-> IO (Maybe [a])
getFromListStore (store, _) = do
list <- listStoreToList store
if null list
then return Nothing
else return $ Just list
setToListStore :: (ListStore a, TreeView)
-> [a]
-> IO ()
setToListStore (store, view) newList = do
listStoreClear store
mapM_ (listStoreAppend store) newList
return ()
showFolderChooserDialog :: String
-> Window
-> FileChooserAction
-> IO (Maybe FilePath)
showFolderChooserDialog title parent fcAction = do
dialog <- fileChooserDialogNew (Just title) (Just parent) fcAction [("Cancel", ResponseCancel), ("Select", ResponseAccept)]
response <- dialogRun dialog
case response of
ResponseCancel -> widgetDestroy dialog >> return Nothing
ResponseDeleteEvent -> widgetDestroy dialog >> return Nothing
ResponseAccept -> do
f <- fileChooserGetFilename dialog
widgetDestroy dialog
return f