Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Add a button / hook for reverting to default settings #25

Merged
merged 2 commits into from
Apr 6, 2021
Merged

Add a button / hook for reverting to default settings #25

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
9949c2e
Add a button / hook for reverting to default settings
peddie Mar 31, 2021
b14c550
Optional reversion
peddie Apr 6, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
11 changes: 10 additions & 1 deletion examples/SetExample.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -105,6 +105,13 @@ main = do
void $ CC.putMVar upMsg (Just (k, x))
putStrLn "downstream finished commit"

revertToDefaults :: Int -> DTree -> IO ()
revertToDefaults k _x = void $ do
putStrLn "downstream starting to revert to defaults"
CC.threadDelay 500000
void $ CC.putMVar upMsg (Just (k, toDData initialFoo))
putStrLn "downstream finished revert to defaults"

pollForNewMessage :: IO (Maybe (Int, DTree))
pollForNewMessage = do
mx <- CC.tryTakeMVar downMsg
Expand All @@ -113,4 +120,6 @@ main = do
Just _ -> putStrLn "downstream poll got msg"
return mx

runSetter Nothing "settings" (toDData initialFoo) pollForNewMessage refresh commit
-- If you don't want to support "revert-to-default" functionality, just pass `Nothing` in place of
-- @`pure` revertToDefaults@
runSetter Nothing "settings" (toDData initialFoo) pollForNewMessage refresh commit $ pure revertToDefaults
25 changes: 23 additions & 2 deletions src/SetHo.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -39,8 +39,8 @@ defaultSetHoConfig =
}

-- | fire up the the GUI
runSetter :: Maybe SetHoConfig -> String -> DTree -> IO (Maybe (Int, DTree)) -> (Int -> IO ()) -> (Int -> DTree -> IO ()) -> IO ()
runSetter mconfig rootName initialValue userPollForNewMessage sendRequest userCommit = do
runSetter :: Maybe SetHoConfig -> String -> DTree -> IO (Maybe (Int, DTree)) -> (Int -> IO ()) -> (Int -> DTree -> IO ()) -> Maybe (Int -> DTree -> IO ()) -> IO ()
runSetter mconfig rootName initialValue userPollForNewMessage sendRequest userCommit userRevertToDefaults = do
let config = case mconfig of
Just r -> r
Nothing -> defaultSetHoConfig
Expand Down Expand Up @@ -100,6 +100,7 @@ runSetter mconfig rootName initialValue userPollForNewMessage sendRequest userCo
buttonCommit <- Gtk.buttonNewWithLabel "commit"
buttonRefresh <- Gtk.buttonNewWithLabel "refresh"
buttonTakeUpstream <- Gtk.buttonNewWithLabel "take upstream"
buttonRevertToDefaults <- Gtk.buttonNewWithLabel "revert to defaults"
Gtk.widgetSetTooltipText buttonCommit
(Just "SET ME SET ME GO HEAD DO IT COME ON SET ME")
buttonDiff <- Gtk.buttonNewWithLabel "diff"
Expand Down Expand Up @@ -176,6 +177,8 @@ runSetter mconfig rootName initialValue userPollForNewMessage sendRequest userCo
, Gtk.boxChildPacking buttonTakeUpstream := Gtk.PackNatural
, Gtk.containerChild := buttonDiff
, Gtk.boxChildPacking buttonDiff := Gtk.PackNatural
, Gtk.containerChild := buttonRevertToDefaults
, Gtk.boxChildPacking buttonRevertToDefaults := Gtk.PackNatural
, Gtk.containerChild := options
, Gtk.boxChildPacking options := Gtk.PackNatural
, Gtk.containerChild := treeviewExpander
Expand All @@ -194,6 +197,24 @@ runSetter mconfig rootName initialValue userPollForNewMessage sendRequest userCo

_ <- on buttonDiff Gtk.buttonActivated printDiff

-- How to revert to defaults
let revertToDefaults val = case userRevertToDefaults of
Nothing -> pure ()
Just userRevertAction -> do
counter <- readIORef counterRef
putStrLn $ "sending revert-to-default message " ++ show counter
writeIORef counterRef $ 1 + counter
makeStatsMessage >>= Gtk.labelSetText statsLabel
userRevertAction counter val

-- It's a bit puzzling to provide the latest staged information to the user revert action, but it
-- may be quite convenient to provide a meaningful value depending on how the settings
-- communication protocol works. For example, a channel that cannot represent sum types like
-- `Maybe` cannot use `Nothing` to request a revert; it may have to send up a meaningful value to
-- produce a well-formed message to the the upstream system, even if that value isn't used.
_ <- on buttonRevertToDefaults Gtk.buttonActivated
$ getLatestStaged >>= revertToDefaults

let pollForNewMessage = do
mmsg <- userPollForNewMessage
case mmsg of
Expand Down