module VCSGui.Common.Commit (
SCFile(..)
,Option
,showCommitGUI
,selected
,filePath
,status
,isLocked
) where
import qualified VCSWrapper.Common as Wrapper
import qualified VCSGui.Common.GtkHelper as H
import Graphics.UI.Gtk
import Control.Monad.Trans(liftIO)
import Control.Monad
import Control.Monad.Reader
import Data.Maybe
import Paths_vcsgui(getDataFileName)
import qualified Data.Text as T (unpack, pack)
import Data.Text (Text)
getGladepath = getDataFileName "data/guiCommonCommit.glade"
accessorWindowCommit = "windowCommit"
accessorTreeViewFiles = "treeViewFiles"
accessorActCommit = "actCommit"
accessorActCancel = "actCancel"
accessorActTxtViewMsg = "txtViewMsg"
type OkCallBack = Text
-> [FilePath]
-> [Option]
-> Wrapper.Ctx ()
type TreeViewSetter = TreeView
-> Wrapper.Ctx (ListStore SCFile)
data CommitGUI = CommitGUI {
windowCommit :: H.WindowItem
, treeViewFiles :: H.TreeViewItem SCFile
, actCommit :: H.ActionItem
, actCancel :: H.ActionItem
, txtViewMsg :: H.TextViewItem
}
data SCFile = GITSCFile Bool FilePath Text |
SVNSCFile Bool FilePath Text Bool
deriving (Show)
selected :: SCFile -> Bool
selected (GITSCFile s _ _) = s
selected (SVNSCFile s _ _ _) = s
filePath :: SCFile -> FilePath
filePath (GITSCFile _ fp _ ) = fp
filePath (SVNSCFile _ fp _ _) = fp
status :: SCFile -> Text
status (GITSCFile _ _ s) = s
status (SVNSCFile _ _ s _) = s
isLocked :: SCFile -> Bool
isLocked (SVNSCFile _ _ _ l) = l
isLocked _ = False
type Option = Text
showCommitGUI :: TreeViewSetter
-> OkCallBack
-> Wrapper.Ctx()
showCommitGUI setUpTreeView okCallback = do
liftIO $ putStrLn "Starting gui ..."
gui <- loadCommitGUI setUpTreeView
liftIO $ H.registerClose $ windowCommit gui
liftIO $ H.registerCloseAction (actCancel gui) (windowCommit gui)
config <- ask
liftIO $ on (H.getItem (actCommit gui)) actionActivated $ do
let (store,_) = H.getItem (treeViewFiles gui)
selectedFiles <- getSelectedFiles store
mbMsg <- H.get (txtViewMsg gui)
case selectedFiles of
[] -> return()
_ -> do
case mbMsg of
Nothing -> return()
Just msg -> Wrapper.runVcs config $ okCallback msg selectedFiles []
H.closeWin (windowCommit gui)
liftIO $ widgetShowAll $ H.getItem $ windowCommit gui
return ()
loadCommitGUI :: TreeViewSetter
-> Wrapper.Ctx CommitGUI
loadCommitGUI setUpTreeView = do
gladepath <- liftIO getGladepath
builder <- liftIO $ H.openGladeFile gladepath
win <- liftIO $ H.getWindowFromGlade builder accessorWindowCommit
treeViewFiles <- getTreeViewFromGladeCustomStore builder accessorTreeViewFiles setUpTreeView
actCommit <- liftIO $ H.getActionFromGlade builder accessorActCommit
actCancel <- liftIO $ H.getActionFromGlade builder accessorActCancel
txtViewMsg <- liftIO $ H.getTextViewFromGlade builder accessorActTxtViewMsg
return $ CommitGUI win treeViewFiles actCommit actCancel txtViewMsg
getSelectedFiles :: ListStore SCFile -> IO [FilePath]
getSelectedFiles listStore = do
listedFiles <- listStoreToList listStore
let selectedFiles = map (\scf -> filePath scf )
$ filter (\scf -> selected scf) listedFiles
return (selectedFiles)
getTreeViewFromGladeCustomStore :: Builder
-> Text
-> TreeViewSetter
-> 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)
-> Text -> IO (Text, objClass)
wrapWidget builder cast name = do
putStrLn $ " cast " ++ T.unpack 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 ()