module Graphics.UI.GIGtkStrut
  ( defaultStrutConfig
  , StrutPosition(..)
  , StrutSize(..)
  , StrutAlignment(..)
  , StrutConfig(..)
  , buildStrutWindow
  , setupStrutWindow
  ) where

import           Control.Monad
import           Control.Monad.Fail (MonadFail)
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Maybe
import           Data.Default
import           Data.Int
import           Data.Maybe
import qualified Data.Text as T
import qualified GI.Gdk as Gdk
import qualified GI.Gtk as Gtk
import           Graphics.UI.EWMHStrut
import           System.Log.Logger
import           Text.Printf

strutLog :: MonadIO m => Priority -> String -> m ()
strutLog :: forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
strutLog Priority
p String
s = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Priority -> String -> IO ()
logM String
"Graphics.UI.GIGtkStrut" Priority
p String
s

data StrutPosition
  = TopPos | BottomPos | LeftPos | RightPos
    deriving (Int -> StrutPosition -> ShowS
[StrutPosition] -> ShowS
StrutPosition -> String
(Int -> StrutPosition -> ShowS)
-> (StrutPosition -> String)
-> ([StrutPosition] -> ShowS)
-> Show StrutPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StrutPosition -> ShowS
showsPrec :: Int -> StrutPosition -> ShowS
$cshow :: StrutPosition -> String
show :: StrutPosition -> String
$cshowList :: [StrutPosition] -> ShowS
showList :: [StrutPosition] -> ShowS
Show, ReadPrec [StrutPosition]
ReadPrec StrutPosition
Int -> ReadS StrutPosition
ReadS [StrutPosition]
(Int -> ReadS StrutPosition)
-> ReadS [StrutPosition]
-> ReadPrec StrutPosition
-> ReadPrec [StrutPosition]
-> Read StrutPosition
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS StrutPosition
readsPrec :: Int -> ReadS StrutPosition
$creadList :: ReadS [StrutPosition]
readList :: ReadS [StrutPosition]
$creadPrec :: ReadPrec StrutPosition
readPrec :: ReadPrec StrutPosition
$creadListPrec :: ReadPrec [StrutPosition]
readListPrec :: ReadPrec [StrutPosition]
Read, StrutPosition -> StrutPosition -> Bool
(StrutPosition -> StrutPosition -> Bool)
-> (StrutPosition -> StrutPosition -> Bool) -> Eq StrutPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StrutPosition -> StrutPosition -> Bool
== :: StrutPosition -> StrutPosition -> Bool
$c/= :: StrutPosition -> StrutPosition -> Bool
/= :: StrutPosition -> StrutPosition -> Bool
Eq)

data StrutAlignment
  = Beginning | Center | End
    deriving (Int -> StrutAlignment -> ShowS
[StrutAlignment] -> ShowS
StrutAlignment -> String
(Int -> StrutAlignment -> ShowS)
-> (StrutAlignment -> String)
-> ([StrutAlignment] -> ShowS)
-> Show StrutAlignment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StrutAlignment -> ShowS
showsPrec :: Int -> StrutAlignment -> ShowS
$cshow :: StrutAlignment -> String
show :: StrutAlignment -> String
$cshowList :: [StrutAlignment] -> ShowS
showList :: [StrutAlignment] -> ShowS
Show, ReadPrec [StrutAlignment]
ReadPrec StrutAlignment
Int -> ReadS StrutAlignment
ReadS [StrutAlignment]
(Int -> ReadS StrutAlignment)
-> ReadS [StrutAlignment]
-> ReadPrec StrutAlignment
-> ReadPrec [StrutAlignment]
-> Read StrutAlignment
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS StrutAlignment
readsPrec :: Int -> ReadS StrutAlignment
$creadList :: ReadS [StrutAlignment]
readList :: ReadS [StrutAlignment]
$creadPrec :: ReadPrec StrutAlignment
readPrec :: ReadPrec StrutAlignment
$creadListPrec :: ReadPrec [StrutAlignment]
readListPrec :: ReadPrec [StrutAlignment]
Read, StrutAlignment -> StrutAlignment -> Bool
(StrutAlignment -> StrutAlignment -> Bool)
-> (StrutAlignment -> StrutAlignment -> Bool) -> Eq StrutAlignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StrutAlignment -> StrutAlignment -> Bool
== :: StrutAlignment -> StrutAlignment -> Bool
$c/= :: StrutAlignment -> StrutAlignment -> Bool
/= :: StrutAlignment -> StrutAlignment -> Bool
Eq)

data StrutSize
  = ExactSize Int32 | ScreenRatio Rational
    deriving (Int -> StrutSize -> ShowS
[StrutSize] -> ShowS
StrutSize -> String
(Int -> StrutSize -> ShowS)
-> (StrutSize -> String)
-> ([StrutSize] -> ShowS)
-> Show StrutSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StrutSize -> ShowS
showsPrec :: Int -> StrutSize -> ShowS
$cshow :: StrutSize -> String
show :: StrutSize -> String
$cshowList :: [StrutSize] -> ShowS
showList :: [StrutSize] -> ShowS
Show, ReadPrec [StrutSize]
ReadPrec StrutSize
Int -> ReadS StrutSize
ReadS [StrutSize]
(Int -> ReadS StrutSize)
-> ReadS [StrutSize]
-> ReadPrec StrutSize
-> ReadPrec [StrutSize]
-> Read StrutSize
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS StrutSize
readsPrec :: Int -> ReadS StrutSize
$creadList :: ReadS [StrutSize]
readList :: ReadS [StrutSize]
$creadPrec :: ReadPrec StrutSize
readPrec :: ReadPrec StrutSize
$creadListPrec :: ReadPrec [StrutSize]
readListPrec :: ReadPrec [StrutSize]
Read, StrutSize -> StrutSize -> Bool
(StrutSize -> StrutSize -> Bool)
-> (StrutSize -> StrutSize -> Bool) -> Eq StrutSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StrutSize -> StrutSize -> Bool
== :: StrutSize -> StrutSize -> Bool
$c/= :: StrutSize -> StrutSize -> Bool
/= :: StrutSize -> StrutSize -> Bool
Eq)

data StrutConfig = StrutConfig
  { StrutConfig -> StrutSize
strutWidth :: StrutSize
  , StrutConfig -> StrutSize
strutHeight :: StrutSize
  , StrutConfig -> Int32
strutXPadding :: Int32
  , StrutConfig -> Int32
strutYPadding :: Int32
  , StrutConfig -> Maybe Int32
strutMonitor :: Maybe Int32
  , StrutConfig -> StrutPosition
strutPosition :: StrutPosition
  , StrutConfig -> StrutAlignment
strutAlignment :: StrutAlignment
  , StrutConfig -> Maybe Text
strutDisplayName :: Maybe T.Text
  } deriving (Int -> StrutConfig -> ShowS
[StrutConfig] -> ShowS
StrutConfig -> String
(Int -> StrutConfig -> ShowS)
-> (StrutConfig -> String)
-> ([StrutConfig] -> ShowS)
-> Show StrutConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StrutConfig -> ShowS
showsPrec :: Int -> StrutConfig -> ShowS
$cshow :: StrutConfig -> String
show :: StrutConfig -> String
$cshowList :: [StrutConfig] -> ShowS
showList :: [StrutConfig] -> ShowS
Show, StrutConfig -> StrutConfig -> Bool
(StrutConfig -> StrutConfig -> Bool)
-> (StrutConfig -> StrutConfig -> Bool) -> Eq StrutConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StrutConfig -> StrutConfig -> Bool
== :: StrutConfig -> StrutConfig -> Bool
$c/= :: StrutConfig -> StrutConfig -> Bool
/= :: StrutConfig -> StrutConfig -> Bool
Eq)

defaultStrutConfig :: StrutConfig
defaultStrutConfig = StrutConfig
  { strutWidth :: StrutSize
strutWidth = Rational -> StrutSize
ScreenRatio Rational
1
  , strutHeight :: StrutSize
strutHeight = Rational -> StrutSize
ScreenRatio Rational
1
  , strutXPadding :: Int32
strutXPadding = Int32
0
  , strutYPadding :: Int32
strutYPadding = Int32
0
  , strutMonitor :: Maybe Int32
strutMonitor = Maybe Int32
forall a. Maybe a
Nothing
  , strutPosition :: StrutPosition
strutPosition = StrutPosition
TopPos
  , strutAlignment :: StrutAlignment
strutAlignment = StrutAlignment
Beginning
  , strutDisplayName :: Maybe Text
strutDisplayName = Maybe Text
forall a. Maybe a
Nothing
  }

instance Default StrutConfig where
  def :: StrutConfig
def =
    StrutConfig
    { strutWidth :: StrutSize
strutWidth = Rational -> StrutSize
ScreenRatio Rational
1
    , strutHeight :: StrutSize
strutHeight = Rational -> StrutSize
ScreenRatio Rational
1
    , strutXPadding :: Int32
strutXPadding = Int32
0
    , strutYPadding :: Int32
strutYPadding = Int32
0
    , strutMonitor :: Maybe Int32
strutMonitor = Maybe Int32
forall a. Maybe a
Nothing
    , strutPosition :: StrutPosition
strutPosition = StrutPosition
TopPos
    , strutAlignment :: StrutAlignment
strutAlignment = StrutAlignment
Beginning
    , strutDisplayName :: Maybe Text
strutDisplayName = Maybe Text
forall a. Maybe a
Nothing
    }


-- | Build a strut window to the specifications provided by the 'StrutConfig'
-- argument.
buildStrutWindow :: (MonadFail m, MonadIO m) => StrutConfig -> m Gtk.Window
buildStrutWindow :: forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
StrutConfig -> m Window
buildStrutWindow StrutConfig
config = do
  window <- WindowType -> m Window
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
WindowType -> m Window
Gtk.windowNew WindowType
Gtk.WindowTypeToplevel
  setupStrutWindow config window
  return window

-- | Configure the provided 'Gtk.Window' so that it has the properties specified
-- by the 'StrutConfig' argument.
setupStrutWindow :: (MonadFail m, MonadIO m) => StrutConfig -> Gtk.Window -> m ()
setupStrutWindow :: forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
StrutConfig -> Window -> m ()
setupStrutWindow StrutConfig
                   { strutWidth :: StrutConfig -> StrutSize
strutWidth = StrutSize
widthSize
                   , strutHeight :: StrutConfig -> StrutSize
strutHeight = StrutSize
heightSize
                   , strutXPadding :: StrutConfig -> Int32
strutXPadding = Int32
xpadding
                   , strutYPadding :: StrutConfig -> Int32
strutYPadding = Int32
ypadding
                   , strutMonitor :: StrutConfig -> Maybe Int32
strutMonitor = Maybe Int32
monitorNumber
                   , strutPosition :: StrutConfig -> StrutPosition
strutPosition = StrutPosition
position
                   , strutAlignment :: StrutConfig -> StrutAlignment
strutAlignment = StrutAlignment
alignment
                   , strutDisplayName :: StrutConfig -> Maybe Text
strutDisplayName = Maybe Text
displayName
                   } Window
window = do
  Priority -> String -> m ()
forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
strutLog Priority
DEBUG String
"Starting strut window setup"
  Just display <- m (Maybe Display)
-> (Text -> m (Maybe Display)) -> Maybe Text -> m (Maybe Display)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m (Maybe Display)
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m (Maybe Display)
Gdk.displayGetDefault Text -> m (Maybe Display)
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m (Maybe Display)
Gdk.displayOpen Maybe Text
displayName
  Just monitor <- maybe (Gdk.displayGetPrimaryMonitor display)
                  (Gdk.displayGetMonitor display) monitorNumber

  screen <- Gdk.displayGetDefaultScreen display

  monitorCount <- Gdk.displayGetNMonitors display
  allMonitors <- catMaybes <$> mapM (Gdk.displayGetMonitor display)
                 [0..(monitorCount-1)]
  allGeometries <- mapM Gdk.monitorGetGeometry allMonitors

  let getFullY Rectangle
geometry = Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
(+) (Int32 -> Int32 -> Int32) -> f Int32 -> f (Int32 -> Int32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rectangle -> f Int32
forall (m :: * -> *). MonadIO m => Rectangle -> m Int32
Gdk.getRectangleY Rectangle
geometry
                              f (Int32 -> Int32) -> f Int32 -> f Int32
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Rectangle -> f Int32
forall (m :: * -> *). MonadIO m => Rectangle -> m Int32
Gdk.getRectangleHeight Rectangle
geometry
      getFullX Rectangle
geometry = Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
(+) (Int32 -> Int32 -> Int32) -> f Int32 -> f (Int32 -> Int32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rectangle -> f Int32
forall (m :: * -> *). MonadIO m => Rectangle -> m Int32
Gdk.getRectangleX Rectangle
geometry
                              f (Int32 -> Int32) -> f Int32 -> f Int32
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Rectangle -> f Int32
forall (m :: * -> *). MonadIO m => Rectangle -> m Int32
Gdk.getRectangleWidth Rectangle
geometry

  -- The screen concept actually encapsulates things displayed across multiple
  -- monitors, which is why we take the maximum here -- what we really want to
  -- know is what is the farthest we can go in each direction on any monitor.
  screenWidth <- maximum <$> mapM getFullX allGeometries
  screenHeight <- maximum <$> mapM getFullY allGeometries

  geometry <- Gdk.newZeroGeometry

  monitorGeometry <- Gdk.monitorGetGeometry monitor
  monitorScaleFactor <- Gdk.monitorGetScaleFactor monitor
  monitorWidth <- Gdk.getRectangleWidth monitorGeometry
  monitorHeight <- Gdk.getRectangleHeight monitorGeometry
  monitorX <- Gdk.getRectangleX monitorGeometry
  monitorY <- Gdk.getRectangleY monitorGeometry

  let width =
        case StrutSize
widthSize of
          ExactSize Int32
w -> Int32
w
          ScreenRatio Rational
p ->
            Rational -> Int32
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational -> Int32) -> Rational -> Int32
forall a b. (a -> b) -> a -> b
$ Rational
p Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Int32 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
monitorWidth Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- (Int32
2 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
xpadding))
      height =
        case StrutSize
heightSize of
          ExactSize Int32
h -> Int32
h
          ScreenRatio Rational
p ->
            Rational -> Int32
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational -> Int32) -> Rational -> Int32
forall a b. (a -> b) -> a -> b
$ Rational
p Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Int32 -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32
monitorHeight Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- (Int32
2 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
ypadding))

  Gdk.setGeometryBaseWidth geometry width
  Gdk.setGeometryBaseHeight geometry height
  Gdk.setGeometryMinWidth geometry width
  Gdk.setGeometryMinHeight geometry height
  Gdk.setGeometryMaxWidth geometry width
  Gdk.setGeometryMaxHeight geometry height
  Gtk.windowSetGeometryHints window (Nothing :: Maybe Gtk.Window)
       (Just geometry) allHints

  let paddedHeight = Int32
height Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
2 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
ypadding
      paddedWidth = Int32
width Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
2 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
xpadding
      getAlignedPos a
dimensionPos a
dpadding a
monitorSize a
barSize =
        a
dimensionPos a -> a -> a
forall a. Num a => a -> a -> a
+
        case StrutAlignment
alignment of
          StrutAlignment
Beginning -> a
dpadding
          StrutAlignment
Center -> (a
monitorSize a -> a -> a
forall a. Num a => a -> a -> a
- a
barSize) a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2
          StrutAlignment
End -> a
monitorSize a -> a -> a
forall a. Num a => a -> a -> a
- a
barSize a -> a -> a
forall a. Num a => a -> a -> a
- a
dpadding
      xAligned = Int32 -> Int32 -> Int32 -> Int32 -> Int32
forall {a}. Integral a => a -> a -> a -> a -> a
getAlignedPos Int32
monitorX Int32
xpadding Int32
monitorWidth Int32
width
      yAligned = Int32 -> Int32 -> Int32 -> Int32 -> Int32
forall {a}. Integral a => a -> a -> a -> a -> a
getAlignedPos Int32
monitorY Int32
ypadding Int32
monitorHeight Int32
height
      (xPos, yPos) =
        case position of
          StrutPosition
TopPos -> (Int32
xAligned, Int32
monitorY Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
ypadding)
          StrutPosition
BottomPos -> (Int32
xAligned, Int32
monitorY Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
monitorHeight Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
height Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
ypadding)
          StrutPosition
LeftPos -> (Int32
monitorX Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
xpadding, Int32
yAligned)
          StrutPosition
RightPos -> (Int32
monitorX Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
monitorWidth Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
width Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
xpadding, Int32
yAligned)

  Gtk.windowSetTypeHint window Gdk.WindowTypeHintDock
  Gtk.windowSetScreen window screen
  Gtk.windowMove window xPos yPos
  Gtk.windowSetKeepBelow window True

  let ewmhSettings =
        case StrutPosition
position of
          StrutPosition
TopPos ->
            EWMHStrutSettings
zeroStrutSettings
            { _top = monitorY + paddedHeight
            , _top_start_x = xPos - xpadding
            , _top_end_x = xPos + width + xpadding - 1
            }
          StrutPosition
BottomPos ->
            EWMHStrutSettings
zeroStrutSettings
            { _bottom = screenHeight - monitorY - monitorHeight + paddedHeight
            , _bottom_start_x = xPos - xpadding
            , _bottom_end_x = xPos + width + xpadding - 1
            }
          StrutPosition
LeftPos ->
            EWMHStrutSettings
zeroStrutSettings
            { _left = monitorX + paddedWidth
            , _left_start_y = yPos - ypadding
            , _left_end_y = yPos + height + ypadding - 1
            }
          StrutPosition
RightPos ->
            EWMHStrutSettings
zeroStrutSettings
            { _right = screenWidth - monitorX - monitorWidth + paddedWidth
            , _right_start_y = yPos - ypadding
            , _right_end_y = yPos + height + ypadding - 1
            }
      scaledStrutSettings = Int32 -> EWMHStrutSettings -> EWMHStrutSettings
scaleStrutSettings Int32
monitorScaleFactor EWMHStrutSettings
ewmhSettings
      setStrutProperties =
        IO (Maybe ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe ()) -> IO ()) -> IO (Maybe ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ MaybeT IO () -> IO (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO () -> IO (Maybe ())) -> MaybeT IO () -> IO (Maybe ())
forall a b. (a -> b) -> a -> b
$ do
          gdkWindow <- IO (Maybe Window) -> MaybeT IO Window
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe Window) -> MaybeT IO Window)
-> IO (Maybe Window) -> MaybeT IO Window
forall a b. (a -> b) -> a -> b
$ Window -> IO (Maybe Window)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m (Maybe Window)
Gtk.widgetGetWindow Window
window
          lift $ setStrut gdkWindow scaledStrutSettings
      logPairs =
        [ (String
"width", Int32 -> String
forall a. Show a => a -> String
show Int32
width)
        , (String
"height", Int32 -> String
forall a. Show a => a -> String
show Int32
height)
        , (String
"xPos", Int32 -> String
forall a. Show a => a -> String
show Int32
xPos)
        , (String
"yPos", Int32 -> String
forall a. Show a => a -> String
show Int32
yPos)
        , (String
"paddedWidth", Int32 -> String
forall a. Show a => a -> String
show Int32
paddedWidth)
        , (String
"paddedHeight", Int32 -> String
forall a. Show a => a -> String
show Int32
paddedHeight)
        , (String
"monitorWidth", Int32 -> String
forall a. Show a => a -> String
show Int32
monitorWidth)
        , (String
"monitorHeight", Int32 -> String
forall a. Show a => a -> String
show Int32
monitorHeight)
        , (String
"monitorX", Int32 -> String
forall a. Show a => a -> String
show Int32
monitorX)
        , (String
"monitorY", Int32 -> String
forall a. Show a => a -> String
show Int32
monitorY)
        , (String
"strutSettings", EWMHStrutSettings -> String
forall a. Show a => a -> String
show EWMHStrutSettings
ewmhSettings)
        , (String
"scaledStrutSettings", EWMHStrutSettings -> String
forall a. Show a => a -> String
show EWMHStrutSettings
scaledStrutSettings)
        ]

  strutLog DEBUG "Properties:"
  mapM_ (\(String
name, String
value) -> Priority -> String -> m ()
forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
strutLog Priority
WARNING (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"%s: %s" String
name String
value) logPairs

  void $ Gtk.onWidgetRealize window setStrutProperties

allHints :: [Gdk.WindowHints]
allHints :: [WindowHints]
allHints =
  [ WindowHints
Gdk.WindowHintsMinSize
  , WindowHints
Gdk.WindowHintsMaxSize
  , WindowHints
Gdk.WindowHintsBaseSize
  , WindowHints
Gdk.WindowHintsUserPos
  , WindowHints
Gdk.WindowHintsUserSize
  ]