From fc2f25cfa68dad22472907320e4654f4b5fdb03d Mon Sep 17 00:00:00 2001
From: sheaf <sam.derbyshire@gmail.com>
Date: Fri, 6 Sep 2024 18:48:04 +0200
Subject: [PATCH] UI: use GTK4 FileDialog API

---
 src/app/MetaBrush/Action.hs | 117 ++++++++++++++++++------------------
 1 file changed, 60 insertions(+), 57 deletions(-)

diff --git a/src/app/MetaBrush/Action.hs b/src/app/MetaBrush/Action.hs
index dc16f86..87d6b80 100644
--- a/src/app/MetaBrush/Action.hs
+++ b/src/app/MetaBrush/Action.hs
@@ -203,38 +203,40 @@ data OpenFile = OpenFile !TabLocation
 
 instance HandleAction OpenFile where
   handleAction uiElts@( UIElements {..} ) vars@( Variables {..} ) ( OpenFile tabLoc ) = do
-    -- GTK 4 TODO: use FileDialog
-    fileChooser <-
-      GTK.fileChooserNativeNew ( Just "Open MetaBrush document..." ) ( Just window )
-        GTK.FileChooserActionOpen
-        ( Just "Open" )
-        ( Just "Cancel" )
-    GTK.fileChooserSetSelectMultiple fileChooser True
-    GTK.fileChooserSetAction fileChooser GTK.FileChooserActionOpen
-    GTK.nativeDialogSetModal fileChooser True
+    fileDialog <- GTK.fileDialogNew
+    GTK.fileDialogSetTitle fileDialog "Open MetaBrush document..."
+    GTK.fileDialogSetModal fileDialog True
+    GTK.fileDialogSetAcceptLabel fileDialog (Just "Open")
+
     fileFilter <- GTK.fileFilterNew
-    GTK.fileFilterSetName fileFilter ( Just "MetaBrush document" )
+    GTK.fileFilterSetName fileFilter (Just "MetaBrush document")
     GTK.fileFilterAddPattern fileFilter "*.mb"
-    GTK.fileChooserAddFilter fileChooser fileFilter
-    GTK.nativeDialogShow fileChooser
-    void $ GTK.afterNativeDialogResponse fileChooser \ response -> do
-      when ( response == fromIntegral ( fromEnum GTK.ResponseTypeAccept ) ) do
-        files <- GTK.fileChooserGetFiles fileChooser
-        nbFiles <- GIO.listModelGetNItems files
-        fileNames <- catMaybes <$>
-          for [ ( 0 :: Int ) .. fromIntegral nbFiles - 1 ] \ i ->
-            GIO.listModelGetItem files ( fromIntegral i ) >>?=
-              ( GI.castTo GIO.File >=?=> GIO.fileGetPath )
-        for_ fileNames \ filePath -> do
-          mbDoc <- loadDocument uniqueSupply filePath
-          case mbDoc of
-            Left errMessage -> warningDialog window filePath errMessage
-            Right doc -> do
-              let
-                newDocHist :: DocumentHistory
-                newDocHist = newHistory doc
-              newFileTab uiElts vars ( Just newDocHist ) tabLoc
-              updateHistoryState uiElts ( Just newDocHist )
+    GTK.setFileDialogDefaultFilter fileDialog fileFilter
+    fileFilterType <- GTK.gvalueGType_ @(Maybe GTK.FileFilter)
+    filterList <- GIO.listStoreNew fileFilterType
+    void $ GIO.listStoreAppend filterList fileFilter
+    GTK.fileDialogSetFilters fileDialog (Just filterList)
+
+    GTK.fileDialogOpenMultiple fileDialog (Just window) (Nothing :: Maybe GIO.Cancellable) $
+      Just $ \ _ result -> do
+        response <- GTK.handleDialogError (\ _ _ -> return Nothing) $
+                    GTK.fileDialogOpenMultipleFinish fileDialog result
+        case response of
+          Just files -> do
+            nbFiles <- GIO.listModelGetNItems files
+            fileNames <- catMaybes <$>
+              for [ ( 0 :: Int ) .. fromIntegral nbFiles - 1 ] \ i ->
+                GIO.listModelGetItem files ( fromIntegral i ) >>?=
+                  ( GI.castTo GIO.File >=?=> GIO.fileGetPath )
+            for_ fileNames $ \ filePath -> do
+              mbDoc <- loadDocument uniqueSupply filePath
+              case mbDoc of
+                Left errMessage -> warningDialog window filePath errMessage
+                Right doc -> do
+                  let newDocHist = newHistory doc
+                  newFileTab uiElts vars (Just newDocHist) tabLoc
+                  updateHistoryState uiElts (Just newDocHist)
+          Nothing -> return ()
 
 warningDialog
   :: ( Show errMess, GTK.IsWindow window )
@@ -265,18 +267,16 @@ data OpenFolder = OpenFolder !TabLocation
 
 instance HandleAction OpenFolder where
   handleAction uiElts@( UIElements {..} ) vars@( Variables {..} ) ( OpenFolder tabLoc ) = do
-    -- GTK 4 TODO: use FileDialog
-    fileChooser <-
-      GTK.fileChooserNativeNew ( Just "Select folder..." ) ( Just window )
-        GTK.FileChooserActionSelectFolder
-        ( Just "Select Folder" )
-        ( Just "Cancel" )
-    GTK.fileChooserSetAction fileChooser GTK.FileChooserActionSelectFolder
-    GTK.nativeDialogSetModal fileChooser True
-    GTK.nativeDialogShow fileChooser
-    void $ GTK.afterNativeDialogResponse fileChooser \ response -> do
-      when ( response == fromIntegral ( fromEnum GTK.ResponseTypeAccept ) ) do
-        mbFolder <- GTK.fileChooserGetFile fileChooser
+
+    fileDialog <- GTK.fileDialogNew
+    GTK.fileDialogSetTitle fileDialog "Select folder..."
+    GTK.fileDialogSetModal fileDialog True
+    GTK.fileDialogSetAcceptLabel fileDialog (Just "Open")
+
+    GTK.fileDialogSelectFolder fileDialog (Just window) (Nothing :: Maybe GIO.Cancellable) $
+      Just $ \ _ result -> do
+        mbFolder <- GTK.handleDialogError (\ _ _ -> return Nothing) $
+                    GTK.fileDialogSelectFolderFinish fileDialog result
         for_ mbFolder \ folder -> do
           mbFolderPath <- GIO.fileGetPath folder
           for_ mbFolderPath \ folderPath -> do
@@ -364,23 +364,26 @@ export uiElts vars@( Variables { .. } ) = do
 
 withSavePath :: UIElements -> SaveFormat -> ( FilePath -> IO () ) -> IO ()
 withSavePath ( UIElements {..} ) saveFormat action = do
-  -- GTK 4 TODO: use FileDialog
-  fileChooser <-
-    GTK.fileChooserNativeNew ( Just saveText ) ( Just window )
-      GTK.FileChooserActionSave
-      ( Just saveOrExport )
-      ( Just "Cancel" )
-  GTK.nativeDialogSetModal fileChooser True
-  GTK.fileChooserSetAction fileChooser GTK.FileChooserActionSave
+  fileDialog <- GTK.fileDialogNew
+  GTK.fileDialogSetTitle fileDialog saveText
+  GTK.fileDialogSetModal fileDialog True
+  GTK.fileDialogSetAcceptLabel fileDialog (Just "Open")
+
   fileFilter <- GTK.fileFilterNew
-  GTK.fileFilterSetName fileFilter ( Just $ Text.pack $ show saveFormat <> " document" )
+  GTK.fileFilterSetName fileFilter (Just $ Text.pack $ show saveFormat <> " document")
+
   GTK.fileFilterAddPattern fileFilter ( "*." <> extension )
-  GTK.fileChooserAddFilter fileChooser fileFilter
-  GTK.nativeDialogShow fileChooser
-  void $ GTK.afterNativeDialogResponse fileChooser \ response -> do
-    when ( response == fromIntegral ( fromEnum GTK.ResponseTypeAccept ) ) do
-      mbSaveFile <- GTK.fileChooserGetFile fileChooser
-      for_ mbSaveFile \ saveFile -> do
+  GTK.setFileDialogDefaultFilter fileDialog fileFilter
+  fileFilterType <- GTK.gvalueGType_ @(Maybe GTK.FileFilter)
+  filterList <- GIO.listStoreNew fileFilterType
+  void $ GIO.listStoreAppend filterList fileFilter
+  GTK.fileDialogSetFilters fileDialog (Just filterList)
+
+  GTK.fileDialogSave fileDialog (Just window) (Nothing :: Maybe GIO.Cancellable) $
+    Just $ \ _ result -> do
+      mbSaveFile <- GTK.handleDialogError (\ _ _ -> return Nothing) $
+                    GTK.fileDialogSaveFinish fileDialog result
+      for_ mbSaveFile $ \ saveFile -> do
         mbSavePath <- fmap fullFilePath <$> GIO.fileGetPath saveFile
         for_ mbSavePath action
   where