{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, PatternGuards #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Monitor
-- Description :  Layout modfier for displaying some window (monitor) above other windows.
-- Copyright   :  (c) Roman Cheplyaka
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Roman Cheplyaka <roma@ro-che.info>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Layout modifier for displaying some window (monitor) above other windows.
--
-----------------------------------------------------------------------------
module XMonad.Layout.Monitor (
    -- * Usage
    -- $usage

    -- * Hints and issues
    -- $hints

    Monitor(..),
    monitor,
    Property(..),
    MonitorMessage(..),
    doHideIgnore,
    manageMonitor

    -- * TODO
    -- $todo
    ) where

import XMonad
import XMonad.Prelude (unless)
import XMonad.Layout.LayoutModifier
import XMonad.Util.WindowProperties
import XMonad.Hooks.ManageHelpers (doHideIgnore)
import XMonad.Hooks.FadeInactive (setOpacity)

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.Monitor
--
-- Define 'Monitor' record. 'monitor' can be used as a template. At least 'prop'
-- and 'rect' should be set here. Also consider setting 'persistent' to True.
--
-- Minimal example:
--
-- > myMonitor = monitor
-- >     { prop = ClassName "SomeClass"
-- >     , rect = Rectangle 0 0 40 20 -- rectangle 40x20 in upper left corner
-- >     }
--
-- More interesting example:
--
-- > clock = monitor {
-- >      -- Cairo-clock creates 2 windows with the same classname, thus also using title
-- >      prop = ClassName "Cairo-clock" `And` Title "MacSlow's Cairo-Clock"
-- >      -- rectangle 150x150 in lower right corner, assuming 1280x800 resolution
-- >    , rect = Rectangle (1280-150) (800-150) 150 150
-- >      -- avoid flickering
-- >    , persistent = True
-- >      -- make the window transparent
-- >    , opacity = 0.6
-- >      -- hide on start
-- >    , visible = False
-- >      -- assign it a name to be able to toggle it independently of others
-- >    , name = "clock"
-- >    }
--
-- Add ManageHook to de-manage monitor windows and apply opacity settings.
--
-- > manageHook = myManageHook <> manageMonitor clock
--
-- Apply layout modifier.
--
-- > myLayout = ModifiedLayout clock $ tall ||| Full ||| ...
--
-- After that, if there exists a window with specified properties, it will be
-- displayed on top of all /tiled/ (not floated) windows on specified
-- position.
--
-- It's also useful to add some keybinding to toggle monitor visibility:
--
-- > , ((mod1Mask, xK_u     ), broadcastMessage ToggleMonitor >> refresh)
--
-- Screenshot: <http://www.haskell.org/haskellwiki/Image:Xmonad-clock.png>

data Monitor a = Monitor
    { forall a. Monitor a -> Property
prop :: Property    -- ^ property which uniquely identifies monitor window
    , forall a. Monitor a -> Rectangle
rect :: Rectangle   -- ^ specifies where to put monitor
    , forall a. Monitor a -> Bool
visible :: Bool     -- ^ is it visible by default?
    , forall a. Monitor a -> String
name :: String      -- ^ name of monitor (useful when we have many of them)
    , forall a. Monitor a -> Bool
persistent :: Bool  -- ^ is it shown on all layouts?
    , forall a. Monitor a -> Rational
opacity :: Rational -- ^ opacity level
    } deriving (ReadPrec [Monitor a]
ReadPrec (Monitor a)
Int -> ReadS (Monitor a)
ReadS [Monitor a]
(Int -> ReadS (Monitor a))
-> ReadS [Monitor a]
-> ReadPrec (Monitor a)
-> ReadPrec [Monitor a]
-> Read (Monitor a)
forall a. ReadPrec [Monitor a]
forall a. ReadPrec (Monitor a)
forall a. Int -> ReadS (Monitor a)
forall a. ReadS [Monitor a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Monitor a]
$creadListPrec :: forall a. ReadPrec [Monitor a]
readPrec :: ReadPrec (Monitor a)
$creadPrec :: forall a. ReadPrec (Monitor a)
readList :: ReadS [Monitor a]
$creadList :: forall a. ReadS [Monitor a]
readsPrec :: Int -> ReadS (Monitor a)
$creadsPrec :: forall a. Int -> ReadS (Monitor a)
Read, Int -> Monitor a -> ShowS
[Monitor a] -> ShowS
Monitor a -> String
(Int -> Monitor a -> ShowS)
-> (Monitor a -> String)
-> ([Monitor a] -> ShowS)
-> Show (Monitor a)
forall a. Int -> Monitor a -> ShowS
forall a. [Monitor a] -> ShowS
forall a. Monitor a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Monitor a] -> ShowS
$cshowList :: forall a. [Monitor a] -> ShowS
show :: Monitor a -> String
$cshow :: forall a. Monitor a -> String
showsPrec :: Int -> Monitor a -> ShowS
$cshowsPrec :: forall a. Int -> Monitor a -> ShowS
Show)

-- | Template for 'Monitor' record. At least 'prop' and 'rect' should be
-- redefined. Default settings: 'visible' is 'True', 'persistent' is 'False'.
monitor :: Monitor a
monitor :: forall a. Monitor a
monitor = Monitor :: forall a.
Property
-> Rectangle -> Bool -> String -> Bool -> Rational -> Monitor a
Monitor
    { prop :: Property
prop = Bool -> Property
Const Bool
False
    , rect :: Rectangle
rect = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle Position
0 Position
0 Dimension
0 Dimension
0
    , visible :: Bool
visible = Bool
True
    , name :: String
name = String
""
    , persistent :: Bool
persistent = Bool
False
    , opacity :: Rational
opacity = Rational
1
    }

-- | Messages without names affect all monitors. Messages with names affect only
-- monitors whose names match.
data MonitorMessage = ToggleMonitor | ShowMonitor | HideMonitor
                    | ToggleMonitorNamed String
                    | ShowMonitorNamed String
                    | HideMonitorNamed String
    deriving (ReadPrec [MonitorMessage]
ReadPrec MonitorMessage
Int -> ReadS MonitorMessage
ReadS [MonitorMessage]
(Int -> ReadS MonitorMessage)
-> ReadS [MonitorMessage]
-> ReadPrec MonitorMessage
-> ReadPrec [MonitorMessage]
-> Read MonitorMessage
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MonitorMessage]
$creadListPrec :: ReadPrec [MonitorMessage]
readPrec :: ReadPrec MonitorMessage
$creadPrec :: ReadPrec MonitorMessage
readList :: ReadS [MonitorMessage]
$creadList :: ReadS [MonitorMessage]
readsPrec :: Int -> ReadS MonitorMessage
$creadsPrec :: Int -> ReadS MonitorMessage
Read,Int -> MonitorMessage -> ShowS
[MonitorMessage] -> ShowS
MonitorMessage -> String
(Int -> MonitorMessage -> ShowS)
-> (MonitorMessage -> String)
-> ([MonitorMessage] -> ShowS)
-> Show MonitorMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MonitorMessage] -> ShowS
$cshowList :: [MonitorMessage] -> ShowS
show :: MonitorMessage -> String
$cshow :: MonitorMessage -> String
showsPrec :: Int -> MonitorMessage -> ShowS
$cshowsPrec :: Int -> MonitorMessage -> ShowS
Show,MonitorMessage -> MonitorMessage -> Bool
(MonitorMessage -> MonitorMessage -> Bool)
-> (MonitorMessage -> MonitorMessage -> Bool) -> Eq MonitorMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonitorMessage -> MonitorMessage -> Bool
$c/= :: MonitorMessage -> MonitorMessage -> Bool
== :: MonitorMessage -> MonitorMessage -> Bool
$c== :: MonitorMessage -> MonitorMessage -> Bool
Eq)
instance Message MonitorMessage

withMonitor :: Property -> a -> (Window -> X a) -> X a
withMonitor :: forall a. Property -> a -> (Window -> X a) -> X a
withMonitor Property
p a
a Window -> X a
fn = do
    [Window]
monitorWindows <- Property -> X [Window]
allWithProperty Property
p
    case [Window]
monitorWindows of
        [] -> a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
        Window
w:[Window]
_ -> Window -> X a
fn Window
w

instance LayoutModifier Monitor Window where
    redoLayout :: Monitor Window
-> Rectangle
-> Maybe (Stack Window)
-> [(Window, Rectangle)]
-> X ([(Window, Rectangle)], Maybe (Monitor Window))
redoLayout Monitor Window
mon Rectangle
_ Maybe (Stack Window)
_ [(Window, Rectangle)]
rects = Property
-> ([(Window, Rectangle)], Maybe (Monitor Window))
-> (Window -> X ([(Window, Rectangle)], Maybe (Monitor Window)))
-> X ([(Window, Rectangle)], Maybe (Monitor Window))
forall a. Property -> a -> (Window -> X a) -> X a
withMonitor (Monitor Window -> Property
forall a. Monitor a -> Property
prop Monitor Window
mon) ([(Window, Rectangle)]
rects, Maybe (Monitor Window)
forall a. Maybe a
Nothing) ((Window -> X ([(Window, Rectangle)], Maybe (Monitor Window)))
 -> X ([(Window, Rectangle)], Maybe (Monitor Window)))
-> (Window -> X ([(Window, Rectangle)], Maybe (Monitor Window)))
-> X ([(Window, Rectangle)], Maybe (Monitor Window))
forall a b. (a -> b) -> a -> b
$ \Window
w ->
        if Monitor Window -> Bool
forall a. Monitor a -> Bool
visible Monitor Window
mon
            then do Window -> Rectangle -> X ()
tileWindow Window
w (Monitor Window -> Rectangle
forall a. Monitor a -> Rectangle
rect Monitor Window
mon)
                    Window -> X ()
reveal Window
w
                    ([(Window, Rectangle)], Maybe (Monitor Window))
-> X ([(Window, Rectangle)], Maybe (Monitor Window))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Window
w,Monitor Window -> Rectangle
forall a. Monitor a -> Rectangle
rect Monitor Window
mon)(Window, Rectangle)
-> [(Window, Rectangle)] -> [(Window, Rectangle)]
forall a. a -> [a] -> [a]
:[(Window, Rectangle)]
rects, Maybe (Monitor Window)
forall a. Maybe a
Nothing)
            else do Window -> X ()
hide Window
w
                    ([(Window, Rectangle)], Maybe (Monitor Window))
-> X ([(Window, Rectangle)], Maybe (Monitor Window))
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Window, Rectangle)]
rects, Maybe (Monitor Window)
forall a. Maybe a
Nothing)
    handleMess :: Monitor Window -> SomeMessage -> X (Maybe (Monitor Window))
handleMess Monitor Window
mon SomeMessage
mess
        | Just MonitorMessage
ToggleMonitor <- SomeMessage -> Maybe MonitorMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
mess = Maybe (Monitor Window) -> X (Maybe (Monitor Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Monitor Window) -> X (Maybe (Monitor Window)))
-> Maybe (Monitor Window) -> X (Maybe (Monitor Window))
forall a b. (a -> b) -> a -> b
$ Monitor Window -> Maybe (Monitor Window)
forall a. a -> Maybe a
Just (Monitor Window -> Maybe (Monitor Window))
-> Monitor Window -> Maybe (Monitor Window)
forall a b. (a -> b) -> a -> b
$ Monitor Window
mon { visible :: Bool
visible = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Monitor Window -> Bool
forall a. Monitor a -> Bool
visible Monitor Window
mon }
        | Just (ToggleMonitorNamed String
n) <- SomeMessage -> Maybe MonitorMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
mess = Maybe (Monitor Window) -> X (Maybe (Monitor Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Monitor Window) -> X (Maybe (Monitor Window)))
-> Maybe (Monitor Window) -> X (Maybe (Monitor Window))
forall a b. (a -> b) -> a -> b
$
            if Monitor Window -> String
forall a. Monitor a -> String
name Monitor Window
mon String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n then Monitor Window -> Maybe (Monitor Window)
forall a. a -> Maybe a
Just (Monitor Window -> Maybe (Monitor Window))
-> Monitor Window -> Maybe (Monitor Window)
forall a b. (a -> b) -> a -> b
$ Monitor Window
mon { visible :: Bool
visible = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Monitor Window -> Bool
forall a. Monitor a -> Bool
visible Monitor Window
mon } else Maybe (Monitor Window)
forall a. Maybe a
Nothing
        | Just MonitorMessage
ShowMonitor <- SomeMessage -> Maybe MonitorMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
mess = Maybe (Monitor Window) -> X (Maybe (Monitor Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Monitor Window) -> X (Maybe (Monitor Window)))
-> Maybe (Monitor Window) -> X (Maybe (Monitor Window))
forall a b. (a -> b) -> a -> b
$ Monitor Window -> Maybe (Monitor Window)
forall a. a -> Maybe a
Just (Monitor Window -> Maybe (Monitor Window))
-> Monitor Window -> Maybe (Monitor Window)
forall a b. (a -> b) -> a -> b
$ Monitor Window
mon { visible :: Bool
visible = Bool
True }
        | Just (ShowMonitorNamed String
n) <- SomeMessage -> Maybe MonitorMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
mess = Maybe (Monitor Window) -> X (Maybe (Monitor Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Monitor Window) -> X (Maybe (Monitor Window)))
-> Maybe (Monitor Window) -> X (Maybe (Monitor Window))
forall a b. (a -> b) -> a -> b
$
            if Monitor Window -> String
forall a. Monitor a -> String
name Monitor Window
mon String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n then Monitor Window -> Maybe (Monitor Window)
forall a. a -> Maybe a
Just (Monitor Window -> Maybe (Monitor Window))
-> Monitor Window -> Maybe (Monitor Window)
forall a b. (a -> b) -> a -> b
$ Monitor Window
mon { visible :: Bool
visible = Bool
True } else Maybe (Monitor Window)
forall a. Maybe a
Nothing
        | Just MonitorMessage
HideMonitor <- SomeMessage -> Maybe MonitorMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
mess = Maybe (Monitor Window) -> X (Maybe (Monitor Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Monitor Window) -> X (Maybe (Monitor Window)))
-> Maybe (Monitor Window) -> X (Maybe (Monitor Window))
forall a b. (a -> b) -> a -> b
$ Monitor Window -> Maybe (Monitor Window)
forall a. a -> Maybe a
Just (Monitor Window -> Maybe (Monitor Window))
-> Monitor Window -> Maybe (Monitor Window)
forall a b. (a -> b) -> a -> b
$ Monitor Window
mon { visible :: Bool
visible = Bool
False }
        | Just (HideMonitorNamed String
n) <- SomeMessage -> Maybe MonitorMessage
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
mess = Maybe (Monitor Window) -> X (Maybe (Monitor Window))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Monitor Window) -> X (Maybe (Monitor Window)))
-> Maybe (Monitor Window) -> X (Maybe (Monitor Window))
forall a b. (a -> b) -> a -> b
$
            if Monitor Window -> String
forall a. Monitor a -> String
name Monitor Window
mon String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n then Monitor Window -> Maybe (Monitor Window)
forall a. a -> Maybe a
Just (Monitor Window -> Maybe (Monitor Window))
-> Monitor Window -> Maybe (Monitor Window)
forall a b. (a -> b) -> a -> b
$ Monitor Window
mon { visible :: Bool
visible = Bool
False } else Maybe (Monitor Window)
forall a. Maybe a
Nothing
        | Just LayoutMessages
Hide <- SomeMessage -> Maybe LayoutMessages
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
mess = do Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Monitor Window -> Bool
forall a. Monitor a -> Bool
persistent Monitor Window
mon) (X () -> X ()) -> X () -> X ()
forall a b. (a -> b) -> a -> b
$ Property -> () -> (Window -> X ()) -> X ()
forall a. Property -> a -> (Window -> X a) -> X a
withMonitor (Monitor Window -> Property
forall a. Monitor a -> Property
prop Monitor Window
mon) () Window -> X ()
hide; Maybe (Monitor Window) -> X (Maybe (Monitor Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Monitor Window)
forall a. Maybe a
Nothing
        | Bool
otherwise = Maybe (Monitor Window) -> X (Maybe (Monitor Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Monitor Window)
forall a. Maybe a
Nothing

-- | ManageHook which demanages monitor window and applies opacity settings.
manageMonitor :: Monitor a -> ManageHook
manageMonitor :: forall a. Monitor a -> ManageHook
manageMonitor Monitor a
mon = Property -> Query Bool
propertyToQuery (Monitor a -> Property
forall a. Monitor a -> Property
prop Monitor a
mon) Query Bool -> ManageHook -> ManageHook
forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> do
    Window
w <- Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask
    X () -> Query ()
forall a. X a -> Query a
liftX (X () -> Query ()) -> X () -> Query ()
forall a b. (a -> b) -> a -> b
$ Window -> Rational -> X ()
setOpacity Window
w (Rational -> X ()) -> Rational -> X ()
forall a b. (a -> b) -> a -> b
$ Monitor a -> Rational
forall a. Monitor a -> Rational
opacity Monitor a
mon
    if Monitor a -> Bool
forall a. Monitor a -> Bool
persistent Monitor a
mon then ManageHook
doIgnore else ManageHook
doHideIgnore

-- $hints
-- - This module assumes that there is only one window satisfying property exists.
--
-- - If your monitor is available on /all/ layouts, set
-- 'persistent' to 'True' to avoid unnecessary
-- flickering. You can still toggle monitor with a keybinding.
--
-- - You can use several monitors with nested modifiers. Give them names
---  to be able to toggle them independently.
--
-- - You can display monitor only on specific workspaces with
-- "XMonad.Layout.PerWorkspace".

-- $todo
-- - make Monitor remember the window it manages
--
-- - specify position relative to the screen