module IDE.Command.VCS.Common.Helper (
eMergeToolSetter
,createActionFromContext
) where
import IDE.Core.Types
import IDE.Core.State
import qualified IDE.Workspaces.Writer as Writer
import qualified IDE.Command.VCS.Types as Types
import qualified VCSWrapper.Common as VCS
import qualified VCSGui.Common as VCSGUI
import Control.Monad.Reader
import Control.Monad.Trans(liftIO)
import Data.Maybe
import qualified Data.Map as Map
createActionFromContext :: VCS.Ctx()
-> Types.VCSAction ()
createActionFromContext vcsAction = do
((_,conf,_),_) <- ask
liftIO $ VCSGUI.defaultVCSExceptionHandler $ VCS.runVcs conf vcsAction
eMergeToolSetter :: IDERef
-> FilePath
-> Maybe VCSGUI.MergeTool
-> Either VCSGUI.MergeTool (VCSGUI.MergeTool -> IO())
eMergeToolSetter ideRef cabalFp mbMergeTool =
case mbMergeTool of
Nothing -> Right $ mergeToolSetter ideRef cabalFp
Just mergeTool -> Left mergeTool
mergeToolSetter :: IDERef -> FilePath -> VCSGUI.MergeTool -> IO()
mergeToolSetter ideRef cabalFp mergeTool =
runReaderT (workspaceSetMergeTool cabalFp mergeTool) ideRef
workspaceSetMergeTool :: FilePath -> VCSGUI.MergeTool -> IDEAction
workspaceSetMergeTool pathToPackage mergeTool = do
modifyIDE_ (\ide -> do
let oldWs = fromJust (workspace ide)
let oldMap = packageVcsConf oldWs
case Map.lookup pathToPackage oldMap of
Nothing -> ide
Just (vcsType,config,_) -> do
let vcsConf = (vcsType,config,Just mergeTool)
let newMap = Map.insert pathToPackage vcsConf oldMap
let newWs = oldWs { packageVcsConf = newMap }
ide {workspace = Just newWs })
newWs <- readIDE workspace
Writer.writeWorkspace $ fromJust newWs