diff --git a/.gitignore b/.gitignore index 0ff207e..9a3feb0 100644 --- a/.gitignore +++ b/.gitignore @@ -5,3 +5,4 @@ vcsguis.lkshw haskellVCSGUI.lkshs haskellVCSGUI.lkshw /.shelly/ +/dist-newstyle/ diff --git a/.travis.yml b/.travis.yml index 274000e..6175986 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,36 +1,26 @@ -language: haskell +sudo: required +services: + - docker -sudo: false +cache: + directories: + - .cabal + - .ghc -matrix: - include: - - env: CABALVER=1.22 GHCVER=7.8.3 - addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.3,happy-1.19.5,alex-3.1.4,libwebkitgtk-dev,libwebkitgtk-3.0-dev], sources: [hvr-ghc]}} - - env: CABALVER=1.22 GHCVER=7.8.4 - addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4,happy-1.19.5,alex-3.1.4,libwebkitgtk-dev,libwebkitgtk-3.0-dev], sources: [hvr-ghc]}} - - env: CABALVER=1.22 GHCVER=7.10.1 - addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.1,happy-1.19.5,alex-3.1.4,libwebkitgtk-dev,libwebkitgtk-3.0-dev], sources: [hvr-ghc]}} - - env: CABALVER=1.22 GHCVER=7.10.2 - addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2,happy-1.19.5,alex-3.1.4,libwebkitgtk-dev,libwebkitgtk-3.0-dev], sources: [hvr-ghc]}} - - env: CABALVER=head GHCVER=head - addons: {apt: {packages: [cabal-install-head,ghc-head,happy-1.19.5,alex-3.1.4,libwebkitgtk-dev,libwebkitgtk-3.0-dev], sources: [hvr-ghc]}} - allow_failures: - - env: CABALVER=1.22 GHCVER=7.10.2 - - env: CABALVER=head GHCVER=head +env: + - CABALVER=1.24 GHCVER=7.10.3 OSVER=xenial + - CABALVER=1.24 GHCVER=8.0.1 OSVER=xenial + - CABALVER=1.24 GHCVER=8.0.2 OSVER=xenial before_install: - - export PATH=$HOME/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:/opt/alex/3.1.4/bin:/opt/happy/1.19.5/bin:$PATH - -install: - - cabal --version - - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" - - cabal update - - cabal install gtk2hs-buildtools + - docker build -t leksah -f travis/$OSVER.Dockerfile travis script: - - cd vcsgui - - cabal install -v2 - - cabal check + - docker run -v `pwd`:/build leksah + bash -x -c " + apt-get install -y cabal-install-$CABALVER ghc-$GHCVER && + export PATH=\$HOME/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:/opt/alex/3.1.7/bin:/opt/happy/1.19.5/bin:\$PATH && + ./travis/build.sh" notifications: irc: diff --git a/cabal.project b/cabal.project new file mode 100644 index 0000000..221618e --- /dev/null +++ b/cabal.project @@ -0,0 +1,37 @@ +flags: -overloaded-methods -overloaded-signals -overloaded-properties + +packages: ./vcsgui + +package gi-atk + flags: -overloaded-methods -overloaded-signals -overloaded-properties +package gi-cairo + flags: -overloaded-methods -overloaded-signals -overloaded-properties +package gi-gdk + flags: -overloaded-methods -overloaded-signals -overloaded-properties +package gi-gdkpixbuf + flags: -overloaded-methods -overloaded-signals -overloaded-properties +package gi-gio + flags: -overloaded-methods -overloaded-signals -overloaded-properties +package gi-glib + flags: -overloaded-methods -overloaded-signals -overloaded-properties +package gi-gobject + flags: -overloaded-methods -overloaded-signals -overloaded-properties +package gi-gtk + flags: -overloaded-methods -overloaded-signals -overloaded-properties +package gi-gtk-hs + flags: -overloaded-methods -overloaded-signals -overloaded-properties +package gi-gtkosxapplication + flags: -overloaded-methods -overloaded-signals -overloaded-properties +package gi-gtksource + flags: -overloaded-methods -overloaded-signals -overloaded-properties +package gi-javascriptcore + flags: -overloaded-methods -overloaded-signals -overloaded-properties +package gi-pango + flags: -overloaded-methods -overloaded-signals -overloaded-properties +package gi-soup + flags: -overloaded-methods -overloaded-signals -overloaded-properties +package gi-webkit + flags: -overloaded-methods -overloaded-signals -overloaded-properties +package gi-webkit2 + flags: -overloaded-methods -overloaded-signals -overloaded-properties + diff --git a/travis/build.sh b/travis/build.sh new file mode 100755 index 0000000..e306503 --- /dev/null +++ b/travis/build.sh @@ -0,0 +1,18 @@ +#!/bin/bash -ex + +echo $PATH +export LC_ALL=C.UTF-8 + +if [[ -d .cabal && -d .ghc ]]; then + cp -a .cabal .ghc /root +fi + +cabal update +cd vcsgui +cabal new-build + +# update the cache +rm -rf .cabal +cp -a /root/.cabal ./ +rm -rf .ghc +cp -a /root/.ghc ./ diff --git a/travis/vivid.Dockerfile b/travis/vivid.Dockerfile new file mode 100644 index 0000000..cd43293 --- /dev/null +++ b/travis/vivid.Dockerfile @@ -0,0 +1,11 @@ +FROM ubuntu:vivid + +RUN apt-get update && \ + apt-get -y install software-properties-common && \ + add-apt-repository -y ppa:hvr/ghc && \ + apt-get update && \ + apt-get -y install happy-1.19.5 alex-3.1.7 libgirepository1.0-dev libgtksourceview-3.0-dev libwebkitgtk-3.0-dev + +RUN mkdir /build +WORKDIR /build + diff --git a/travis/wily.Dockerfile b/travis/wily.Dockerfile new file mode 100644 index 0000000..5ffe96d --- /dev/null +++ b/travis/wily.Dockerfile @@ -0,0 +1,11 @@ +FROM ubuntu:wily + +RUN apt-get update && \ + apt-get -y install software-properties-common && \ + add-apt-repository -y ppa:hvr/ghc && \ + apt-get update && \ + apt-get -y install happy-1.19.5 alex-3.1.7 libgirepository1.0-dev libgtksourceview-3.0-dev libwebkitgtk-3.0-dev + +RUN mkdir /build +WORKDIR /build + diff --git a/travis/xenial.Dockerfile b/travis/xenial.Dockerfile new file mode 100644 index 0000000..2f4a5fa --- /dev/null +++ b/travis/xenial.Dockerfile @@ -0,0 +1,11 @@ +FROM ubuntu:xenial + +RUN apt-get update && \ + apt-get -y install software-properties-common && \ + add-apt-repository -y ppa:hvr/ghc && \ + apt-get update && \ + apt-get -y install happy-1.19.5 alex-3.1.7 libgirepository1.0-dev libgtksourceview-3.0-dev libwebkitgtk-3.0-dev + +RUN mkdir /build +WORKDIR /build + diff --git a/vcsgui/src/VCSGui/Common/Commit.hs b/vcsgui/src/VCSGui/Common/Commit.hs index 8f72d69..1a3d8e0 100644 --- a/vcsgui/src/VCSGui/Common/Commit.hs +++ b/vcsgui/src/VCSGui/Common/Commit.hs @@ -38,8 +38,8 @@ import Data.GI.Gtk.ModelView.SeqStore import GI.Gtk.Objects.Action (onActionActivate) import GI.Gtk.Objects.Widget (widgetShowAll) import GI.Gtk.Objects.Builder (builderGetObject, Builder(..)) -import Foreign.ForeignPtr (ForeignPtr) -import Data.GI.Base.BasicTypes (NullToNothing(..), GObject) +import Data.GI.Base.BasicTypes + (ManagedPtr(..), GObject) import Data.GI.Base.ManagedPtr (unsafeCastTo) -- @@ -176,11 +176,11 @@ getTreeViewFromGladeCustomStore builder name setupSeqStore = do --- wrapWidget :: GObject objClass => Builder - -> (ForeignPtr objClass -> objClass) + -> (ManagedPtr objClass -> objClass) -> Text -> IO (Text, objClass) wrapWidget builder constructor name = do putStrLn $ " cast " ++ T.unpack name - gobj <- nullToNothing (builderGetObject builder name) >>= unsafeCastTo constructor . fromJust + gobj <- builderGetObject builder name >>= unsafeCastTo constructor . fromJust return (name, gobj) getFromSeqStore :: (SeqStore a, TreeView) diff --git a/vcsgui/src/VCSGui/Common/Error.hs b/vcsgui/src/VCSGui/Common/Error.hs index debc796..574879c 100644 --- a/vcsgui/src/VCSGui/Common/Error.hs +++ b/vcsgui/src/VCSGui/Common/Error.hs @@ -19,22 +19,22 @@ module VCSGui.Common.Error ( ) where import Data.Text (Text) -import GI.Gtk.Objects.Dialog (dialogUseHeaderBar, dialogRun) +import GI.Gtk.Objects.Dialog (constructDialogUseHeaderBar, dialogRun) import GI.Gtk.Objects.Widget (widgetDestroy) -import Data.GI.Base (new) +import Data.GI.Base.GObject (new') import GI.Gtk.Objects.MessageDialog - (messageDialogMessageType, messageDialogButtons, + (constructMessageDialogMessageType, constructMessageDialogButtons, setMessageDialogText, MessageDialog(..)) import GI.Gtk.Enums (ButtonsType(..), MessageType(..)) -import Data.GI.Base.Attributes (AttrOp(..)) -- | Displays a simple window displaying given 'String' as an error message. showErrorGUI :: Text -- ^ Message to display. -> IO () showErrorGUI msg = do - dialog <- new MessageDialog [dialogUseHeaderBar := 0, - messageDialogMessageType := MessageTypeError, - messageDialogButtons := ButtonsTypeOk] + dialog <- new' MessageDialog [ + constructDialogUseHeaderBar 0, + constructMessageDialogMessageType MessageTypeError, + constructMessageDialogButtons ButtonsTypeOk] setMessageDialogText dialog msg _ <- dialogRun dialog widgetDestroy dialog diff --git a/vcsgui/src/VCSGui/Common/FilesInConflict.hs b/vcsgui/src/VCSGui/Common/FilesInConflict.hs index 7e5323d..3891131 100644 --- a/vcsgui/src/VCSGui/Common/FilesInConflict.hs +++ b/vcsgui/src/VCSGui/Common/FilesInConflict.hs @@ -37,13 +37,12 @@ import GI.Gtk.Objects.Action (onActionActivate) import GI.Gtk.Enums (ResponseType(..), FileChooserAction(..)) import GI.Gtk.Objects.Widget (widgetDestroy, widgetShowAll) import GI.Gtk.Objects.CellRendererText (cellRendererTextNew) -import Data.GI.Base.Attributes (AttrOp(..), AttrLabelProxy(..)) import GI.Gtk.Objects.CellRendererToggle (onCellRendererToggleToggled, cellRendererToggleNew) import GI.Gtk.Interfaces.TreeModel (treeModelGetIterFromString) import GI.Gtk.Objects.Builder (builderGetObject, Builder(..)) -import Data.GI.Base.BasicTypes (NullToNothing(..), GObject) -import Foreign.ForeignPtr (ForeignPtr) +import Data.GI.Base.BasicTypes + (ManagedPtr(..), GObject) import Data.GI.Base.ManagedPtr (unsafeCastTo) import Data.GI.Gtk.ModelView.SeqStore (seqStoreAppend, seqStoreClear, seqStoreToList, @@ -51,15 +50,14 @@ import Data.GI.Gtk.ModelView.SeqStore seqStoreNew, SeqStore(..)) import GI.Gtk.Objects.Window (setWindowTransientFor, setWindowTitle, Window(..)) -import Data.GI.Base (new, nullToNothing) +import Data.GI.Base.GObject (new') import GI.Gtk.Objects.FileChooserDialog (FileChooserDialog(..)) import GI.Gtk.Objects.Dialog (dialogRun, dialogAddButton) import GI.Gtk.Interfaces.FileChooser (fileChooserGetFilename, setFileChooserAction) import Data.Maybe (fromJust) - -_active = AttrLabelProxy :: AttrLabelProxy "active" -_text = AttrLabelProxy :: AttrLabelProxy "text" +import GI.Gtk + (setCellRendererToggleActive, setCellRendererTextText) -- -- glade path and object accessors @@ -186,13 +184,13 @@ defaultSetUpTreeView mbcwd conflictingFiles filesToResolveGetter resolveMarker e H.addColumnToTreeView' treeViewItem renderer "File" - $ \scf -> [_text := T.pack $ filePath scf] + $ \cell scf -> setCellRendererTextText cell . T.pack $ filePath scf renderer <- cellRendererToggleNew H.addColumnToTreeView' treeViewItem renderer "Resolved" - $ \scf -> [_active := isResolved scf] + $ \cell scf -> setCellRendererToggleActive cell $ isResolved scf -- connect select action onCellRendererToggleToggled renderer $ \(columnId :: Text) -> do @@ -251,11 +249,11 @@ getTreeViewFromGladeCustomStore builder name setupSeqStore = do --- wrapWidget :: GObject objClass => Builder - -> (ForeignPtr objClass -> objClass) + -> (ManagedPtr objClass -> objClass) -> Text -> IO (Text, objClass) wrapWidget builder constructor name = do putStrLn $ " cast " ++ T.unpack name - gobj <- nullToNothing (builderGetObject builder name) >>= unsafeCastTo constructor . fromJust + gobj <- builderGetObject builder name >>= unsafeCastTo constructor . fromJust return (name, gobj) getFromSeqStore :: (SeqStore a, TreeView) @@ -282,7 +280,7 @@ showFolderChooserDialog :: Text -- ^ title of the window -> FileChooserAction -> IO (Maybe FilePath) showFolderChooserDialog title parent fcAction = do - dialog <- new FileChooserDialog [] + dialog <- new' FileChooserDialog [] setWindowTitle dialog title dialogAddButton dialog "gtk-cancel" (fromIntegral $ fromEnum ResponseTypeCancel) dialogAddButton dialog "Select" (fromIntegral $ fromEnum ResponseTypeAccept) @@ -293,7 +291,7 @@ showFolderChooserDialog title parent fcAction = do ResponseTypeCancel -> widgetDestroy dialog >> return Nothing ResponseTypeDeleteEvent -> widgetDestroy dialog >> return Nothing ResponseTypeAccept -> do - f <- nullToNothing $ fileChooserGetFilename dialog + f <- fileChooserGetFilename dialog widgetDestroy dialog return f diff --git a/vcsgui/src/VCSGui/Common/GtkHelper.hs b/vcsgui/src/VCSGui/Common/GtkHelper.hs index 937bd51..3bc9aea 100644 --- a/vcsgui/src/VCSGui/Common/GtkHelper.hs +++ b/vcsgui/src/VCSGui/Common/GtkHelper.hs @@ -100,20 +100,17 @@ import qualified GI.Gtk.Objects.ToggleButton as Gtk import qualified GI.Gtk.Objects.Widget as Gtk (onWidgetDeleteEvent, widgetHide) import qualified GI.Gtk.Functions as Gtk (mainQuit) -import qualified GI.Gtk.Objects.CellRenderer as Gtk (CellRendererK) -import qualified Data.GI.Base.Attributes as Gtk - (AttrOpTag(..), AttrOp) +import qualified GI.Gtk.Objects.CellRenderer as Gtk (IsCellRenderer) import qualified GI.Gtk.Objects.TreeViewColumn as Gtk (treeViewColumnPackStart, setTreeViewColumnTitle, treeViewColumnNew) import qualified Data.GI.Gtk.ModelView.CellLayout as Gtk - (cellLayoutSetAttributes) + (cellLayoutSetDataFunction) import qualified GI.Gtk.Objects.CellRendererText as Gtk (cellRendererTextNew, CellRendererText(..)) import qualified Data.GI.Base.BasicTypes as Gtk (GObject) -import Foreign.ForeignPtr (ForeignPtr) import Data.GI.Base.ManagedPtr (unsafeCastTo) -import Data.GI.Base.BasicTypes (NullToNothing(..)) +import Data.GI.Base.BasicTypes (ManagedPtr(..)) import Data.Maybe (fromJust) -- Typesynonyms @@ -337,11 +334,11 @@ registerQuitWithCustomFun win fun = Gtk.onWidgetDeleteEvent (getItem win) (\_ -> -- | Add a column to given SeqStore and TreeView using a mapping. -- The mapping consists of a CellRenderer, the title and a function, that maps each row to attributes of the column -addColumnToTreeView :: Gtk.CellRendererK r => +addColumnToTreeView :: Gtk.IsCellRenderer r => TreeViewItem a -> r -- ^ CellRenderer -> Text -- ^ title - -> (a -> [Gtk.AttrOp r 'Gtk.AttrSet]) -- ^ mapping + -> (r -> a -> IO ()) -- ^ mapping -> IO () addColumnToTreeView (_, item, _) = do addColumnToTreeView' item @@ -352,23 +349,23 @@ addColumnToTreeView (_, item, _) = do -- Gtk.cellLayoutSetAttributes newCol renderer seqStore value2attributes -- | Same as 'addColumnToTreeView'. This function can be called without a complete 'TreeViewItem'. -addColumnToTreeView' :: Gtk.CellRendererK r => +addColumnToTreeView' :: Gtk.IsCellRenderer r => (Gtk.SeqStore a, Gtk.TreeView) -> r -> Text - -> (a -> [Gtk.AttrOp r 'Gtk.AttrSet]) + -> (r -> a -> IO ()) -> IO () addColumnToTreeView' (seqStore, listView) renderer title value2attributes = do newCol <- Gtk.treeViewColumnNew Gtk.setTreeViewColumnTitle newCol title Gtk.treeViewAppendColumn listView newCol Gtk.treeViewColumnPackStart newCol renderer True - Gtk.cellLayoutSetAttributes newCol renderer seqStore value2attributes + Gtk.cellLayoutSetDataFunction newCol renderer seqStore (value2attributes renderer) -- | Shortcut for adding text columns to a TreeView. See 'addColumnToTreeView'. addTextColumnToTreeView :: TreeViewItem a -> Text -- ^ title - -> (a -> [Gtk.AttrOp Gtk.CellRendererText 'Gtk.AttrSet]) -- ^ mapping + -> (Gtk.CellRendererText -> a -> IO ()) -- ^ mapping -> IO () addTextColumnToTreeView tree title map = do r <- Gtk.cellRendererTextNew @@ -377,7 +374,7 @@ addTextColumnToTreeView tree title map = do -- | Shortcut for adding text columns to a TreeView. See 'addColumnToTreeView\''. addTextColumnToTreeView' :: (Gtk.SeqStore a, Gtk.TreeView) -> Text - -> (a -> [Gtk.AttrOp Gtk.CellRendererText 'Gtk.AttrSet]) + -> (Gtk.CellRendererText -> a -> IO ()) -> IO () addTextColumnToTreeView' item title map = do r <- Gtk.cellRendererTextNew @@ -389,11 +386,11 @@ addTextColumnToTreeView' item title map = do wrapWidget :: Gtk.GObject objClass => Gtk.Builder - -> (ForeignPtr objClass -> objClass) + -> (ManagedPtr objClass -> objClass) -> Text -> IO (Text, objClass) wrapWidget builder constructor name = do hPutStrLn stderr $ " cast " ++ T.unpack name - gobj <- nullToNothing (Gtk.builderGetObject builder name) >>= unsafeCastTo constructor . fromJust + gobj <- Gtk.builderGetObject builder name >>= unsafeCastTo constructor . fromJust return (name, gobj) diff --git a/vcsgui/src/VCSGui/Common/Log.hs b/vcsgui/src/VCSGui/Common/Log.hs index 199a7a2..086f077 100644 --- a/vcsgui/src/VCSGui/Common/Log.hs +++ b/vcsgui/src/VCSGui/Common/Log.hs @@ -40,14 +40,11 @@ import qualified GI.Gtk.Interfaces.TreeModel as Gtk (treeModelGetPath, treeModelGetIterFirst, treeModelGetIter) import qualified Data.GI.Gtk.ModelView.SeqStore as Gtk (seqStoreIterToIndex, seqStoreGetValue, SeqStore(..)) -import qualified Data.GI.Base.Attributes as Gtk (AttrOp(..)) import qualified Data.GI.Gtk.ComboBox as Gtk (comboBoxSetActive, comboBoxPrependText) import qualified GI.Gtk.Objects.ComboBox as Gtk (onComboBoxChanged) -import GI.Gtk.Objects.TreeViewColumn (noTreeViewColumn) -import Data.GI.Base.Attributes (AttrLabelProxy(..)) - -_text = AttrLabelProxy :: AttrLabelProxy "text" +import GI.Gtk.Objects.TreeViewColumn (TreeViewColumn) +import qualified GI.Gtk as Gtk (setCellRendererTextText) getGladepath = getDataFileName "data/guiCommonLog.glade" @@ -76,7 +73,7 @@ showLogGUI :: [Common.LogEntry] -- ^ logEntries to be displayed initially -> [Text] -- ^ options will be displayed in a menu as checkboxes (TODO this is currently not implemented) - -> Maybe ((Text, [Text]), (Text -> Common.Ctx [Common.LogEntry])) + -> Maybe ((Maybe Text, [Text]), Text -> Common.Ctx [Common.LogEntry]) -- ^ (list of branchnames to display, Function called when a different branch is selected) -- -- The function will be called with the selected branchname to repopulate the displayed LogEntries. @@ -131,15 +128,15 @@ guiWithoutBranches logEntries options doCheckoutFn displayBranchNames = do setupLogColumns :: LogGUI -> Bool -> IO () setupLogColumns gui displayBranchNames = do let item = (logTreeView gui) - addTextColumnToTreeView item "Subject" (\Common.LogEntry { Common.subject = t } -> [_text Gtk.:= t]) - addTextColumnToTreeView item "Author" (\Common.LogEntry { Common.author = t, Common.email = mail } -> [_text Gtk.:= t <> " <" <> mail <> ">"]) - addTextColumnToTreeView item "Date" (\Common.LogEntry { Common.date = t } -> [_text Gtk.:= t]) + addTextColumnToTreeView item "Subject" (\cell Common.LogEntry { Common.subject = t } -> Gtk.setCellRendererTextText cell t) + addTextColumnToTreeView item "Author" (\cell Common.LogEntry { Common.author = t, Common.email = mail } -> Gtk.setCellRendererTextText cell $ t <> " <" <> mail <> ">") + addTextColumnToTreeView item "Date" (\cell Common.LogEntry { Common.date = t } -> Gtk.setCellRendererTextText cell t) case displayBranchNames of - True -> addTextColumnToTreeView item "Branch" (\Common.LogEntry { Common.mbBranch = t } -> [_text Gtk.:= fromMaybe "" t]) + True -> addTextColumnToTreeView item "Branch" (\cell Common.LogEntry { Common.mbBranch = t } -> Gtk.setCellRendererTextText cell $ fromMaybe "" t) False -> return() return () -guiAddBranches :: LogGUI -> (Text, [Text]) -> (Text -> Common.Ctx [Common.LogEntry]) -> Common.Ctx () +guiAddBranches :: LogGUI -> (Maybe Text, [Text]) -> (Text -> Common.Ctx [Common.LogEntry]) -> Common.Ctx () guiAddBranches gui (curBranch, otherBranches) changeBranchFn = do -- set branch selection visible liftIO $ Gtk.setWidgetVisible (getItem $ lblBranch gui) True @@ -147,7 +144,7 @@ guiAddBranches gui (curBranch, otherBranches) changeBranchFn = do -- fill with data® liftIO $ set (comboBranch gui) otherBranches - liftIO $ Gtk.comboBoxPrependText (getItem $ comboBranch gui) curBranch + forM_ curBranch $ Gtk.comboBoxPrependText (getItem $ comboBranch gui) liftIO $ Gtk.comboBoxSetActive (getItem $ comboBranch gui) 0 -- register branch switch fn @@ -165,7 +162,7 @@ guiAddBranches gui (curBranch, otherBranches) changeBranchFn = do Gtk.treeModelGetIterFirst store >>= \case (True, firstRowIter) -> do firstRow <- Gtk.treeModelGetPath store firstRowIter - Gtk.treeViewSetCursor view firstRow noTreeViewColumn False + Gtk.treeViewSetCursor view firstRow (Nothing :: Maybe TreeViewColumn) False _ -> return () diff --git a/vcsgui/src/VCSGui/Common/MergeTool.hs b/vcsgui/src/VCSGui/Common/MergeTool.hs index 5619ac0..1ad6926 100644 --- a/vcsgui/src/VCSGui/Common/MergeTool.hs +++ b/vcsgui/src/VCSGui/Common/MergeTool.hs @@ -11,18 +11,23 @@ -- | Types associated with resolving conflicts with a 'Mergetool'. -- ----------------------------------------------------------------------------- -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} module VCSGui.Common.MergeTool ( MergeTool (..) , MergeToolSetter ) where +import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) -- | Representation of a mergetool, e.g. kdiff3 -data MergeTool = MergeTool { +newtype MergeTool = MergeTool { fullPath :: FilePath - } deriving (Show, Read) + } deriving (Show, Read, Generic) + +instance ToJSON MergeTool +instance FromJSON MergeTool -- | Fn to set a 'MergeTool'. type MergeToolSetter = MergeTool -> IO() diff --git a/vcsgui/src/VCSGui/Common/SetupConfig.hs b/vcsgui/src/VCSGui/Common/SetupConfig.hs index 91052ff..9dd22b3 100644 --- a/vcsgui/src/VCSGui/Common/SetupConfig.hs +++ b/vcsgui/src/VCSGui/Common/SetupConfig.hs @@ -40,7 +40,7 @@ import GI.Gtk.Objects.Widget import GI.Gtk.Objects.ComboBox (comboBoxSetActive) import GI.Gtk.Objects.Window (setWindowTransientFor, setWindowTitle, Window(..)) -import Data.GI.Base (new, nullToNothing) +import Data.GI.Base (new) import GI.Gtk.Objects.FileChooserDialog (FileChooserDialog(..)) import GI.Gtk.Objects.Dialog (dialogRun, dialogAddButton) import GI.Gtk.Interfaces.FileChooser @@ -330,7 +330,7 @@ showFolderChooserDialog title parent fcAction = do ResponseTypeCancel -> widgetDestroy dialog >> return Nothing ResponseTypeDeleteEvent -> widgetDestroy dialog >> return Nothing ResponseTypeAccept -> do - f <- nullToNothing $ fileChooserGetFilename dialog + f <- fileChooserGetFilename dialog widgetDestroy dialog return f diff --git a/vcsgui/src/VCSGui/Git/Commit.hs b/vcsgui/src/VCSGui/Git/Commit.hs index 1fecacd..8336bb0 100644 --- a/vcsgui/src/VCSGui/Git/Commit.hs +++ b/vcsgui/src/VCSGui/Git/Commit.hs @@ -35,11 +35,9 @@ import Data.GI.Gtk.ModelView.SeqStore seqStoreNew, SeqStore(..)) import GI.Gtk.Objects.CellRendererToggle (onCellRendererToggleToggled, cellRendererToggleNew) -import Data.GI.Base.Attributes (AttrLabelProxy(..), AttrOp(..)) import GI.Gtk.Interfaces.TreeModel (treeModelGetIterFromString) - -_text = AttrLabelProxy :: AttrLabelProxy "text" -_active = AttrLabelProxy :: AttrLabelProxy "active" +import GI.Gtk + (setCellRendererTextText, setCellRendererToggleActive) doCommit :: Text -> [FilePath] -> [Commit.Option] -> Wrapper.Ctx () doCommit commitMsg files _ = do @@ -72,9 +70,9 @@ setupSeqStore view = do let item = (store, view) toggleRenderer <- cellRendererToggleNew - addColumnToTreeView' item toggleRenderer "Commit" (\(Commit.GITSCFile s _ _)-> [_active := s]) - addTextColumnToTreeView' item "File" (\(Commit.GITSCFile _ p _) -> [_text := T.pack p]) - addTextColumnToTreeView' item "File status" (\(Commit.GITSCFile _ _ m) -> [_text := m]) + 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 diff --git a/vcsgui/src/VCSGui/Git/Log.hs b/vcsgui/src/VCSGui/Git/Log.hs index 7d3e1f2..0a61284 100644 --- a/vcsgui/src/VCSGui/Git/Log.hs +++ b/vcsgui/src/VCSGui/Git/Log.hs @@ -28,11 +28,11 @@ import qualified Data.Text as T (unpack, pack) import Data.Text (Text) import qualified GI.Gtk.Objects.Dialog as Gtk (dialogRun, dialogGetContentArea, dialogAddButton, dialogNew) -import qualified GI.Gtk.Enums as Gtk (ResponseType(..)) +import qualified GI.Gtk.Enums as Gtk (ResponseType(..), Orientation(..)) import qualified GI.Gtk.Objects.Entry as Gtk (entryGetText, entryNew) import qualified GI.Gtk.Objects.Label as Gtk (labelNew) -import qualified GI.Gtk.Objects.HBox as Gtk (hBoxNew) +import qualified GI.Gtk.Objects.Box as Gtk (boxNew) import qualified GI.Gtk.Objects.Container as Gtk (containerAdd) import Data.GI.Base.ManagedPtr (unsafeCastTo) import GI.Gtk.Objects.Box (Box(..)) @@ -69,7 +69,7 @@ showLogGUI = do inputBranch <- Gtk.entryNew lblBranch <- Gtk.labelNew $ Just ("Enter a new branchname (empty for anonym branch):" :: Text) - box <- Gtk.hBoxNew False 2 + box <- Gtk.boxNew Gtk.OrientationHorizontal 2 Gtk.containerAdd upper box Gtk.containerAdd box lblBranch Gtk.containerAdd box inputBranch diff --git a/vcsgui/src/VCSGui/Mercurial/Commit.hs b/vcsgui/src/VCSGui/Mercurial/Commit.hs index 2aff915..8c901d3 100644 --- a/vcsgui/src/VCSGui/Mercurial/Commit.hs +++ b/vcsgui/src/VCSGui/Mercurial/Commit.hs @@ -35,11 +35,9 @@ import Data.GI.Gtk.ModelView.SeqStore seqStoreNew, SeqStore(..)) import GI.Gtk.Objects.CellRendererToggle (onCellRendererToggleToggled, cellRendererToggleNew) -import Data.GI.Base.Attributes (AttrLabelProxy(..), AttrOp(..)) import GI.Gtk.Interfaces.TreeModel (treeModelGetIterFromString) - -_text = AttrLabelProxy :: AttrLabelProxy "text" -_active = AttrLabelProxy :: AttrLabelProxy "active" +import qualified GI.Gtk as Gtk + (setCellRendererTextText, setCellRendererToggleActive) doCommit :: Text -> [FilePath] -> [Commit.Option] -> Wrapper.Ctx () doCommit commitMsg files _ = do @@ -68,9 +66,9 @@ setupSeqStore view = do let item = (store, view) toggleRenderer <- cellRendererToggleNew - addColumnToTreeView' item toggleRenderer "Commit" (\(Commit.GITSCFile s _ _)-> [_active := s]) - addTextColumnToTreeView' item "File" (\(Commit.GITSCFile _ p _) -> [_text := T.pack p]) - addTextColumnToTreeView' item "File status" (\(Commit.GITSCFile _ _ m) -> [_text := m]) + addColumnToTreeView' item toggleRenderer "Commit" (\cell (Commit.GITSCFile s _ _) -> Gtk.setCellRendererToggleActive cell s) + addTextColumnToTreeView' item "File" (\cell (Commit.GITSCFile _ p _) -> Gtk.setCellRendererTextText cell $ T.pack p) + addTextColumnToTreeView' item "File status" (\cell (Commit.GITSCFile _ _ m) -> Gtk.setCellRendererTextText cell m) -- register toggle renderer onCellRendererToggleToggled toggleRenderer $ \filepath -> do diff --git a/vcsgui/src/VCSGui/Svn/AskPassword.hs b/vcsgui/src/VCSGui/Svn/AskPassword.hs index a2b52c5..fe35fdb 100644 --- a/vcsgui/src/VCSGui/Svn/AskPassword.hs +++ b/vcsgui/src/VCSGui/Svn/AskPassword.hs @@ -38,7 +38,6 @@ import GI.Gtk.Objects.Widget import Data.GI.Base.Attributes (AttrOp(..)) import GI.Gtk.Objects.Builder (builderGetObject) import Data.GI.Base.ManagedPtr (unsafeCastTo) -import Data.GI.Base.BasicTypes (NullToNothing(..)) -- -- glade path and object accessors -- @@ -139,5 +138,5 @@ loadAskpassGUI = do setToggleButtonActive (H.getItem checkbtUsePw) True checkbtSaveForSession <- H.getCheckButtonFromGlade builder accessorCheckbtSaveForSession setToggleButtonActive (H.getItem checkbtSaveForSession) True - boxUsePw <- nullToNothing (builderGetObject builder accessorboxUsePwd) >>= unsafeCastTo VBox . fromJust + boxUsePw <- builderGetObject builder accessorboxUsePwd >>= unsafeCastTo VBox . fromJust return $ AskpassGUI windowAskpass actOk actCancel entryPw checkbtUsePw checkbtSaveForSession boxUsePw diff --git a/vcsgui/src/VCSGui/Svn/Commit.hs b/vcsgui/src/VCSGui/Svn/Commit.hs index b7b3780..3876418 100644 --- a/vcsgui/src/VCSGui/Svn/Commit.hs +++ b/vcsgui/src/VCSGui/Svn/Commit.hs @@ -38,12 +38,10 @@ import Data.GI.Gtk.ModelView.SeqStore seqStoreNew, SeqStore(..)) import GI.Gtk.Objects.CellRendererToggle (onCellRendererToggleToggled, cellRendererToggleNew) -import Data.GI.Base.Attributes (AttrOp(..), AttrLabelProxy(..)) import GI.Gtk.Interfaces.TreeModel (treeModelGetIterFromString) import GI.Gtk.Objects.CellRendererText (cellRendererTextNew) - -_active = AttrLabelProxy :: AttrLabelProxy "active" -_text = AttrLabelProxy :: AttrLabelProxy "text" +import GI.Gtk + (setCellRendererTextText, setCellRendererToggleActive) {- | Shows a GUI showing status of subversion and possibilites to commit/cancel. @@ -117,7 +115,7 @@ setUpTreeView listView = do H.addColumnToTreeView' treeViewItem renderer "" - $ \scf -> [_active := C.selected scf] + $ \cell scf -> setCellRendererToggleActive cell $ C.selected scf -- connect select action onCellRendererToggleToggled renderer $ \(columnId :: Text) -> do @@ -133,19 +131,19 @@ setUpTreeView listView = do H.addColumnToTreeView' treeViewItem renderer "Files to commit" - $ \scf -> [_text := T.pack $ C.filePath scf] + $ \cell scf -> setCellRendererTextText cell . T.pack $ C.filePath scf renderer <- cellRendererTextNew H.addColumnToTreeView' treeViewItem renderer "Status" - $ \scf -> [_text := C.status scf] + $ \cell scf -> setCellRendererTextText cell $ C.status scf renderer <- cellRendererToggleNew H.addColumnToTreeView' treeViewItem renderer "Locked" - $ \scf -> [_active := C.isLocked scf] + $ \cell scf -> setCellRendererToggleActive cell $ C.isLocked scf return seqStore where ctxSelect status = status == Svn.Added || status == Svn.Deleted || status==Svn.Modified || diff --git a/vcsgui/vcsgui.cabal b/vcsgui/vcsgui.cabal index a404c9c..a12d4d3 100644 --- a/vcsgui/vcsgui.cabal +++ b/vcsgui/vcsgui.cabal @@ -1,5 +1,5 @@ name: vcsgui -version: 0.2.0.0 +version: 0.3.0.0 cabal-version: >=1.8 build-type: Simple license: GPL @@ -35,19 +35,6 @@ library VCSGui.Git VCSGui.Svn VCSGui.Mercurial - build-depends: - filepath >=1.2.0.0 && <1.5, - base >=4.0.0.0 && <4.10, - directory >=1.1.0.0 && <1.3, - mtl >=2.0.1.0 && <2.3, - vcswrapper >=0.1.1 && <0.2, - process >=1.0.1.5 && <1.5, - text -any, - haskell-gi-base >=0.17 && <0.18, - gi-gtk >=3.0.2 && <3.1, - gi-gtk-hs >=0.2.0.0 && <0.3 - hs-source-dirs: src - other-modules: VCSGui.Svn.Helper VCSGui.Common.Process VCSGui.Common.ConflictsResolved @@ -74,47 +61,39 @@ library VCSGui.Common.Helpers Paths_vcsgui + build-depends: + aeson >=1.1.2.0 && <1.6, + filepath >=1.2.0.0 && <1.5, + base >=4.0.0.0 && <4.15, + directory >=1.1.0.0 && <1.4, + mtl >=2.0.1.0 && <2.3, + vcswrapper >=0.2.0 && <0.3, + process >=1.0.1.5 && <1.7, + text -any, + haskell-gi-base >=0.20 && <0.26, + gi-gtk >=3.0.6 && <3.1, + gi-gtk-hs >=0.3.0.0 && <0.4 + hs-source-dirs: src + executable vcsgui if os(osx) ghc-options: -optl-headerpad_max_install_names main-is: Main.hs build-depends: + aeson >=1.1.2.0 && <1.6, filepath >=1.2.0.0 && <1.5, - base >=4.0.0.0 && <4.10, - directory >=1.1.0.0 && <1.3, + base >=4.0.0.0 && <4.15, + directory >=1.1.0.0 && <1.4, mtl >=2.0.1.0 && <2.3, - vcswrapper >=0.1.1 && <0.2, - process >=1.0.1.5 && <1.5, + vcswrapper >=0.2.0 && <0.3, + process >=1.0.1.5 && <1.7, text -any, - haskell-gi-base >=0.17 && <0.18, - gi-gtk >=3.0.2 && <3.1, - gi-gtk-hs >=0.2.0.0 && <0.3 + haskell-gi-base >=0.20 && <0.26, + gi-gtk >=3.0.6 && <3.1, + gi-gtk-hs >=0.3.0.0 && <0.4, + vcsgui hs-source-dirs: src - other-modules: - VCSGui.Svn.Helper - VCSGui.Common.Process - VCSGui.Common.ConflictsResolved - VCSGui.Common.MergeTool - VCSGui.Common.FilesInConflict - VCSGui.Git.Pull - VCSGui.Svn.Update - VCSGui.Svn.AskPassword - VCSGui - VCSGui.Svn.Log - VCSGui.Svn.Checkout - VCSGui.Svn.Commit - VCSGui.Git.Log - VCSGui.Git.Helpers - VCSGui.Git.Commit - VCSGui.Common.Log - VCSGui.Common.GtkHelper - VCSGui.Common.ExceptionHandler - VCSGui.Common.SetupConfig - VCSGui.Common.Error - VCSGui.Common.Commit - VCSGui.Common.Helpers - Paths_vcsgui executable vcsgui-askpass @@ -122,27 +101,17 @@ executable vcsgui-askpass ghc-options: -optl-headerpad_max_install_names main-is: Main.hs build-depends: + aeson >=1.1.2.0 && <1.6, filepath >=1.2.0.0 && <1.5, - base >=4.0.0.0 && <4.10, - directory >=1.1.0.0 && <1.3, + base >=4.0.0.0 && <4.15, + directory >=1.1.0.0 && <1.4, mtl >=2.0.1.0 && <2.3, - vcswrapper >=0.1.1 && <0.2, - process >=1.0.1.5 && <1.5, + vcswrapper >=0.2.0 && <0.3, + process >=1.0.1.5 && <1.7, text -any, - haskell-gi-base >=0.17 && <0.18, - gi-gtk >=3.0.2 && <3.1, - gi-gtk-hs >=0.2.0.0 && <0.3 - hs-source-dirs: src/exe/askpass src - other-modules: - VCSGui.Svn.Helper - VCSGui.Common.Process - VCSGui.Common.ConflictsResolved - VCSGui.Common.MergeTool - VCSGui.Common.FilesInConflict - VCSGui.Git.Pull - VCSGui.Svn.Update - VCSGui.Svn.AskPassword - Paths_vcsgui - VCSGui.Common.GtkHelper - VCSGui.Common.Helpers + haskell-gi-base >=0.20 && <0.26, + gi-gtk >=3.0.6 && <3.1, + gi-gtk-hs >=0.3.0.0 && <0.4, + vcsgui + hs-source-dirs: src/exe/askpass