    {-# LANGUAGE OverloadedLabels #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE FlexibleContexts #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      : StatusNotifier.TransparentWindow
    -- Copyright   : (c) Ivan A. Malison
    -- License     : BSD3-style (see LICENSE)
    --
    -- Maintainer  : Ivan A. Malison
    -- Stability   : unstable
    -- Portability : unportable
    --
    -- Make a window transparent. Approach adapted from python code from
    -- https://stackoverflow.com/questions/3908565/how-to-make-gtk-window-background-transparent/33294727#33294727
    -----------------------------------------------------------------------------
    module StatusNotifier.TransparentWindow where

    import           Control.Monad.IO.Class
    import           Control.Monad.Trans.Reader
    import           Data.GI.Base
    import           Foreign.Ptr (castPtr)
    import           GI.Cairo hiding (OperatorOver, OperatorSource)
    import           GI.Cairo.Render
    import           GI.Cairo.Render.Connector
    import qualified GI.Gdk as Gdk
    import qualified GI.Gtk as Gtk

    makeWindowTransparent :: MonadIO m => Gtk.Window -> m ()
    makeWindowTransparent :: forall (m :: * -> *). MonadIO m => Window -> m ()
    makeWindowTransparent Window
    window = do
      screen <- Window -> m Screen
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m Screen
    Gtk.widgetGetScreen Window
    window
      visual <- Gdk.screenGetRgbaVisual screen
      Gtk.widgetSetVisual window visual
      Gtk.setWidgetAppPaintable window True
      _ <- Gtk.onWidgetDraw window transparentDraw
      return ()

    transparentDraw :: Gtk.WidgetDrawCallback
    transparentDraw :: WidgetDrawCallback
    transparentDraw Context
    context = do
      rGBA <- IO RGBA
    forall (m :: * -> *). MonadIO m => m RGBA
    Gdk.newZeroRGBA
      Gdk.setRGBAAlpha rGBA 0.0
      Gdk.setRGBABlue rGBA 1.0
      Gdk.setRGBARed rGBA 1.0
      Gdk.setRGBAGreen rGBA 1.0
      Gdk.cairoSetSourceRgba context rGBA
      flip renderWithContext context $ do
        setOperator OperatorSource
        paint
        setOperator OperatorOver
      return False