Attempt to hack full screen support for Firefox in XMonad

FloatFullScreenFirefox.hs

{-# LANGUAGE NamedFieldPuns #-}

--------------------------------------------------------------------------------
-- |
-- Module     : Custom.Hooks.FloatFullScreenFirefox
--
-- Maintainer : Jesse Hallett <[email protected]>
--
-- As of version 57 Firefox for Linux does not set full screen state in Xorg
-- when entering full screen mode. This module exports an event hook that
-- attempts to guess when Firefox enters full screen, and to draw the window in
-- a full screen rectangle when that happens. (Does not work yet!)
--------------------------------------------------------------------------------
module Custom.Hooks.FloatFullScreenFirefox
  ( firefoxFullFloatEventHook
  , isFirefoxFullScreen
  ) where

import Control.Monad (when)
import Data.Monoid (All(..))
import Graphics.X11.Types (Atom, Window)
import Graphics.X11.Xlib.Extras (Event(..), SizeHints(..), getWMNormalHints)
import Graphics.X11.Xlib.Types (Display)
import XMonad.Core (Query, X, io, runQuery)
import XMonad.Hooks.ManageHelpers (doFullFloat)
import XMonad.ManageHook ((=?), className, liftX)

firefoxFullFloatEventHook :: Event -> X All
firefoxFullFloatEventHook ev@(PropertyEvent { ev_event_display, ev_atom, ev_window })
  | (ev_atom == wmNormalHintsAtom) = do
    ff <- runQuery isFirefox ev_window
    fs <- isFirefoxFullScreen ev_event_display ev_window
    when (ff && fs) $
      runQuery doFullFloat ev_window >> return ()
    return mempty
firefoxFullFloatEventHook _ = return mempty

isFirefox :: Query Bool
isFirefox = className =? "Firefox"

-- In my tests Firefox sets its base height hint to <100 when in full screen
-- mode, and >200 otherwise
isFirefoxFullScreen :: Display -> Window -> X Bool
isFirefoxFullScreen disp win = do
  sizeHints <- io $ getWMNormalHints disp win
  case sh_base_size sizeHints of
    Just (_, height) -> return (height < 100)
    Nothing -> return False

wmNormalHintsAtom :: Atom
wmNormalHintsAtom = 0x28