diff --git a/app/Documents.hs b/app/Documents.hs --- a/app/Documents.hs +++ b/app/Documents.hs @@ -10,9 +10,9 @@ import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Builder (Builder) import Data.Text.Lazy.Builder qualified as Builder -import Desktop.Portal (Client, directory) +import Desktop.Portal (Client, FileSpec (..), directory) import Desktop.Portal qualified as Portal -import Desktop.Portal.Documents (DocumentId (..), FileIdentifier (..)) +import Desktop.Portal.Documents (DocumentId (..)) import Desktop.Portal.Documents qualified as Documents import Desktop.Portal.FileChooser (OpenFileResults) import Monomer @@ -129,7 +129,7 @@ filePath <- (<> "/hello.txt") <$> Portal.getXdgDataHome writeFile filePath "Hello!" catchErrors "Add File Failed" emit $ do - void (Documents.add model.portalClient (DocumentFilePath filePath) True True) + void (Documents.add model.portalClient (FileSpecPath filePath) True True) emit RefreshDocuments ] ShowAlert {title, body} -> diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE QuasiQuotes #-} - module Main (main) where import Control.Exception (SomeException, catch) @@ -10,22 +8,23 @@ import Data.Sequence qualified as Seq import Data.Text (Text, pack, unpack) import Data.Word (Word32) -import Desktop.Portal (AddNotificationOptions (..), Client, GetUserInformationOptions (..), GetUserInformationResults (..), NotificationButton (..), NotificationIcon (..), NotificationPriority (..), Request, addNotificationOptions, openURIOptions) +import Desktop.Portal (AddNotificationOptions (..), Client, GetUserInformationOptions (..), GetUserInformationResults (..), NotificationButton (..), NotificationIcon (..), NotificationPriority (..), Request, addNotificationOptions) import Desktop.Portal qualified as Portal import Desktop.Portal.Settings (ReadAllOptions (..), ReadAllResults) import Desktop.Portal.Settings qualified as Settings import Documents (documents) import Monomer import Monomer.Hagrid +import OpenURI (openURI) import Paths_monomer_flatpak_example (getDataFileName) import System.Directory (getCurrentDirectory, getHomeDirectory, listDirectory) import System.Environment (getEnvironment) -import Text.URI.QQ (uri) data AppModel = AppModel { portalClient :: Client, fileSystem :: Seq EnvironmentInfo, environmentVariables :: Seq EnvironmentInfo, + showOpenURI :: Bool, showDocuments :: Bool, alertContents :: AlertContents } @@ -55,7 +54,7 @@ | AddNotification | ReadSettings | ReadSettingsFinish ReadAllResults - | OpenURI + | SetShowOpenURI Bool | SetShowDocuments Bool | RequestFailed Text | CancelRequest @@ -75,6 +74,7 @@ { portalClient, fileSystem = mempty, environmentVariables = mempty, + showOpenURI = False, showDocuments = False, alertContents = AlertNotShown } @@ -107,7 +107,7 @@ button "Documents" (SetShowDocuments True), button "Add Notification" AddNotification, button "Read Settings" ReadSettings, - button "Open URI" OpenURI + button "Open URI" (SetShowOpenURI True) ] `styleBasic` [padding 5], hagrid @@ -121,16 +121,25 @@ ] model.environmentVariables ], + maybeOpenURI, maybeDocuments, -- nodeKey to workaround https://github.com/fjvallarino/monomer/issues/265 maybeAlert `nodeKey` pack (show model.alertContents) ] + maybeOpenURI + | model.showOpenURI = + alert_ + (SetShowOpenURI False) + [titleCaption "OpenURI Portal"] + (openURI model.portalClient ShowAlertMessage `styleBasic` [padding 20]) + | otherwise = spacer `nodeVisible` False + maybeDocuments | model.showDocuments = alert_ (SetShowDocuments False) - [titleCaption "Documents"] + [titleCaption "Documents Portal"] (documents model.portalClient ShowAlertMessage `styleBasic` [padding 20]) | otherwise = spacer `nodeVisible` False @@ -223,6 +232,8 @@ [Model model {alertContents = AlertRequestingUserInformation res}] GetUserInformationFinish info -> [Model model {alertContents = AlertUserInformation info}] + SetShowOpenURI showOpenURI -> + [Model model {showOpenURI}] SetShowDocuments showDocuments -> [Model model {showDocuments}] AddNotification -> @@ -247,11 +258,6 @@ ] ReadSettingsFinish results -> [Model model {alertContents = AlertSettings results}] - OpenURI -> - [ Producer $ \emit -> - catchRequestErrors emit $ do - void (Portal.openURI model.portalClient (openURIOptions [uri|https://www.bbc.com/weather|])) - ] ShowAlertMessage {title, body} -> [Model model {alertContents = AlertMessage {title, body}}] CancelRequest -> diff --git a/app/OpenURI.hs b/app/OpenURI.hs new file mode 100644 --- /dev/null +++ b/app/OpenURI.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE QuasiQuotes #-} + +module OpenURI (openURI) where + +import Control.Exception (SomeException, catch) +import Control.Monad (void) +import Data.Text (Text, pack) +import Desktop.Portal (Client, FileSpec (..)) +import Desktop.Portal qualified as Portal +import Desktop.Portal.OpenURI (openURIOptions) +import Desktop.Portal.OpenURI qualified as OpenURI +import Monomer +import System.Directory (createDirectoryIfMissing) +import Text.URI (URI, render) +import Text.URI.QQ (uri) + +newtype OpenURIModel = OpenURIModel + { portalClient :: Client + } + deriving (Eq, Show) + +data OpenURIEvent + = OpenURI + | OpenFile + | OpenDirectory + | ShowAlert {title :: Text, body :: Text} + +weatherURI :: URI +weatherURI = [uri|https://www.bbc.co.uk/weather/ox1|] + +openURI :: (CompParentModel s, CompositeEvent e) => Client -> (Text -> Text -> e) -> WidgetNode s e +openURI portalClient parentAlert = + compositeD_ "MonomerFlatpakExample.OpenURI" (WidgetValue initialModel) buildUI (handleEvent parentAlert) [] + where + initialModel = OpenURIModel {portalClient} + +buildUI :: UIBuilder OpenURIModel OpenURIEvent +buildUI _wenv _model = + vstack_ + [childSpacing] + [ label ("Open URI: " <> render weatherURI), + button "Open URI" OpenURI, + spacer, + label "Open new text file with other app.", + button "Open File" OpenFile, + spacer, + label "Open new directory with file browser.", + button "Open Directory" OpenDirectory + ] + +handleEvent :: (Text -> Text -> ep) -> EventHandler OpenURIModel OpenURIEvent sp ep +handleEvent parentAlert _env _node model = \case + OpenURI -> + [ Producer $ \emit -> + catchErrors "Open URI Failed" emit $ do + void (Portal.openURI model.portalClient (openURIOptions weatherURI)) + ] + OpenFile -> + [ Producer $ \emit -> do + catchErrors "Open File Failed" emit $ do + filePath <- (<> "/hello.txt") <$> Portal.getXdgDataHome + writeFile filePath "Hello!" + void $ OpenURI.openFile model.portalClient (OpenURI.openFileOptions (FileSpecPath filePath)) + ] + OpenDirectory -> + [ Producer $ \emit -> do + catchErrors "Open Directory Failed" emit $ do + dirPath <- (<> "/hello-directory") <$> Portal.getXdgDataHome + let filePath = dirPath <> "/hello.txt" + createDirectoryIfMissing True dirPath + writeFile filePath "Hello!" + void $ OpenURI.openDirectory model.portalClient (OpenURI.openDirectoryOptions (FileSpecPath dirPath)) + ] + ShowAlert {title, body} -> + [Report (parentAlert title body)] + +catchErrors :: Text -> (OpenURIEvent -> IO ()) -> IO () -> IO () +catchErrors title emit cmd = catch cmd handler + where + handler (e :: SomeException) = + emit (ShowAlert title (pack (show e))) diff --git a/assets/io.github.Dretch.MonomerFlatpakExample.metainfo.xml b/assets/io.github.Dretch.MonomerFlatpakExample.metainfo.xml --- a/assets/io.github.Dretch.MonomerFlatpakExample.metainfo.xml +++ b/assets/io.github.Dretch.MonomerFlatpakExample.metainfo.xml @@ -23,6 +23,11 @@ + + + Add a demo of OpenFile and OpenDirectory from the OpenURI portal. + + diff --git a/monomer-flatpak-example.cabal b/monomer-flatpak-example.cabal --- a/monomer-flatpak-example.cabal +++ b/monomer-flatpak-example.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: monomer-flatpak-example -version: 0.0.10.0 +version: 0.0.11.0 license: MIT license-file: LICENSE maintainer: garethdanielsmith@gmail.com @@ -29,6 +29,7 @@ hs-source-dirs: app other-modules: Documents + OpenURI Paths_monomer_flatpak_example default-language: Haskell2010 @@ -48,7 +49,7 @@ containers <0.7, data-default-class <0.2, dbus <1.4, - desktop-portal <0.3, + desktop-portal <0.4, directory <1.4, modern-uri <0.4, monomer <1.6,