monomer-flatpak-example 0.0.7.0 → 0.0.8.0
raw patch · 3 files changed
+80/−32 lines, 3 filesdep ~desktop-portal
Dependency ranges changed: desktop-portal
Files
- app/Main.hs +77/−30
- assets/io.github.Dretch.MonomerFlatpakExample.metainfo.xml +1/−0
- monomer-flatpak-example.cabal +2/−2
app/Main.hs view
@@ -1,15 +1,17 @@ module Main (main) where +import Control.Exception (SomeException, catch) import Control.Monad (void) import DBus (Variant, toVariant) import Data.Default.Class (def)-import Data.Maybe (fromMaybe) import Data.Sequence (Seq) import Data.Sequence qualified as Seq import Data.Text (Text, intercalate, pack, unpack) import Data.Word (Word32) import Desktop.Portal (AddNotificationOptions (..), Client, GetUserInformationOptions (..), GetUserInformationResults (..), NotificationButton (..), NotificationIcon (..), NotificationPriority (..), OpenFileResults (..), Request, addNotificationOptions) import Desktop.Portal qualified as Portal+import Desktop.Portal.Settings (ReadAllOptions (..), ReadAllResults)+import Desktop.Portal.Settings qualified as Settings import Monomer import Monomer.Hagrid import Paths_monomer_flatpak_example (getDataFileName)@@ -37,6 +39,8 @@ | AlertUserInformation GetUserInformationResults | AlertRequestingOpenFile (Request OpenFileResults) | AlertOpenFile OpenFileResults+ | AlertSettings ReadAllResults+ | AlertRequestFailed Text deriving (Eq, Show) data AppEvent@@ -49,6 +53,9 @@ | OpenFileStart (Request OpenFileResults) | OpenFileFinish OpenFileResults | AddNotification+ | ReadSettings+ | ReadSettingsFinish ReadAllResults+ | RequestFailed Text | CancelRequest | CloseAlert @@ -95,7 +102,8 @@ [ label "Portals:", button "Get User Information" GetUserInformation, button "Open File" OpenFile,- button "Add Notification" AddNotification+ button "Add Notification" AddNotification,+ button "Read Settings" ReadSettings ] `styleBasic` [padding 5], hagrid@@ -136,6 +144,16 @@ CloseAlert [titleCaption "Open File Response"] (openFileAlertContents results `styleBasic` [padding 20])+ AlertSettings results ->+ alert_+ CloseAlert+ [titleCaption "Read Settings Response"]+ (settingsAlertContents results `styleBasic` [height 400, width 800, padding 10])+ AlertRequestFailed msg ->+ alert_+ CloseAlert+ [titleCaption "Portal error"]+ (label_ msg [multiline] `styleBasic` [padding 20]) userInfoAlertContents results = vstack_@@ -143,17 +161,27 @@ [ label "Request successful.", label ("User Id: " <> results.id), label ("User Name: " <> results.name),- label ("User Image: " <> fromMaybe "[none]" results.image)+ label ("User Image: " <> maybe "[none]" pack results.image) ] openFileAlertContents results = vstack_ [childSpacing] [ label "Request successful.",- label ("Selected URIs: " <> intercalate ", " results.uris),+ label ("Selected Files: " <> intercalate ", " (pack <$> results.uris)), label ("Selected Choices: " <> pack (show results.choices)) ] + settingsAlertContents :: ReadAllResults -> WidgetNode () AppEvent+ settingsAlertContents results =+ hagrid+ [ (textColumn "Namespace" (.namespace)) {initialWidth = 200},+ (textColumn "Key" (.key)) {initialWidth = 200},+ (textColumn "Value" (pack . show . (.value))) {initialWidth = 200},+ (textColumn "Standard Value" (pack . show . (.standardValue))) {initialWidth = 500}+ ]+ (Seq.fromList results.values)+ valueColumn :: Int -> EnvironmentInfo -> WidgetNode s e valueColumn _ix model = label_ model.value [multiline, ellipsis]@@ -184,16 +212,17 @@ [Model model {fileSystem, environmentVariables}] GetUserInformation -> [ Producer $ \emit -> do- res <-- Portal.getUserInformation- model.portalClient- def- { reason = Just "Allows FlatpakMonomerExample to show user information."- }- emit (GetUserInformationStart res)- Portal.await res >>= \case- Nothing -> emit CloseAlert- Just result -> emit (GetUserInformationFinish result)+ catchRequestErrors emit $ do+ req <-+ Portal.getUserInformation+ model.portalClient+ def+ { reason = Just "Allows FlatpakMonomerExample to show user information."+ }+ emit (GetUserInformationStart req)+ Portal.await req >>= \case+ Nothing -> emit CloseAlert+ Just result -> emit (GetUserInformationFinish result) ] GetUserInformationStart res -> [Model model {alertContents = AlertRequestingUserInformation res}]@@ -201,29 +230,39 @@ [Model model {alertContents = AlertUserInformation info}] OpenFile -> [ Producer $ \emit -> do- res <- Portal.openFile model.portalClient def- emit (OpenFileStart res)- Portal.await res >>= \case- Nothing -> emit CloseAlert- Just result -> emit (OpenFileFinish result)+ catchRequestErrors emit $ do+ req <- Portal.openFile model.portalClient def+ emit (OpenFileStart req)+ Portal.await req >>= \case+ Nothing -> emit CloseAlert+ Just result -> emit (OpenFileFinish result) ] OpenFileStart res -> [Model model {alertContents = AlertRequestingOpenFile res}] OpenFileFinish results -> [Model model {alertContents = AlertOpenFile results}] AddNotification ->- [ Producer $ \_emit -> do- Portal.addNotification model.portalClient $- (addNotificationOptions "testNotification")- { title = Just "Test Notification",- body = Just "Hello!",- priority = Just NotificationPriorityLow,- icon = Just (NotificationIconThemed ["weather-snow", "zoom-in"]),- defaultAction = Just "testDefaultAction",- defaultActionTarget = Just (toVariant ("wibble" :: Text, 42 :: Word32)),- buttons = Just [NotificationButton {label_ = "Click Me", action = "testButtonAction", target = Nothing}]- }+ [ Producer $ \emit -> do+ catchRequestErrors emit $+ Portal.addNotification model.portalClient $+ (addNotificationOptions "testNotification")+ { title = Just "Test Notification",+ body = Just "Hello!",+ priority = Just NotificationPriorityLow,+ icon = Just (NotificationIconThemed ["weather-snow", "zoom-in"]),+ defaultAction = Just "testDefaultAction",+ defaultActionTarget = Just (toVariant ("wibble" :: Text, 42 :: Word32)),+ buttons = Just [NotificationButton {label_ = "Click Me", action = "testButtonAction", target = Nothing}]+ } ]+ ReadSettings ->+ [ Producer $ \emit ->+ catchRequestErrors emit $ do+ result <- Settings.readAll model.portalClient (ReadAllOptions [])+ emit (ReadSettingsFinish result)+ ]+ ReadSettingsFinish results ->+ [Model model {alertContents = AlertSettings results}] CancelRequest -> let cancel = case model.alertContents of AlertRequestingOpenFile res ->@@ -234,6 +273,14 @@ in cancel <> [Model model {alertContents = AlertNotShown}] CloseAlert -> [Model model {alertContents = AlertNotShown}]+ RequestFailed msg ->+ [Model model {alertContents = AlertRequestFailed msg}]++catchRequestErrors :: (AppEvent -> IO ()) -> IO () -> IO ()+catchRequestErrors emit cmd = catch cmd handler+ where+ handler (e :: SomeException) =+ emit (RequestFailed . pack . show $ e) handleNotificationAction :: Text -> Text -> Maybe Variant -> IO () handleNotificationAction notificationId action actionTarget = do
assets/io.github.Dretch.MonomerFlatpakExample.metainfo.xml view
@@ -23,6 +23,7 @@ </screenshots> <releases>+ <release version="0.0.8.0" date="2023-05-26"/> <release version="0.0.7.0" date="2023-05-03"/> <release version="0.0.6.0" date="2023-04-22"/> <release version="0.0.5.1" date="2023-04-10"/>
monomer-flatpak-example.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: monomer-flatpak-example-version: 0.0.7.0+version: 0.0.8.0 license: MIT license-file: LICENSE maintainer: garethdanielsmith@gmail.com@@ -45,7 +45,7 @@ containers <0.7, data-default-class <0.2, dbus <1.3,- desktop-portal <0.2,+ desktop-portal <0.3, directory <1.4, monomer <1.6, monomer-hagrid <0.4,