{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-}
{-# LANGUAGE PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Layout.Stoppable
-- Description :  A layout modifier to stop all non-visible processes.
-- Copyright   :  (c) Anton Vorontsov <anton@enomsg.org> 2014
-- License     :  BSD-style (as xmonad)
--
-- Maintainer  :  Anton Vorontsov <anton@enomsg.org>
-- Stability   :  unstable
-- Portability :  unportable
--
-- This module implements a special kind of layout modifier, which when
-- applied to a layout, causes xmonad to stop all non-visible processes.
-- In a way, this is a sledge-hammer for applications that drain power.
-- For example, given a web browser on a stoppable workspace, once the
-- workspace is hidden the web browser will be stopped.
--
-- Note that the stopped application won't be able to communicate with X11
-- clipboard. For this, the module actually stops applications after a
-- certain delay, giving a chance for a user to complete copy-paste
-- sequence. By default, the delay equals to 15 seconds, it is
-- configurable via 'Stoppable' constructor.
--
-- The stoppable modifier prepends a mark (by default equals to
-- \"Stoppable\") to the layout description (alternatively, you can choose
-- your own mark and use it with 'Stoppable' constructor). The stoppable
-- layout (identified by a mark) spans to multiple workspaces, letting you
-- to create groups of stoppable workspaces that only stop processes when
-- none of the workspaces are visible, and conversely, unfreezing all
-- processes even if one of the stoppable workspaces are visible.
--
-- To stop the process we use signals, which works for most cases. For
-- processes that tinker with signal handling (debuggers), another
-- (Linux-centric) approach may be used. See
-- <https://www.kernel.org/doc/Documentation/cgroups/freezer-subsystem.txt>
--
-- * Note
-- This module doesn't work on programs that do fancy things with processes
-- (such as Chromium) and programs that do not set _NET_WM_PID.
-----------------------------------------------------------------------------

module XMonad.Layout.Stoppable
    ( -- $usage
      Stoppable(..)
    , stoppable
    ) where

import XMonad
import XMonad.Prelude
import XMonad.Actions.WithAll
import XMonad.Util.WindowProperties
import XMonad.Util.RemoteWindows
import XMonad.Util.Timer
import XMonad.StackSet hiding (filter)
import XMonad.Layout.LayoutModifier
import System.Posix.Signals

-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad
-- > import XMonad.Layout.Stoppable
-- >
-- > main = xmonad def
-- >    { layoutHook = layoutHook def ||| stoppable (layoutHook def) }
--
-- Note that the module has to distinguish between local and remote
-- proccesses, which means that it needs to know the hostname, so it looks
-- for environment variables (e.g. HOST).
--
-- Environment variables will work for most cases, but won't work if the
-- hostname changes. To cover dynamic hostnames case, in addition to
-- layoutHook you have to provide manageHook from
-- "XMonad.Util.RemoteWindows" module.
--
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"

signalWindow :: Signal -> Window -> X ()
signalWindow :: Signal -> Window -> X ()
signalWindow Signal
s Window
w = do
    Maybe [CLong]
pid <- String -> Window -> X (Maybe [CLong])
getProp32s String
"_NET_WM_PID" Window
w
    IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ (Signal -> ProcessID -> IO ()
signalProcess Signal
s (ProcessID -> IO ()) -> (CLong -> ProcessID) -> CLong -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CLong -> ProcessID
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (CLong -> IO ()) -> [CLong] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
`mapM_` [CLong] -> Maybe [CLong] -> [CLong]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [CLong]
pid

signalLocalWindow :: Signal -> Window -> X ()
signalLocalWindow :: Signal -> Window -> X ()
signalLocalWindow Signal
s Window
w  = Window -> X Bool
isLocalWindow Window
w X Bool -> (Bool -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> X () -> X ()) -> X () -> Bool -> X ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Signal -> Window -> X ()
signalWindow Signal
s Window
w)

withAllOn :: (a -> X ()) -> Workspace i l a -> X ()
withAllOn :: forall a i l. (a -> X ()) -> Workspace i l a -> X ()
withAllOn a -> X ()
f Workspace i l a
wspc = a -> X ()
f (a -> X ()) -> [a] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
`mapM_` Maybe (Stack a) -> [a]
forall a. Maybe (Stack a) -> [a]
integrate' (Workspace i l a -> Maybe (Stack a)
forall i l a. Workspace i l a -> Maybe (Stack a)
stack Workspace i l a
wspc)

withAllFiltered :: (Workspace i l a -> Bool)
                -> [Workspace i l a]
                -> (a -> X ()) -> X ()
withAllFiltered :: forall i l a.
(Workspace i l a -> Bool)
-> [Workspace i l a] -> (a -> X ()) -> X ()
withAllFiltered Workspace i l a -> Bool
p [Workspace i l a]
wspcs a -> X ()
f = (a -> X ()) -> Workspace i l a -> X ()
forall a i l. (a -> X ()) -> Workspace i l a -> X ()
withAllOn a -> X ()
f (Workspace i l a -> X ()) -> [Workspace i l a] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
`mapM_` (Workspace i l a -> Bool) -> [Workspace i l a] -> [Workspace i l a]
forall a. (a -> Bool) -> [a] -> [a]
filter Workspace i l a -> Bool
p [Workspace i l a]
wspcs

sigStoppableWorkspacesHook :: String -> X ()
sigStoppableWorkspacesHook :: String -> X ()
sigStoppableWorkspacesHook String
k = do
    WindowSet
ws <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
    (Workspace String (Layout Window) Window -> Bool)
-> [Workspace String (Layout Window) Window]
-> (Window -> X ())
-> X ()
forall i l a.
(Workspace i l a -> Bool)
-> [Workspace i l a] -> (a -> X ()) -> X ()
withAllFiltered Workspace String (Layout Window) Window -> Bool
forall {layout :: * -> *} {a} {i} {a}.
LayoutClass layout a =>
Workspace i (layout a) a -> Bool
isStoppable (WindowSet -> [Workspace String (Layout Window) Window]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
hidden WindowSet
ws) (Signal -> Window -> X ()
signalLocalWindow Signal
sigSTOP)
  where
    isStoppable :: Workspace i (layout a) a -> Bool
isStoppable Workspace i (layout a) a
ws = String
k String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String -> [String]
words (layout a -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description (layout a -> String) -> layout a -> String
forall a b. (a -> b) -> a -> b
$ Workspace i (layout a) a -> layout a
forall i l a. Workspace i l a -> l
layout Workspace i (layout a) a
ws)

-- | Data type for ModifiedLayout. The constructor lets you to specify a
-- custom mark/description modifier and a delay. You can also use
-- 'stoppable' helper function.
data Stoppable a = Stoppable
    { forall a. Stoppable a -> String
mark :: String
    , forall a. Stoppable a -> Rational
delay :: Rational
    , forall a. Stoppable a -> Maybe TimerId
timer :: Maybe TimerId
    } deriving (TimerId -> Stoppable a -> ShowS
[Stoppable a] -> ShowS
Stoppable a -> String
(TimerId -> Stoppable a -> ShowS)
-> (Stoppable a -> String)
-> ([Stoppable a] -> ShowS)
-> Show (Stoppable a)
forall a. TimerId -> Stoppable a -> ShowS
forall a. [Stoppable a] -> ShowS
forall a. Stoppable a -> String
forall a.
(TimerId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stoppable a] -> ShowS
$cshowList :: forall a. [Stoppable a] -> ShowS
show :: Stoppable a -> String
$cshow :: forall a. Stoppable a -> String
showsPrec :: TimerId -> Stoppable a -> ShowS
$cshowsPrec :: forall a. TimerId -> Stoppable a -> ShowS
Show,ReadPrec [Stoppable a]
ReadPrec (Stoppable a)
TimerId -> ReadS (Stoppable a)
ReadS [Stoppable a]
(TimerId -> ReadS (Stoppable a))
-> ReadS [Stoppable a]
-> ReadPrec (Stoppable a)
-> ReadPrec [Stoppable a]
-> Read (Stoppable a)
forall a. ReadPrec [Stoppable a]
forall a. ReadPrec (Stoppable a)
forall a. TimerId -> ReadS (Stoppable a)
forall a. ReadS [Stoppable a]
forall a.
(TimerId -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Stoppable a]
$creadListPrec :: forall a. ReadPrec [Stoppable a]
readPrec :: ReadPrec (Stoppable a)
$creadPrec :: forall a. ReadPrec (Stoppable a)
readList :: ReadS [Stoppable a]
$creadList :: forall a. ReadS [Stoppable a]
readsPrec :: TimerId -> ReadS (Stoppable a)
$creadsPrec :: forall a. TimerId -> ReadS (Stoppable a)
Read)

instance LayoutModifier Stoppable Window where
    modifierDescription :: Stoppable Window -> String
modifierDescription = Stoppable Window -> String
forall a. Stoppable a -> String
mark

    hook :: Stoppable Window -> X ()
hook Stoppable Window
_   = (Window -> X ()) -> X ()
withAll ((Window -> X ()) -> X ()) -> (Window -> X ()) -> X ()
forall a b. (a -> b) -> a -> b
$ Signal -> Window -> X ()
signalLocalWindow Signal
sigCONT

    handleMess :: Stoppable Window -> SomeMessage -> X (Maybe (Stoppable Window))
handleMess (Stoppable String
m Rational
_ (Just TimerId
tid)) SomeMessage
msg
        | Just Event
ev <- SomeMessage -> Maybe Event
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
msg = TimerId
-> Event
-> X (Maybe (Stoppable Window))
-> X (Maybe (Stoppable Window))
forall a. TimerId -> Event -> X (Maybe a) -> X (Maybe a)
handleTimer TimerId
tid Event
ev X (Maybe (Stoppable Window))
forall {a}. X (Maybe a)
run
          where run :: X (Maybe a)
run = String -> X ()
sigStoppableWorkspacesHook String
m X () -> X (Maybe a) -> X (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe a -> X (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    handleMess (Stoppable String
m Rational
d Maybe TimerId
_) SomeMessage
msg
        | Just LayoutMessages
Hide <- SomeMessage -> Maybe LayoutMessages
forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
msg =
            Stoppable Window -> Maybe (Stoppable Window)
forall a. a -> Maybe a
Just (Stoppable Window -> Maybe (Stoppable Window))
-> (TimerId -> Stoppable Window)
-> TimerId
-> Maybe (Stoppable Window)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Rational -> Maybe TimerId -> Stoppable Window
forall a. String -> Rational -> Maybe TimerId -> Stoppable a
Stoppable String
m Rational
d (Maybe TimerId -> Stoppable Window)
-> (TimerId -> Maybe TimerId) -> TimerId -> Stoppable Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimerId -> Maybe TimerId
forall a. a -> Maybe a
Just (TimerId -> Maybe (Stoppable Window))
-> X TimerId -> X (Maybe (Stoppable Window))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Rational -> X TimerId
startTimer Rational
d
        | Bool
otherwise = Maybe (Stoppable Window) -> X (Maybe (Stoppable Window))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Stoppable Window)
forall a. Maybe a
Nothing

-- | Convert a layout to a stoppable layout using the default mark
-- (\"Stoppable\") and a delay of 15 seconds.
stoppable :: l a -> ModifiedLayout Stoppable l a
stoppable :: forall (l :: * -> *) a. l a -> ModifiedLayout Stoppable l a
stoppable = Stoppable a -> l a -> ModifiedLayout Stoppable l a
forall (m :: * -> *) (l :: * -> *) a.
m a -> l a -> ModifiedLayout m l a
ModifiedLayout (String -> Rational -> Maybe TimerId -> Stoppable a
forall a. String -> Rational -> Maybe TimerId -> Stoppable a
Stoppable String
"Stoppable" Rational
15 Maybe TimerId
forall a. Maybe a
Nothing)