Add support for file choosers

1 files changed, 43 insertions, 5 deletions

diff --git a/src/Gtk/Widgets.icl b/src/Gtk/Widgets.icl
index 117fa49..5c8f1e6 100644
--- a/src/Gtk/Widgets.icl
+++ b/src/Gtk/Widgets.icl
@@ -11,9 +11,8 @@ import Data.Tuple
 import System.FilePath
 import System._Pointer
 
+import Gtk
 import Gtk.Internal
-import Gtk.State
-import Gtk.Types
 
 :: GtkWidget :== Pointer
 
@@ -24,6 +23,12 @@ where
 	toPtr   w = w
 	fromPtr w = w
 
+show :: !w -> GtkM w | gtkWidget w
+show widget = toState (gtk_widget_show (gtkWidget widget)) >>| pure widget
+
+destroy :: !w -> GtkM () | gtkWidget w
+destroy widget = toState (gtk_widget_destroy (gtkWidget widget))
+
 addCSSClass :: !GtkCSSClass !w -> GtkM w | gtkWidget w
 addCSSClass (Class cls) widget =
 	toStateR (gtk_widget_get_style_context (gtkWidget widget)) >>= \context ->
@@ -44,9 +49,6 @@ setMargins {left,top,right,bottom} widget` =
 	toState (gtk_widget_set_margin_bottom widget bottom) >>|
 	pure widget`
 
-show :: !w -> GtkM w | gtkWidget w
-show widget = toState (gtk_widget_show (gtkWidget widget)) >>| pure widget
-
 :: GtkContainer :== Pointer
 
 instance gtkWidget GtkContainer where gtkWidget c = c
@@ -62,6 +64,42 @@ addToContainer container widget =
 	toState (gtk_container_add (gtkContainer container) (gtkWidget widget)) >>|
 	pure widget
 
+:: GtkDialog :== Pointer
+
+instance gtkWidget GtkDialog where gtkWidget d = d
+instance gtkContainer GtkDialog where gtkContainer d = d
+instance gtkDialog GtkDialog where gtkDialog d = d
+
+instance ptr GtkDialog
+where
+	toPtr   d = d
+	fromPtr d = d
+
+runDialog :: !d -> GtkM GtkResponse | gtkDialog d
+runDialog dialog = fromInt <$> toStateR (gtk_dialog_run (gtkDialog dialog))
+
+getFileWithDialog :: !GtkWindow !GtkFileChooserAction !(Maybe String) -> GtkM (Maybe FilePath)
+getFileWithDialog window action title =
+	toStateR (gtk_file_chooser_dialog_new title window (toInt action) buttons) >>= \dialog ->
+	toState (gtk_dialog_set_default_response dialog (toInt ResponseAccept)) >>|
+	run dialog
+where
+	buttons = map (\(s,r) -> (s,toInt r)) case action of
+		OpenAction         -> [("Cancel", ResponseCancel), ("Open",   ResponseAccept)]
+		SaveAction         -> [("Cancel", ResponseCancel), ("Save",   ResponseAccept)]
+		SelectFolderAction -> [("Cancel", ResponseCancel), ("Select", ResponseAccept)]
+		CreateFolderAction -> [("Cancel", ResponseCancel), ("Create", ResponseAccept)]
+
+	run dialog =
+		runDialog dialog >>= \response -> case response of
+			ResponseAccept ->
+				toStateR (gtk_file_chooser_get_filename dialog) >>= \file_name -> case file_name of
+					Just _  -> destroy dialog >>| pure file_name
+					Nothing -> run dialog
+			_ ->
+				destroy dialog >>|
+				pure Nothing
+
 :: GtkBox :== Pointer
 
 instance gtkWidget GtkBox where gtkWidget b = b