From 828eff69b5c13c5595833c35e0a353464633fea3 Mon Sep 17 00:00:00 2001
From: Sven Bartscher <sven.bartscher@weltraumschlangen.de>
Date: Mon, 16 Dec 2019 20:41:14 +0100
Subject: [PATCH] Change signalAddHandler to return an `AddHandler` without
 `IO`
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Since an `AddHandler` already allows doing `IO` “inside” it, the outer
`IO` is not necessary.
---
 .../reactive-banana-gi-gtk.cabal                |  2 +-
 .../src/Reactive/Banana/GI/Gtk.hs               | 17 ++++++++---------
 2 files changed, 9 insertions(+), 10 deletions(-)

diff --git a/reactive-banana-gi-gtk/reactive-banana-gi-gtk.cabal b/reactive-banana-gi-gtk/reactive-banana-gi-gtk.cabal
index 3a94e32..18d9bcf 100644
--- a/reactive-banana-gi-gtk/reactive-banana-gi-gtk.cabal
+++ b/reactive-banana-gi-gtk/reactive-banana-gi-gtk.cabal
@@ -17,7 +17,7 @@ library
   build-depends:       base >= 4.7 && < 5,
                        reactive-banana < 1.3
                      , gi-gtk >= 3.0.1.1 && < 5.0
-                     , haskell-gi-base >= 0.20 && < 0.26
+                     , haskell-gi-base >= 0.22 && < 0.26
                      , transformers >= 0.5.2.0 && < 0.6
                      , text >= 1.2.2.1 && < 1.3
   default-language:    Haskell2010
diff --git a/reactive-banana-gi-gtk/src/Reactive/Banana/GI/Gtk.hs b/reactive-banana-gi-gtk/src/Reactive/Banana/GI/Gtk.hs
index 3786cd1..f613cb3 100644
--- a/reactive-banana-gi-gtk/src/Reactive/Banana/GI/Gtk.hs
+++ b/reactive-banana-gi-gtk/src/Reactive/Banana/GI/Gtk.hs
@@ -24,7 +24,6 @@ import Reactive.Banana.Frameworks
 
 import Data.Typeable
 import Control.Exception
-import Control.Monad.IO.Class
 import Data.Maybe (fromJust)
 import qualified Data.Text as T
 import Data.Text (Text)
@@ -48,6 +47,7 @@ import Data.GI.Base.Overloading
 import Data.GI.Base.Signals
     ( SignalInfo(..)
     , GObjectNotifySignalInfo(..)
+    , disconnectSignalHandler
     )
 import GI.Gtk
     ( GObject
@@ -91,11 +91,11 @@ signalAddHandler
     -> SignalProxy self info
     -> ((a -> IO b) -> HaskellCallbackType info)
     -> b
-    -> IO (AddHandler a)
-signalAddHandler self signal f b = do
-    (addHandler, fire) <- newAddHandler
-    on self signal (f $ \x -> fire x >> return b)
-    return addHandler
+    -> AddHandler a
+signalAddHandler self signal f b =
+  AddHandler $ \fire ->
+  on self signal (f $ \x -> fire x >> return b) >>=
+  pure . disconnectSignalHandler self
 
 -- | Create an 'Reactive.Banana.Event' from
 -- a 'Data.GI.Base.Signals.SignalProxy'. For making signalE# functions.
@@ -111,9 +111,8 @@ signalEN
     -> ((a -> IO b) -> HaskellCallbackType info)
     -> b
     -> MomentIO (Event a)
-signalEN self signal f b = do
-    addHandler <- liftIO $ signalAddHandler self signal f b
-    fromAddHandler addHandler
+signalEN self signal f b =
+    fromAddHandler $ signalAddHandler self signal f b
 
 -- | Get an 'Reactive.Banana.Event' from
 -- a 'Data.GI.Base.Signals.SignalProxy' that produces nothing.