Simplify tuning

4 files changed, 33 insertions, 17 deletions

diff --git a/src/Gtk/Tune.dcl b/src/Gtk/Tune.dcl
index 63ad69d..b970659 100644
--- a/src/Gtk/Tune.dcl
+++ b/src/Gtk/Tune.dcl
@@ -4,10 +4,13 @@ from Gtk.State import :: StateT, :: Identity, :: State, :: GtkState, :: GtkM
 from Gtk.Types import :: GtkCSSClass, :: GtkMargins
 from Gtk.Widgets import :: GtkWidget, class gtkWidget
 
-class tune elem option :: !(GtkM elem) !option -> GtkM elem
+class tune elem option :: !option !elem -> GtkM elem
 
-(<<@) infixl 2
-(<<@) elem option :== tune elem option
+instance tune elem (oa,ob)       | tune elem oa & tune elem ob
+instance tune elem (oa,ob,oc)    | tune elem oa & tune elem ob & tune elem oc
+instance tune elem (oa,ob,oc,od) | tune elem oa & tune elem ob & tune elem oc & tune elem od
+
+(<<@) infixl 2 :: !(GtkM elem) !option -> GtkM elem | tune elem option
 
 instance tune w GtkMargins | gtkWidget w
 instance tune w GtkCSSClass | gtkWidget w
diff --git a/src/Gtk/Tune.icl b/src/Gtk/Tune.icl
index c5846af..a6d9b0e 100644
--- a/src/Gtk/Tune.icl
+++ b/src/Gtk/Tune.icl
@@ -1,5 +1,7 @@
 implementation module Gtk.Tune
 
+import StdEnv
+
 import Control.Applicative
 import Control.Monad
 import Control.Monad.Identity
@@ -7,16 +9,25 @@ import Control.Monad.State
 
 import Gtk
 
+instance tune elem (oa,ob)       | tune elem oa & tune elem ob
+where
+	tune (a,b) elem = tune a elem >>= tune b
+
+instance tune elem (oa,ob,oc)    | tune elem oa & tune elem ob & tune elem oc
+where
+	tune (a,b,c) elem = tune a elem >>= tune b >>= tune c
+
+instance tune elem (oa,ob,oc,od) | tune elem oa & tune elem ob & tune elem oc & tune elem od
+where
+	tune (a,b,c,d) elem = tune a elem >>= tune b >>= tune c >>= tune d
+
+(<<@) infixl 2 :: !(GtkM elem) !option -> GtkM elem | tune elem option
+(<<@) elemf option = elemf >>= tune option
+
 instance tune w GtkMargins | gtkWidget w
 where
-	tune widgetf margins =
-		widgetf >>= \widget ->
-		setMargins margins widget >>|
-		pure widget
+	tune margins widget = setMargins margins widget
 
 instance tune w GtkCSSClass | gtkWidget w
 where
-	tune widgetf cls =
-		widgetf >>= \widget ->
-		addCSSClass cls widget >>|
-		pure widget
+	tune cls widget = addCSSClass cls widget
diff --git a/src/Gtk/Widgets.dcl b/src/Gtk/Widgets.dcl
index d217730..2403b40 100644
--- a/src/Gtk/Widgets.dcl
+++ b/src/Gtk/Widgets.dcl
@@ -22,9 +22,9 @@ class gtkWidget a :: !a -> GtkWidget
 instance gtkWidget GtkWidget
 instance ptr GtkWidget
 
-addCSSClass :: !GtkCSSClass !w -> GtkM () | gtkWidget w
+addCSSClass :: !GtkCSSClass !w -> GtkM w | gtkWidget w
 removeCSSClass :: !GtkCSSClass !w -> GtkM () | gtkWidget w
-setMargins :: !GtkMargins !w -> GtkM () | gtkWidget w
+setMargins :: !GtkMargins !w -> GtkM w | gtkWidget w
 show :: !w -> GtkM w | gtkWidget w
 
 :: GtkContainer
diff --git a/src/Gtk/Widgets.icl b/src/Gtk/Widgets.icl
index 2e7c1de..869293e 100644
--- a/src/Gtk/Widgets.icl
+++ b/src/Gtk/Widgets.icl
@@ -24,23 +24,25 @@ where
 	toPtr   w = w
 	fromPtr w = w
 
-addCSSClass :: !GtkCSSClass !w -> GtkM () | gtkWidget w
+addCSSClass :: !GtkCSSClass !w -> GtkM w | gtkWidget w
 addCSSClass (Class cls) widget =
 	toStateR ('I'.gtk_widget_get_style_context (gtkWidget widget)) >>= \context ->
-	toState ('I'.gtk_style_context_add_class context cls)
+	toState ('I'.gtk_style_context_add_class context cls) >>|
+	pure widget
 
 removeCSSClass :: !GtkCSSClass !w -> GtkM () | gtkWidget w
 removeCSSClass (Class cls) widget =
 	toStateR ('I'.gtk_widget_get_style_context (gtkWidget widget)) >>= \context ->
 	toState ('I'.gtk_style_context_remove_class context cls)
 
-setMargins :: !GtkMargins !w -> GtkM () | gtkWidget w
+setMargins :: !GtkMargins !w -> GtkM w | gtkWidget w
 setMargins {left,top,right,bottom} widget` =
 	let widget = gtkWidget widget` in
 	toState ('I'.gtk_widget_set_margin_left   widget left)   >>|
 	toState ('I'.gtk_widget_set_margin_top    widget top)    >>|
 	toState ('I'.gtk_widget_set_margin_right  widget right)  >>|
-	toState ('I'.gtk_widget_set_margin_bottom widget bottom)
+	toState ('I'.gtk_widget_set_margin_bottom widget bottom) >>|
+	pure widget`
 
 show :: !w -> GtkM w | gtkWidget w
 show widget = toState ('I'.gtk_widget_show (gtkWidget widget)) >>| pure widget