diff --git a/linux-notification-center.cabal b/linux-notification-center.cabal index 51a87f8..145a16a 100644 --- a/linux-notification-center.cabal +++ b/linux-notification-center.cabal @@ -35,7 +35,6 @@ library , Helpers build-depends: base >= 4.7 && < 5 , regex-tdfa - , gtk3 >= 0.15.4 , transformers , cairo , haskell-gi @@ -45,7 +44,7 @@ library , gi-glib >= 2.0.17 , gi-gdk , gi-gdkpixbuf - , gi-gtk >= 3.0.19 + , gi-gtk >= 4.0.3 , gi-gio , time , system-locale diff --git a/src/Helpers.hs b/src/Helpers.hs index 277c132..2004edb 100644 --- a/src/Helpers.hs +++ b/src/Helpers.hs @@ -189,3 +189,8 @@ parseHtmlEntities = _ -> matched in a ++ repl ++ (if length c > 0 then parseNamedEntities c else "") in parseAsciiEntities . parseNamedEntities + +(=< (a -> n (Maybe b)) -> Maybe a -> n (Maybe b) +(=< Int -> Int -> String -> String -> IO Button createButton config width height command description = do - button <- buttonNew - label <- labelNew $ Just $ Text.pack description - widgetSetSizeRequest button (fromIntegral width) (fromIntegral height) + button <- Gtk.buttonNew + label <- Gtk.labelNew $ Just $ Text.pack description + Gtk.widgetSetSizeRequest button (fromIntegral width) (fromIntegral height) addClass button "userbutton" addClass button "deadd-noti-center" - buttonSetRelief button ReliefStyleNone - setWidgetMargin button $ fromIntegral $ configButtonMargin config - widgetSetHalign label AlignStart - widgetSetValign label AlignEnd - addClass label "userbuttonlabel" - addClass label "deadd-noti-center" + Gtk.buttonSetHasFrame button False + Gtk.setWidgetMarginTop button $ fromIntegral $ configButtonMargin config + Gtk.setWidgetMarginBottom button $ fromIntegral $ configButtonMargin config + Gtk.setWidgetMarginStart button $ fromIntegral $ configButtonMargin config + Gtk.setWidgetMarginEnd button $ fromIntegral $ configButtonMargin config + Gtk.widgetSetHalign label AlignStart + Gtk.widgetSetValign label AlignEnd + Gtk.widgetAddCssClass label "userbuttonlabel" + Gtk.widgetAddCssClass label "deadd-noti-center" let theButton = Button { buttonButton = button , buttonLabel = label , buttonCommand = command } - onButtonClicked button $ do + Gtk.onButtonClicked button $ do addSource $ do setButtonState2 $ theButton return False runCommand command return () - Gtk.containerAdd button label + Gtk.buttonSetChild button $ Just label return theButton setButtonState2 :: Button -> IO () diff --git a/src/NotificationCenter/Notifications/AbstractNotification.hs b/src/NotificationCenter/Notifications/AbstractNotification.hs index 68ae48f..c9eebf6 100644 --- a/src/NotificationCenter/Notifications/AbstractNotification.hs +++ b/src/NotificationCenter/Notifications/AbstractNotification.hs @@ -26,22 +26,11 @@ import Control.Lens.TH (makeClassy) import Control.Lens (view, set) import Control.Monad (when) -import GI.Gtk (rangeGetValue, onRangeValueChanged, rangeSetValue, widgetShowAll, widgetHide, windowMove, widgetDestroy - , widgetSetValign, widgetSetMarginStart, widgetSetMarginEnd - , widgetSetMarginTop, widgetSetMarginBottom, labelSetText - , labelSetMarkup, widgetSetSizeRequest, labelSetXalign - , widgetGetPreferredHeightForWidth, onWidgetButtonPressEvent - , imageSetFromPixbuf, imageSetFromIconName, setWidgetWidthRequest - , setImagePixelSize, widgetSetMarginStart, widgetSetMarginEnd - , progressBarSetFraction, widgetSetVisible - , catchGErrorJustDomain, GErrorMessage(..)) +import qualified GI.Gtk as Gtk import GI.GLib (FileError(..)) import GI.GdkPixbuf (pixbufScaleSimple, pixbufGetHeight, pixbufGetWidth , Pixbuf(..), pixbufNewFromFileAtScale , InterpType(..), PixbufError(..)) -import qualified GI.Gtk as Gtk - (Scale, ProgressBar, IsWidget, Box(..), Label(..), Button(..), Window(..), Image(..) - , Builder(..), containerAdd, containerRemove, containerGetChildren) import GI.Gtk.Enums (Align(..)) data DisplayingNotificationContent = DisplayingNotificationContent @@ -84,18 +73,18 @@ createNotification config builder noti dispNoti = do scale <- scale objs "scale" -- set margins from config - widgetSetMarginTop imgImage + Gtk.widgetSetMarginTop imgImage (fromIntegral $ configImgMarginTop config) - widgetSetMarginBottom imgImage + Gtk.widgetSetMarginBottom imgImage (fromIntegral $ configImgMarginBottom config) - widgetSetMarginStart imgImage + Gtk.widgetSetMarginStart imgImage (fromIntegral $ configImgMarginLeft config) - widgetSetMarginEnd imgImage + Gtk.widgetSetMarginEnd imgImage (fromIntegral $ configImgMarginRight config) - onWidgetButtonPressEvent container $ \(_) -> do - notiOnAction noti "default" Nothing - return False + -- Gtk.onWidgetButtonPressEvent container $ \(_) -> do + -- notiOnAction noti "default" Nothing + -- return False return @@ -122,17 +111,25 @@ setUrgencyLevel urgency elems = do return () +removeChildren :: Gtk.Box -> IO () +removeChildren w = do + mc <- Gtk.widgetGetFirstChild w + case mc of + Nothing -> return () + (Just c) -> do Gtk.boxRemove w c + removeChildren w + updateNotiContent :: HasDisplayingNotificationContent dn => Config -> Notification -> dn -> IO () updateNotiContent config noti dNoti = do - labelSetText (view dLabelTitel dNoti) $ notiSummary noti + Gtk.labelSetText (view dLabelTitel dNoti) $ notiSummary noti if (configNotiMarkup config) then do - labelSetMarkup (view dLabelBody dNoti) $ markupify $ notiBody noti + Gtk.labelSetMarkup (view dLabelBody dNoti) $ markupify $ notiBody noti else do - labelSetText (view dLabelBody dNoti) $ notiBody noti - labelSetText (view dLabelAppname dNoti) $ notiAppName noti - labelSetXalign (view dLabelTitel dNoti) 0 - labelSetXalign (view dLabelBody dNoti) 0 + Gtk.labelSetText (view dLabelBody dNoti) $ notiBody noti + Gtk.labelSetText (view dLabelAppname dNoti) $ notiAppName noti + Gtk.labelSetXalign (view dLabelTitel dNoti) 0 + Gtk.labelSetXalign (view dLabelBody dNoti) 0 let iconSize = 15 imageSize = 100 setImage (notiIcon noti) (fromIntegral $ configIconSize config) @@ -148,33 +145,32 @@ updateNotiContent config noti dNoti = do && (notiPercentage noti == Nothing || a /= "changeValue")) $ takeTwo (unpack <$> notiActions noti)) - currentButtons <- Gtk.containerGetChildren (view dActions dNoti) - sequence $ Gtk.containerRemove (view dActions dNoti) <$> currentButtons - sequence $ Gtk.containerAdd (view dActions dNoti) <$> actionButton <$> actionButtons + removeChildren (view dActions dNoti) + sequence $ Gtk.boxAppend (view dActions dNoti) <$> actionButton <$> actionButtons - widgetShowAll (view dActions dNoti) + Gtk.widgetShow (view dActions dNoti) if (notiPercentage noti /= Nothing) then do if (onChangeAction == Nothing) then do - progressBarSetFraction (view dProgressbar dNoti) + Gtk.progressBarSetFraction (view dProgressbar dNoti) ((fromMaybe 0 $ notiPercentage noti) / 100.0) - widgetSetVisible (view dProgressbar dNoti) True - widgetSetVisible (view dScale dNoti) False + Gtk.widgetSetVisible (view dProgressbar dNoti) True + Gtk.widgetSetVisible (view dScale dNoti) False return () else do - rangeSetValue (view dScale dNoti) + Gtk.rangeSetValue (view dScale dNoti) (fromMaybe 0 $ notiPercentage noti) - onRangeValueChanged (view dScale dNoti) $ do - value <- rangeGetValue (view dScale dNoti) + Gtk.onRangeValueChanged (view dScale dNoti) $ do + value <- Gtk.rangeGetValue (view dScale dNoti) (notiOnAction noti) "changeValue" $ Just $ show value return () - widgetSetVisible (view dScale dNoti) True - widgetSetVisible (view dProgressbar dNoti) False + Gtk.widgetSetVisible (view dScale dNoti) True + Gtk.widgetSetVisible (view dProgressbar dNoti) False return () else do - widgetSetVisible (view dProgressbar dNoti) False - widgetSetVisible (view dScale dNoti) False + Gtk.widgetSetVisible (view dProgressbar dNoti) False + Gtk.widgetSetVisible (view dScale dNoti) False return () where onChangeAction = atMay (Prelude.filter (\(a, b) -> a == "changeValue") @@ -188,27 +184,27 @@ setImage :: Image -> Int32 -> Gtk.Image -> IO () setImage image imageSize widget = do case image of NoImage -> do - widgetSetMarginStart widget 0 - widgetSetMarginEnd widget 0 + Gtk.widgetSetMarginStart widget 0 + Gtk.widgetSetMarginEnd widget 0 (ImagePath path) -> do - pb <- catchGErrorJustDomain - (catchGErrorJustDomain + pb <- Gtk.catchGErrorJustDomain + (Gtk.catchGErrorJustDomain (Just <$> pixbufNewFromFileAtScale path imageSize imageSize True) ((\err message -> return Nothing) - :: PixbufError -> GErrorMessage -> IO (Maybe Pixbuf))) + :: PixbufError -> Gtk.GErrorMessage -> IO (Maybe Pixbuf))) ((\err message -> return Nothing) - :: FileError -> GErrorMessage -> IO (Maybe Pixbuf)) + :: FileError -> Gtk.GErrorMessage -> IO (Maybe Pixbuf)) case pb of - (Just pb') -> imageSetFromPixbuf widget (Just pb') + (Just pb') -> Gtk.imageSetFromPixbuf widget (Just pb') Nothing -> return () (NamedIcon name) -> do - imageSetFromIconName widget - (Just $ pack name) imageSize - setImagePixelSize widget imageSize + Gtk.imageSetFromIconName widget + (Just $ pack name) + Gtk.setImagePixelSize widget imageSize (RawImg a) -> do pb <- rawImgToPixBuf $ RawImg a pb' <- scalePixbuf imageSize imageSize pb - imageSetFromPixbuf widget pb' + Gtk.imageSetFromPixbuf widget pb' scalePixbuf :: Int32 -> Int32 -> Pixbuf -> IO (Maybe Pixbuf) diff --git a/src/NotificationCenter/Notifications/Action.hs b/src/NotificationCenter/Notifications/Action.hs index 4572471..7642a9e 100644 --- a/src/NotificationCenter/Notifications/Action.hs +++ b/src/NotificationCenter/Notifications/Action.hs @@ -8,33 +8,10 @@ module NotificationCenter.Notifications.Action import Config (Config(..)) import TransparentWindow -import GI.Gtk - (widgetSetHalign, widgetSetHexpand, buttonNew, setWidgetMargin - , buttonSetRelief, widgetSetSizeRequest, widgetShowAll, widgetShow - , widgetHide, onWidgetDestroy - , windowSetDefaultSize, setWindowTitle, boxPackStart, boxNew - , setWindowWindowPosition, WindowPosition(..), windowMove - , frameSetShadowType, aspectFrameNew - , widgetGetAllocatedHeight, widgetGetAllocatedWidth, onWidgetDraw - , onWidgetLeaveNotifyEvent, onWidgetMotionNotifyEvent - , widgetAddEvents, alignmentSetPadding, alignmentNew, rangeSetValue - , scaleSetDigits, scaleSetValuePos, rangeGetValue - , afterScaleButtonValueChanged, scaleNewWithRange, containerAdd - , buttonBoxNew, mainQuit, onButtonActivate - , toggleButtonGetActive, onToggleButtonToggled, buttonSetUseStock - , toggleButtonNewWithLabel, onButtonClicked - , buttonNewWithLabel, widgetQueueDraw, drawingAreaNew - , windowNew, widgetDestroy, dialogRun, setAboutDialogComments - , setAboutDialogAuthors, setAboutDialogVersion - , setAboutDialogProgramName, aboutDialogNew, labelNew, get - , afterWindowSetFocus, labelSetText - , onWidgetFocusOutEvent, onWidgetKeyReleaseEvent, widgetGetParentWindow - , onButtonClicked, windowGetScreen, boxNew, widgetSetValign - , imageNewFromIconName) +import qualified GI.Gtk as Gtk import GI.Gtk.Enums - (Orientation(..), PositionType(..), ReliefStyle(..), Align(..), IconSize(..)) + (Orientation(..), PositionType(..), Align(..), IconSize(..)) -import qualified GI.Gtk as Gtk (containerAdd, Box(..), Label(..), Button(..)) import qualified Data.Text as Text import System.Process (runCommand) @@ -47,27 +24,30 @@ data Action = Action createAction :: Config -> Bool -> (String -> Maybe String -> IO ()) -> Int -> Int -> String -> String -> IO Action createAction config useIcons onAction width height command description = do - button <- buttonNew - widgetSetSizeRequest button (fromIntegral width) (fromIntegral height) + button <- Gtk.buttonNew + Gtk.widgetSetSizeRequest button (fromIntegral width) (fromIntegral height) addClass button "userbutton" addClass button "deadd-noti-center" - buttonSetRelief button ReliefStyleNone - setWidgetMargin button $ fromIntegral $ configButtonMargin config + Gtk.buttonSetHasFrame button False + Gtk.setWidgetMarginTop button $ fromIntegral $ configButtonMargin config + Gtk.setWidgetMarginBottom button $ fromIntegral $ configButtonMargin config + Gtk.setWidgetMarginStart button $ fromIntegral $ configButtonMargin config + Gtk.setWidgetMarginEnd button $ fromIntegral $ configButtonMargin config -- widgetSetHalign label AlignStart -- widgetSetValign label AlignEnd let theButton = Action { actionButton = button , actionCommand = command } - onButtonClicked button $ do + Gtk.onButtonClicked button $ do onAction command Nothing return () if useIcons && configActionIcons config then do - img <-imageNewFromIconName (Just $ Text.pack description) (fromIntegral $ fromEnum IconSizeButton) - Gtk.containerAdd button img + img <- Gtk.imageNewFromIconName (Just $ Text.pack description) + Gtk.buttonSetChild button $ Just img else do - label <- labelNew $ Just $ Text.pack description + label <- Gtk.labelNew $ Just $ Text.pack description addClass label "userbuttonlabel" addClass label "deadd-noti-center" - Gtk.containerAdd button label + Gtk.buttonSetChild button $ Just label return theButton diff --git a/src/NotificationCenter/Notifications/NotificationPopup.hs b/src/NotificationCenter/Notifications/NotificationPopup.hs index 5d04a23..a80a2fc 100644 --- a/src/NotificationCenter/Notifications/NotificationPopup.hs +++ b/src/NotificationCenter/Notifications/NotificationPopup.hs @@ -31,11 +31,8 @@ import Data.Maybe ( fromMaybe, isJust ) import Control.Monad import DBus ( Variant (..) ) -import GI.Gdk (getEventButtonButton) -import GI.Gtk (widgetShow, widgetGetPreferredHeightForWidth, widgetSetSizeRequest - , widgetShowAll, onWidgetButtonPressEvent, windowMove - , setWidgetWidthRequest, widgetDestroy , labelGetText - , labelSetText, labelGetLayout) +import qualified GI.Gdk as Gdk +import qualified GI.Gtk as Gtk import GI.Pango.Enums (EllipsizeMode(..)) import GI.Pango.Objects.Layout (layoutGetLinesReadonly, layoutGetLineCount) import GI.Pango.Structs.LayoutLine (getLayoutLineLength, getLayoutLineStartIndex) @@ -84,7 +81,7 @@ showNotificationWindow config noti dispNotis onClose = do { _dMainWindow = mainWindow , _dLabelBG = labelBG , _dNotiId = notiId noti - , _dNotiDestroy = widgetDestroy mainWindow + , _dNotiDestroy = Gtk.windowDestroy mainWindow , _dHasCustomPosition = hasCustomPosition , _dpopupContent = DisplayingNotificationContent {} } @@ -93,7 +90,7 @@ showNotificationWindow config noti dispNotis onClose = do dispNotiWithoutHeight lblBody = (flip view) dispNoti $ dLabelBody - setWidgetWidthRequest mainWindow $ fromIntegral $ configWidthNoti config + Gtk.setWidgetWidthRequest mainWindow $ fromIntegral $ configWidthNoti config setUrgencyLevel (notiUrgency noti) [mainWindow] setUrgencyLevel (notiUrgency noti) @@ -102,23 +99,23 @@ showNotificationWindow config noti dispNotis onClose = do height <- updateNoti' config onClose noti dispNoti -- Ellipsization of Body - numLines <- fromIntegral <$> (layoutGetLineCount =<< labelGetLayout lblBody) - let maxLines = (configPopupMaxLinesInBody config) + numLines <- fromIntegral <$> (layoutGetLineCount =<< Gtk.labelGetLayout lblBody) + let maxLines = (configPopupMaxLinesInBody config) ellipsizeBody = configPopupEllipsizeBody config height <- if numLines > maxLines && ellipsizeBody then do - lines <- layoutGetLinesReadonly =<< labelGetLayout lblBody + lines <- layoutGetLinesReadonly =<< Gtk.labelGetLayout lblBody let lastLine = lines !! (maxLines - 1) len <- fromIntegral <$> getLayoutLineLength lastLine startOffset <- fromIntegral <$> getLayoutLineStartIndex lastLine - bodyText <- labelGetText lblBody + bodyText <- Gtk.labelGetText lblBody let lenOfTruncatedBody = len - 4 + startOffset + (maxLines - 1) let truncatedBody = Text.take lenOfTruncatedBody $ bodyText ellipsizedBody = Text.append truncatedBody "..." - labelSetText lblBody ellipsizedBody + Gtk.labelSetText lblBody ellipsizedBody -- re-request height to reflect ellipsized body height' <- getHeight (view dContainer dispNoti) config - widgetSetSizeRequest (_dLabelBG dispNoti) (-1) height' + Gtk.widgetSetSizeRequest (_dLabelBG dispNoti) (-1) height' return height' else return height @@ -138,12 +135,12 @@ showNotificationWindow config noti dispNotis onClose = do findBefore hBefores (distanceTop + screenY) height (fromIntegral distanceBetween) - windowMove mainWindow + Gtk.windowMove mainWindow (screenW - fromIntegral (configWidthNoti config + distanceRight)) hBefore - onWidgetButtonPressEvent mainWindow $ \eventButton -> do + Gtk.onWidgetButtonPressEvent mainWindow $ \eventButton -> do mouseButton <- (\n -> "mouse" ++ n) . show <$> getEventButtonButton eventButton let validMouseButtons = ["mouse1", "mouse2", "mouse3", "mouse4", "mouse5"] validInput = mouseButton `elem` validMouseButtons diff --git a/src/TransparentWindow.hs b/src/TransparentWindow.hs index 6da928b..177624f 100644 --- a/src/TransparentWindow.hs +++ b/src/TransparentWindow.hs @@ -28,6 +28,8 @@ module TransparentWindow -- * Colors ) where +import Helpers ((=< IO (GHC.Int.Int32, GHC.Int.Int32) getScreenProportions window = do - screen <- window `get` #screen - h <- screenGetHeight screen - w <- screenGetWidth screen + monitor <- getMonitor window 0 + geometry <- Gdk.monitorGetGeometry monitor + h <- Gdk.getRectangleHeight geometry + w <- Gdk.getRectangleWidth geometry return (h, w) createTransparentWindow :: Text.Text -> [Text.Text] -> Maybe Text.Text @@ -139,12 +114,12 @@ createTransparentWindow mainWindow <- window objs "main_window" - screen <- mainWindow `get` #screen - visual <- #getRgbaVisual screen - #setVisual mainWindow visual +-- screen <- mainWindow `get` #screen +-- visual <- #getRgbaVisual screen +-- #setVisual mainWindow visual when (title /= Nothing) $ let (Just title') = title in - setWindowTitle mainWindow title' + Gtk.setWindowTitle mainWindow title' return (objs, builder) @@ -157,65 +132,69 @@ addSource f = do idleAdd PRIORITY_DEFAULT f -setStyle :: Screen -> BS.ByteString -> IO () +setStyle :: Gdk.Display -> BS.ByteString -> IO () setStyle screen style = do - provider <- cssProviderNew - cssProviderLoadFromData provider style - styleContextAddProviderForScreen screen provider + provider <- Gtk.cssProviderNew + Gtk.cssProviderLoadFromData provider style + Gtk.styleContextAddProviderForDisplay screen provider $ fromIntegral STYLE_PROVIDER_PRIORITY_USER return () addClass :: Gtk.IsWidget a => a -> Text.Text -> IO () addClass w clazz = do - context <- widgetGetStyleContext w - styleContextAddClass context clazz + context <- Gtk.widgetGetStyleContext w + Gtk.styleContextAddClass context clazz removeClass :: Gtk.IsWidget a => a -> Text.Text -> IO () removeClass w clazz = do - context <- widgetGetStyleContext w - styleContextRemoveClass context clazz + context <- Gtk.widgetGetStyleContext w + Gtk.styleContextRemoveClass context clazz getScreenPos :: Gtk.Window -> GHC.Int.Int32 -> IO (GHC.Int.Int32, GHC.Int.Int32, GHC.Int.Int32) -getScreenPos window number = do - screen <- window `get` #screen - display <- screenGetDisplay screen - monitor <- fromMaybe (error "Unknown screen") - <$> displayGetMonitor display number - getMonitorProps monitor +getScreenPos window number = + getMonitorProps =<< getMonitor window number + +getDisplay :: Gtk.Window -> IO Gdk.Display +getDisplay window = do + display <- window `Gdk.get` #display :: IO (Maybe Gdk.Display) + return $ fromMaybe (error "No display found") display + +getMonitor :: Gtk.Window -> GHC.Int.Int32 -> IO Gdk.Monitor +getMonitor window number = do + display <- window `Gdk.get` #display :: IO (Maybe Gdk.Display) + monitors <- sequence $ Gdk.displayGetMonitors <$> display :: IO (Maybe Gio.ListModel) + monitorObj <- (flip Gio.listModelGetItem) 0 =< monitorObj + return $ fromMaybe (error "Unknown screen") monitor getMouseActiveScreenPos :: Gtk.Window -> GHC.Int.Int32 -> IO (GHC.Int.Int32, GHC.Int.Int32, GHC.Int.Int32) getMouseActiveScreenPos window number = do - screen <- window `get` #screen - display <- screenGetDisplay screen + display <- getDisplay window mPointerPos <- getPointerPos monitor <- case mPointerPos of - Just (x, y) -> displayGetMonitorAtPoint display x y - Nothing -> fromMaybe (error "Unknown screen") - <$> displayGetMonitor display number + Just (surface) -> Gdk.displayGetMonitorAtSurface display surface + Nothing -> getMonitor window number getMonitorProps monitor -getMonitorProps :: Monitor -> IO (GHC.Int.Int32, GHC.Int.Int32, GHC.Int.Int32) +getMonitorProps :: Gdk.Monitor -> IO (GHC.Int.Int32, GHC.Int.Int32, GHC.Int.Int32) getMonitorProps monitor = do - monitorGeometry <- monitorGetGeometry monitor - monitorX <- getRectangleX monitorGeometry - monitorY <- getRectangleY monitorGeometry - monitorWidth <- getRectangleWidth monitorGeometry - monitorHeight <- getRectangleHeight monitorGeometry - return (monitorX + monitorWidth, monitorY, monitorHeight) + geometry <- Gdk.monitorGetGeometry monitor + h <- Gdk.getRectangleHeight geometry + w <- Gdk.getRectangleWidth geometry + x <- Gdk.getRectangleX geometry + y <- Gdk.getRectangleY geometry + return (x + w, y, h) -getPointerPos :: IO (Maybe (Int32, Int32)) +getPointerPos :: IO (Maybe (Gdk.Surface)) getPointerPos = do - mDisplay <- displayGetDefault - mSeat <- sequence $ displayGetDefaultSeat <$> mDisplay - case mSeat of - Just (seat) -> do - mPointer <- seatGetPointer seat - case mPointer of - Just (pointer) -> do - (screen, x, y) <- deviceGetPosition pointer - return $ Just (x, y) - Nothing -> return Nothing + mDisplay <- Gdk.displayGetDefault + mSeat <- Gdk.displayGetDefaultSeat =< do + (msurface, x, y) <- Gdk.deviceGetSurfaceAtPosition pointer + return msurface Nothing -> return Nothing diff --git a/stack.yaml b/stack.yaml index de9baf4..75ec650 100644 --- a/stack.yaml +++ b/stack.yaml @@ -43,23 +43,22 @@ extra-deps: [ ConfigFile-1.1.4 , system-locale-0.3.0.0 , gi-harfbuzz-0.0.3 , dbus-0.10.15 - , gtk3-0.15.4 , stm-2.5.0.0 , hgettext-0.1.31.0 , glib-0.13.8.1 , pango-0.13.8.1 - , gio-0.13.8.0 , gi-pango-1.0.23 - , haskell-gi-0.24.5 - , haskell-gi-base-0.24.4 + , haskell-gi-0.24.7 + , haskell-gi-base-0.24.5 , gi-glib-2.0.24 , gi-cairo-1.0.24 , gi-atk-2.0.22 - , gi-gdk-3.0.23 + , gi-gdk-4.0.2 + , gi-gsk-4.0.2 , gi-gdkpixbuf-2.0.24 , gi-gio-2.0.27 , gi-gobject-2.0.25 - , gi-gtk-3.0.36 + , gi-gtk-4.0.3 , gi-graphene-1.0.2 , ansi-terminal-0.11 , tagsoup-0.14.7 diff --git a/stack.yaml.lock b/stack.yaml.lock index aad3f87..aab2f0b 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -32,13 +32,6 @@ packages: sha256: 8ac4beea6d6a51079e7f47506822803da8ac26fff7a0aff905debcf350a643e8 original: hackage: dbus-0.10.15 -- completed: - hackage: gtk3-0.15.4@sha256:e8de08763cb757c4be202a4eb7551a108b49cd59aa90bc7e2d680893d5fccec1,19491 - pantry-tree: - size: 21251 - sha256: d58917c46a6a8477a471d914783798a43bf63341a355bc27442a8fd34d76aea3 - original: - hackage: gtk3-0.15.4 - completed: hackage: stm-2.5.0.0@sha256:c238075f9f0711cd6a78eab6001b3e218cdaa745d6377bf83cc21e58ceec2ea1,2100 pantry-tree: @@ -67,13 +60,6 @@ packages: sha256: eec456a3d16f1a9305196a86a7c49a6f2cfe1b041a50b02059dc4898a07a3bd9 original: hackage: pango-0.13.8.1 -- completed: - hackage: gio-0.13.8.0@sha256:5691212b07dc4193ea6f8202a625c9515d750b249aeafc659139e29a5ec61436,3116 - pantry-tree: - size: 2036 - sha256: 0dd6b7b8aceaa8bf6e356f63337e20d312c568b345b57f5c3f4b3aab5c219cac - original: - hackage: gio-0.13.8.0 - completed: hackage: gi-pango-1.0.23@sha256:160443e93def8aa95e66fe1de40d51bb12ee922f7cafe6e33d6009f5490c66c5,8233 pantry-tree: @@ -82,19 +68,19 @@ packages: original: hackage: gi-pango-1.0.23 - completed: - hackage: haskell-gi-0.24.5@sha256:a7a29f3bd532c3a36c64d5c0b6d7cc0ab990ace22029e4a3b1daae3f545d5989,5241 + hackage: haskell-gi-0.24.7@sha256:d1cf3e64589c9c366228f8fe89d2d48207b3ca11b48966ef976fedfa679a819b,5241 pantry-tree: size: 4348 - sha256: 4d8864a46675e648638091f1f443bfd828a0fb8b3527db3335821006866575cd + sha256: c6db02339d61f70cfb687c7786c4441b9fa2658ce4b4aac19395f2e939ed8f1b original: - hackage: haskell-gi-0.24.5 + hackage: haskell-gi-0.24.7 - completed: - hackage: haskell-gi-base-0.24.4@sha256:436539663b9ed5b5f8228cb0a702e270207c649b0320bc44b440046d3b608e74,2435 + hackage: haskell-gi-base-0.24.5@sha256:f289ee14d99bc91daaf15a72533def379e1f5c6e51e9eff0d67e57912816ce74,2435 pantry-tree: size: 1937 - sha256: 76f7ff59ce0be278e635dd6698c495a12def5801047f7c2cd904cfb080e42951 + sha256: ddb1858a395755bb14438f39718df2f95042f492a55b6dc0f9343435f758613c original: - hackage: haskell-gi-base-0.24.4 + hackage: haskell-gi-base-0.24.5 - completed: hackage: gi-glib-2.0.24@sha256:46726f0fb6b0ef0d6f6620d53025a9ca2a5bc273ab65496b368df7bc3dbe6d83,9558 pantry-tree: @@ -117,12 +103,19 @@ packages: original: hackage: gi-atk-2.0.22 - completed: - hackage: gi-gdk-3.0.23@sha256:33ad689aa6e1463c57946762016a789b6cb663df174e31f9705956a9385b7b0f,9003 + hackage: gi-gdk-4.0.2@sha256:447f8ac6e04a6573b4be948aceea56a668b84a3f437d71af7092a48d5bd80e57,9125 pantry-tree: - size: 355 - sha256: 11ff63701019ed413a143b84849f058a83770ba251c8f5743a7edf5d252a1049 + size: 351 + sha256: a6474cc70acaa93ca810bd0955573c92dda10bc3186525c4f116ecdaad2d1562 original: - hackage: gi-gdk-3.0.23 + hackage: gi-gdk-4.0.2 +- completed: + hackage: gi-gsk-4.0.2@sha256:920aa5984791b8997a38e7b93bce415cc1822d48bfb7f7b08e0aeab0de2142da,6059 + pantry-tree: + size: 351 + sha256: 46bbade9f6115ded47c76419c638ac06b51ac829c3e8c7afc0db5150a8b838a6 + original: + hackage: gi-gsk-4.0.2 - completed: hackage: gi-gdkpixbuf-2.0.24@sha256:287c7233cfecb69a6aff0fb6a952862d759b5562b488bb8046229ee0f4372c6f,3842 pantry-tree: @@ -145,12 +138,12 @@ packages: original: hackage: gi-gobject-2.0.25 - completed: - hackage: gi-gtk-3.0.36@sha256:ed4525766763f290aa03ae19e41a31c429a8d381729d4869e7c44e551351df6a,39016 + hackage: gi-gtk-4.0.3@sha256:158e24b56c3352b45fd9b0f2a634dace4008059cc7483e6b8cd7f5a09d83c9e3,35643 pantry-tree: - size: 359 - sha256: cd1718b99526699f158dce646c2c20cf51eedca7f78c33f8d6290e2ba46ccbb4 + size: 357 + sha256: 8528e5b654a85c51ee91951b983f7ee7cc160be2f53c92b573028f9ad9565c8b original: - hackage: gi-gtk-3.0.36 + hackage: gi-gtk-4.0.3 - completed: hackage: gi-graphene-1.0.2@sha256:87b4e7f6728f6f828ed756ff21f283ae12950e80541007154d0034dee3cca20f,4645 pantry-tree: