{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DerivingVia #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Core
-- Copyright   :  (c) Spencer Janssen 2007
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  spencerjanssen@gmail.com
-- Stability   :  unstable
-- Portability :  not portable, uses cunning newtype deriving
--
-- The 'X' monad, a state monad transformer over 'IO', for the window
-- manager state, and support routines.
--
-----------------------------------------------------------------------------

module XMonad.Core (
    X, WindowSet, WindowSpace, WorkspaceId,
    ScreenId(..), ScreenDetail(..), XState(..),
    XConf(..), XConfig(..), LayoutClass(..),
    Layout(..), readsLayout, Typeable, Message,
    SomeMessage(..), fromMessage, LayoutMessages(..),
    StateExtension(..), ExtensionClass(..), ConfExtension(..),
    runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers,
    withDisplay, withWindowSet, isRoot, runOnWorkspaces,
    getAtom, spawn, spawnPID, xfork, xmessage, recompile, trace, whenJust, whenX, ifM,
    getXMonadDir, getXMonadCacheDir, getXMonadDataDir, stateFileName, binFileName,
    atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, withWindowAttributes,
    ManageHook, Query(..), runQuery, Directories'(..), Directories, getDirectories,
  ) where

import XMonad.StackSet hiding (modify)

import Prelude
import Control.Exception (fromException, try, bracket_, throw, finally, SomeException(..))
import qualified Control.Exception as E
import Control.Applicative ((<|>), empty)
import Control.Monad.Fail
import Control.Monad.Fix (fix)
import Control.Monad.State
import Control.Monad.Reader
import Control.Monad (filterM, guard, void, when)
import Data.Semigroup
import Data.Traversable (for)
import Data.Time.Clock (UTCTime)
import Data.Default.Class
import System.Environment (lookupEnv)
import Data.List (isInfixOf, intercalate, (\\))
import System.FilePath
import System.IO
import System.Info
import System.Posix.Env (getEnv)
import System.Posix.Process (executeFile, forkProcess, getAnyProcessStatus, createSession)
import System.Posix.Signals
import System.Posix.IO
import System.Posix.Types (ProcessID)
import System.Process
import System.Directory
import System.Exit
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras (getWindowAttributes, WindowAttributes, Event)
import Data.Typeable
import Data.Maybe (isJust,fromMaybe)
import Data.Monoid (Ap(..))

import qualified Data.Map as M
import qualified Data.Set as S

-- | XState, the (mutable) window manager state.
data XState = XState
    { XState -> WindowSet
windowset        :: !WindowSet                     -- ^ workspace list
    , XState -> Set Window
mapped           :: !(S.Set Window)                -- ^ the Set of mapped windows
    , XState -> Map Window Int
waitingUnmap     :: !(M.Map Window Int)            -- ^ the number of expected UnmapEvents
    , XState -> Maybe (Position -> Position -> X (), X ())
dragging         :: !(Maybe (Position -> Position -> X (), X ()))
    , XState -> KeyMask
numberlockMask   :: !KeyMask                       -- ^ The numlock modifier
    , XState -> Map FilePath (Either FilePath StateExtension)
extensibleState  :: !(M.Map String (Either String StateExtension))
    -- ^ stores custom state information.
    --
    -- The module "XMonad.Util.ExtensibleState" in xmonad-contrib
    -- provides additional information and a simple interface for using this.
    }

-- | XConf, the (read-only) window manager configuration.
data XConf = XConf
    { XConf -> Display
display       :: Display        -- ^ the X11 display
    , XConf -> XConfig Layout
config        :: !(XConfig Layout)       -- ^ initial user configuration
    , XConf -> Window
theRoot       :: !Window        -- ^ the root window
    , XConf -> Window
normalBorder  :: !Pixel         -- ^ border color of unfocused windows
    , XConf -> Window
focusedBorder :: !Pixel         -- ^ border color of the focused window
    , XConf -> Map (KeyMask, Window) (X ())
keyActions    :: !(M.Map (KeyMask, KeySym) (X ()))
                                      -- ^ a mapping of key presses to actions
    , XConf -> Map (KeyMask, Button) (Window -> X ())
buttonActions :: !(M.Map (KeyMask, Button) (Window -> X ()))
                                      -- ^ a mapping of button presses to actions
    , XConf -> Bool
mouseFocused :: !Bool           -- ^ was refocus caused by mouse action?
    , XConf -> Maybe (Position, Position)
mousePosition :: !(Maybe (Position, Position))
                                      -- ^ position of the mouse according to
                                      -- the event currently being processed
    , XConf -> Maybe Event
currentEvent :: !(Maybe Event)  -- ^ event currently being processed
    , XConf -> Directories
directories  :: !Directories    -- ^ directories to use
    }

-- todo, better name
data XConfig l = XConfig
    { forall (l :: * -> *). XConfig l -> FilePath
normalBorderColor  :: !String              -- ^ Non focused windows border color. Default: \"#dddddd\"
    , forall (l :: * -> *). XConfig l -> FilePath
focusedBorderColor :: !String              -- ^ Focused windows border color. Default: \"#ff0000\"
    , forall (l :: * -> *). XConfig l -> FilePath
terminal           :: !String              -- ^ The preferred terminal application. Default: \"xterm\"
    , forall (l :: * -> *). XConfig l -> l Window
layoutHook         :: !(l Window)          -- ^ The available layouts
    , forall (l :: * -> *). XConfig l -> ManageHook
manageHook         :: !ManageHook          -- ^ The action to run when a new window is opened
    , forall (l :: * -> *). XConfig l -> Event -> X All
handleEventHook    :: !(Event -> X All)    -- ^ Handle an X event, returns (All True) if the default handler
                                                 -- should also be run afterwards. mappend should be used for combining
                                                 -- event hooks in most cases.
    , forall (l :: * -> *). XConfig l -> [FilePath]
workspaces         :: ![String]            -- ^ The list of workspaces' names
    , forall (l :: * -> *). XConfig l -> KeyMask
modMask            :: !KeyMask             -- ^ the mod modifier
    , forall (l :: * -> *).
XConfig l -> XConfig Layout -> Map (KeyMask, Window) (X ())
keys               :: !(XConfig Layout -> M.Map (ButtonMask,KeySym) (X ()))
                                                 -- ^ The key binding: a map from key presses and actions
    , forall (l :: * -> *).
XConfig l
-> XConfig Layout -> Map (KeyMask, Button) (Window -> X ())
mouseBindings      :: !(XConfig Layout -> M.Map (ButtonMask, Button) (Window -> X ()))
                                                 -- ^ The mouse bindings
    , forall (l :: * -> *). XConfig l -> Button
borderWidth        :: !Dimension           -- ^ The border width
    , forall (l :: * -> *). XConfig l -> X ()
logHook            :: !(X ())              -- ^ The action to perform when the windows set is changed
    , forall (l :: * -> *). XConfig l -> X ()
startupHook        :: !(X ())              -- ^ The action to perform on startup
    , forall (l :: * -> *). XConfig l -> Bool
focusFollowsMouse  :: !Bool                -- ^ Whether window entry events can change focus
    , forall (l :: * -> *). XConfig l -> Bool
clickJustFocuses   :: !Bool                -- ^ False to make a click which changes focus to be additionally passed to the window
    , forall (l :: * -> *). XConfig l -> Window
clientMask         :: !EventMask           -- ^ The client events that xmonad is interested in
    , forall (l :: * -> *). XConfig l -> Window
rootMask           :: !EventMask           -- ^ The root events that xmonad is interested in
    , forall (l :: * -> *).
XConfig l -> [FilePath] -> XConfig Layout -> IO (XConfig Layout)
handleExtraArgs    :: !([String] -> XConfig Layout -> IO (XConfig Layout))
                                                 -- ^ Modify the configuration, complain about extra arguments etc. with arguments that are not handled by default
    , forall (l :: * -> *). XConfig l -> Map TypeRep ConfExtension
extensibleConf     :: !(M.Map TypeRep ConfExtension)
                                                 -- ^ Stores custom config information.
                                                 --
                                                 -- The module "XMonad.Util.ExtensibleConf" in xmonad-contrib
                                                 -- provides additional information and a simple interface for using this.
    }


type WindowSet   = StackSet  WorkspaceId (Layout Window) Window ScreenId ScreenDetail
type WindowSpace = Workspace WorkspaceId (Layout Window) Window

-- | Virtual workspace indices
type WorkspaceId = String

-- | Physical screen indices
newtype ScreenId    = S Int deriving (ScreenId -> ScreenId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScreenId -> ScreenId -> Bool
$c/= :: ScreenId -> ScreenId -> Bool
== :: ScreenId -> ScreenId -> Bool
$c== :: ScreenId -> ScreenId -> Bool
Eq,Eq ScreenId
ScreenId -> ScreenId -> Bool
ScreenId -> ScreenId -> Ordering
ScreenId -> ScreenId -> ScreenId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ScreenId -> ScreenId -> ScreenId
$cmin :: ScreenId -> ScreenId -> ScreenId
max :: ScreenId -> ScreenId -> ScreenId
$cmax :: ScreenId -> ScreenId -> ScreenId
>= :: ScreenId -> ScreenId -> Bool
$c>= :: ScreenId -> ScreenId -> Bool
> :: ScreenId -> ScreenId -> Bool
$c> :: ScreenId -> ScreenId -> Bool
<= :: ScreenId -> ScreenId -> Bool
$c<= :: ScreenId -> ScreenId -> Bool
< :: ScreenId -> ScreenId -> Bool
$c< :: ScreenId -> ScreenId -> Bool
compare :: ScreenId -> ScreenId -> Ordering
$ccompare :: ScreenId -> ScreenId -> Ordering
Ord,Int -> ScreenId -> ShowS
[ScreenId] -> ShowS
ScreenId -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ScreenId] -> ShowS
$cshowList :: [ScreenId] -> ShowS
show :: ScreenId -> FilePath
$cshow :: ScreenId -> FilePath
showsPrec :: Int -> ScreenId -> ShowS
$cshowsPrec :: Int -> ScreenId -> ShowS
Show,ReadPrec [ScreenId]
ReadPrec ScreenId
Int -> ReadS ScreenId
ReadS [ScreenId]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ScreenId]
$creadListPrec :: ReadPrec [ScreenId]
readPrec :: ReadPrec ScreenId
$creadPrec :: ReadPrec ScreenId
readList :: ReadS [ScreenId]
$creadList :: ReadS [ScreenId]
readsPrec :: Int -> ReadS ScreenId
$creadsPrec :: Int -> ReadS ScreenId
Read,Int -> ScreenId
ScreenId -> Int
ScreenId -> [ScreenId]
ScreenId -> ScreenId
ScreenId -> ScreenId -> [ScreenId]
ScreenId -> ScreenId -> ScreenId -> [ScreenId]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ScreenId -> ScreenId -> ScreenId -> [ScreenId]
$cenumFromThenTo :: ScreenId -> ScreenId -> ScreenId -> [ScreenId]
enumFromTo :: ScreenId -> ScreenId -> [ScreenId]
$cenumFromTo :: ScreenId -> ScreenId -> [ScreenId]
enumFromThen :: ScreenId -> ScreenId -> [ScreenId]
$cenumFromThen :: ScreenId -> ScreenId -> [ScreenId]
enumFrom :: ScreenId -> [ScreenId]
$cenumFrom :: ScreenId -> [ScreenId]
fromEnum :: ScreenId -> Int
$cfromEnum :: ScreenId -> Int
toEnum :: Int -> ScreenId
$ctoEnum :: Int -> ScreenId
pred :: ScreenId -> ScreenId
$cpred :: ScreenId -> ScreenId
succ :: ScreenId -> ScreenId
$csucc :: ScreenId -> ScreenId
Enum,Integer -> ScreenId
ScreenId -> ScreenId
ScreenId -> ScreenId -> ScreenId
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ScreenId
$cfromInteger :: Integer -> ScreenId
signum :: ScreenId -> ScreenId
$csignum :: ScreenId -> ScreenId
abs :: ScreenId -> ScreenId
$cabs :: ScreenId -> ScreenId
negate :: ScreenId -> ScreenId
$cnegate :: ScreenId -> ScreenId
* :: ScreenId -> ScreenId -> ScreenId
$c* :: ScreenId -> ScreenId -> ScreenId
- :: ScreenId -> ScreenId -> ScreenId
$c- :: ScreenId -> ScreenId -> ScreenId
+ :: ScreenId -> ScreenId -> ScreenId
$c+ :: ScreenId -> ScreenId -> ScreenId
Num,Enum ScreenId
Real ScreenId
ScreenId -> Integer
ScreenId -> ScreenId -> (ScreenId, ScreenId)
ScreenId -> ScreenId -> ScreenId
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: ScreenId -> Integer
$ctoInteger :: ScreenId -> Integer
divMod :: ScreenId -> ScreenId -> (ScreenId, ScreenId)
$cdivMod :: ScreenId -> ScreenId -> (ScreenId, ScreenId)
quotRem :: ScreenId -> ScreenId -> (ScreenId, ScreenId)
$cquotRem :: ScreenId -> ScreenId -> (ScreenId, ScreenId)
mod :: ScreenId -> ScreenId -> ScreenId
$cmod :: ScreenId -> ScreenId -> ScreenId
div :: ScreenId -> ScreenId -> ScreenId
$cdiv :: ScreenId -> ScreenId -> ScreenId
rem :: ScreenId -> ScreenId -> ScreenId
$crem :: ScreenId -> ScreenId -> ScreenId
quot :: ScreenId -> ScreenId -> ScreenId
$cquot :: ScreenId -> ScreenId -> ScreenId
Integral,Num ScreenId
Ord ScreenId
ScreenId -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: ScreenId -> Rational
$ctoRational :: ScreenId -> Rational
Real)

-- | The 'Rectangle' with screen dimensions
newtype ScreenDetail = SD { ScreenDetail -> Rectangle
screenRect :: Rectangle }
    deriving (ScreenDetail -> ScreenDetail -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScreenDetail -> ScreenDetail -> Bool
$c/= :: ScreenDetail -> ScreenDetail -> Bool
== :: ScreenDetail -> ScreenDetail -> Bool
$c== :: ScreenDetail -> ScreenDetail -> Bool
Eq,Int -> ScreenDetail -> ShowS
[ScreenDetail] -> ShowS
ScreenDetail -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ScreenDetail] -> ShowS
$cshowList :: [ScreenDetail] -> ShowS
show :: ScreenDetail -> FilePath
$cshow :: ScreenDetail -> FilePath
showsPrec :: Int -> ScreenDetail -> ShowS
$cshowsPrec :: Int -> ScreenDetail -> ShowS
Show, ReadPrec [ScreenDetail]
ReadPrec ScreenDetail
Int -> ReadS ScreenDetail
ReadS [ScreenDetail]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ScreenDetail]
$creadListPrec :: ReadPrec [ScreenDetail]
readPrec :: ReadPrec ScreenDetail
$creadPrec :: ReadPrec ScreenDetail
readList :: ReadS [ScreenDetail]
$creadList :: ReadS [ScreenDetail]
readsPrec :: Int -> ReadS ScreenDetail
$creadsPrec :: Int -> ReadS ScreenDetail
Read)

------------------------------------------------------------------------

-- | The X monad, 'ReaderT' and 'StateT' transformers over 'IO'
-- encapsulating the window manager configuration and state,
-- respectively.
--
-- Dynamic components may be retrieved with 'get', static components
-- with 'ask'. With newtype deriving we get readers and state monads
-- instantiated on 'XConf' and 'XState' automatically.
--
newtype X a = X (ReaderT XConf (StateT XState IO) a)
    deriving (forall a b. a -> X b -> X a
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> X b -> X a
$c<$ :: forall a b. a -> X b -> X a
fmap :: forall a b. (a -> b) -> X a -> X b
$cfmap :: forall a b. (a -> b) -> X a -> X b
Functor, Functor X
forall a. a -> X a
forall a b. X a -> X b -> X a
forall a b. X a -> X b -> X b
forall a b. X (a -> b) -> X a -> X b
forall a b c. (a -> b -> c) -> X a -> X b -> X c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. X a -> X b -> X a
$c<* :: forall a b. X a -> X b -> X a
*> :: forall a b. X a -> X b -> X b
$c*> :: forall a b. X a -> X b -> X b
liftA2 :: forall a b c. (a -> b -> c) -> X a -> X b -> X c
$cliftA2 :: forall a b c. (a -> b -> c) -> X a -> X b -> X c
<*> :: forall a b. X (a -> b) -> X a -> X b
$c<*> :: forall a b. X (a -> b) -> X a -> X b
pure :: forall a. a -> X a
$cpure :: forall a. a -> X a
Applicative, Applicative X
forall a. a -> X a
forall a b. X a -> X b -> X b
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> X a
$creturn :: forall a. a -> X a
>> :: forall a b. X a -> X b -> X b
$c>> :: forall a b. X a -> X b -> X b
>>= :: forall a b. X a -> (a -> X b) -> X b
$c>>= :: forall a b. X a -> (a -> X b) -> X b
Monad, Monad X
forall a. FilePath -> X a
forall (m :: * -> *).
Monad m -> (forall a. FilePath -> m a) -> MonadFail m
fail :: forall a. FilePath -> X a
$cfail :: forall a. FilePath -> X a
MonadFail, Monad X
forall a. IO a -> X a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> X a
$cliftIO :: forall a. IO a -> X a
MonadIO, MonadState XState, MonadReader XConf)
    deriving (NonEmpty (X a) -> X a
X a -> X a -> X a
forall b. Integral b => b -> X a -> X a
forall a. Semigroup a => NonEmpty (X a) -> X a
forall a. Semigroup a => X a -> X a -> X a
forall a b. (Semigroup a, Integral b) => b -> X a -> X a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> X a -> X a
$cstimes :: forall a b. (Semigroup a, Integral b) => b -> X a -> X a
sconcat :: NonEmpty (X a) -> X a
$csconcat :: forall a. Semigroup a => NonEmpty (X a) -> X a
<> :: X a -> X a -> X a
$c<> :: forall a. Semigroup a => X a -> X a -> X a
Semigroup, X a
[X a] -> X a
X a -> X a -> X a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall {a}. Monoid a => Semigroup (X a)
forall a. Monoid a => X a
forall a. Monoid a => [X a] -> X a
forall a. Monoid a => X a -> X a -> X a
mconcat :: [X a] -> X a
$cmconcat :: forall a. Monoid a => [X a] -> X a
mappend :: X a -> X a -> X a
$cmappend :: forall a. Monoid a => X a -> X a -> X a
mempty :: X a
$cmempty :: forall a. Monoid a => X a
Monoid) via Ap X a

instance Default a => Default (X a) where
    def :: X a
def = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Default a => a
def

type ManageHook = Query (Endo WindowSet)
newtype Query a = Query (ReaderT Window X a)
    deriving (forall a b. a -> Query b -> Query a
forall a b. (a -> b) -> Query a -> Query b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Query b -> Query a
$c<$ :: forall a b. a -> Query b -> Query a
fmap :: forall a b. (a -> b) -> Query a -> Query b
$cfmap :: forall a b. (a -> b) -> Query a -> Query b
Functor, Functor Query
forall a. a -> Query a
forall a b. Query a -> Query b -> Query a
forall a b. Query a -> Query b -> Query b
forall a b. Query (a -> b) -> Query a -> Query b
forall a b c. (a -> b -> c) -> Query a -> Query b -> Query c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Query a -> Query b -> Query a
$c<* :: forall a b. Query a -> Query b -> Query a
*> :: forall a b. Query a -> Query b -> Query b
$c*> :: forall a b. Query a -> Query b -> Query b
liftA2 :: forall a b c. (a -> b -> c) -> Query a -> Query b -> Query c
$cliftA2 :: forall a b c. (a -> b -> c) -> Query a -> Query b -> Query c
<*> :: forall a b. Query (a -> b) -> Query a -> Query b
$c<*> :: forall a b. Query (a -> b) -> Query a -> Query b
pure :: forall a. a -> Query a
$cpure :: forall a. a -> Query a
Applicative, Applicative Query
forall a. a -> Query a
forall a b. Query a -> Query b -> Query b
forall a b. Query a -> (a -> Query b) -> Query b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Query a
$creturn :: forall a. a -> Query a
>> :: forall a b. Query a -> Query b -> Query b
$c>> :: forall a b. Query a -> Query b -> Query b
>>= :: forall a b. Query a -> (a -> Query b) -> Query b
$c>>= :: forall a b. Query a -> (a -> Query b) -> Query b
Monad, MonadReader Window, Monad Query
forall a. IO a -> Query a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Query a
$cliftIO :: forall a. IO a -> Query a
MonadIO)
    deriving (NonEmpty (Query a) -> Query a
Query a -> Query a -> Query a
forall b. Integral b => b -> Query a -> Query a
forall a. Semigroup a => NonEmpty (Query a) -> Query a
forall a. Semigroup a => Query a -> Query a -> Query a
forall a b. (Semigroup a, Integral b) => b -> Query a -> Query a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Query a -> Query a
$cstimes :: forall a b. (Semigroup a, Integral b) => b -> Query a -> Query a
sconcat :: NonEmpty (Query a) -> Query a
$csconcat :: forall a. Semigroup a => NonEmpty (Query a) -> Query a
<> :: Query a -> Query a -> Query a
$c<> :: forall a. Semigroup a => Query a -> Query a -> Query a
Semigroup, Query a
[Query a] -> Query a
Query a -> Query a -> Query a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall {a}. Monoid a => Semigroup (Query a)
forall a. Monoid a => Query a
forall a. Monoid a => [Query a] -> Query a
forall a. Monoid a => Query a -> Query a -> Query a
mconcat :: [Query a] -> Query a
$cmconcat :: forall a. Monoid a => [Query a] -> Query a
mappend :: Query a -> Query a -> Query a
$cmappend :: forall a. Monoid a => Query a -> Query a -> Query a
mempty :: Query a
$cmempty :: forall a. Monoid a => Query a
Monoid) via Ap Query a

runQuery :: Query a -> Window -> X a
runQuery :: forall a. Query a -> Window -> X a
runQuery (Query ReaderT Window X a
m) = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Window X a
m

instance Default a => Default (Query a) where
    def :: Query a
def = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Default a => a
def

-- | Run the 'X' monad, given a chunk of 'X' monad code, and an initial state
-- Return the result, and final state
runX :: XConf -> XState -> X a -> IO (a, XState)
runX :: forall a. XConf -> XState -> X a -> IO (a, XState)
runX XConf
c XState
st (X ReaderT XConf (StateT XState IO) a
a) = forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT XConf (StateT XState IO) a
a XConf
c) XState
st

-- | Run in the 'X' monad, and in case of exception, and catch it and log it
-- to stderr, and run the error case.
catchX :: X a -> X a -> X a
catchX :: forall a. X a -> X a -> X a
catchX X a
job X a
errcase = do
    XState
st <- forall s (m :: * -> *). MonadState s m => m s
get
    XConf
c <- forall r (m :: * -> *). MonadReader r m => m r
ask
    (a
a, XState
s') <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a. XConf -> XState -> X a -> IO (a, XState)
runX XConf
c XState
st X a
job forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \SomeException
e -> case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
                        Just (ExitCode
_ :: ExitCode) -> forall a e. Exception e => e -> a
throw SomeException
e
                        Maybe ExitCode
_ -> do forall a. Show a => Handle -> a -> IO ()
hPrint Handle
stderr SomeException
e; forall a. XConf -> XState -> X a -> IO (a, XState)
runX XConf
c XState
st X a
errcase
    forall s (m :: * -> *). MonadState s m => s -> m ()
put XState
s'
    forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Execute the argument, catching all exceptions.  Either this function or
-- 'catchX' should be used at all callsites of user customized code.
userCode :: X a -> X (Maybe a)
userCode :: forall a. X a -> X (Maybe a)
userCode X a
a = forall a. X a -> X a -> X a
catchX (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X a
a) (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)

-- | Same as userCode but with a default argument to return instead of using
-- Maybe, provided for convenience.
userCodeDef :: a -> X a -> X a
userCodeDef :: forall a. a -> X a -> X a
userCodeDef a
defValue X a
a = forall a. a -> Maybe a -> a
fromMaybe a
defValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. X a -> X (Maybe a)
userCode X a
a

-- ---------------------------------------------------------------------
-- Convenient wrappers to state

-- | Run a monad action with the current display settings
withDisplay :: (Display -> X a) -> X a
withDisplay :: forall a. (Display -> X a) -> X a
withDisplay   Display -> X a
f = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Display -> X a
f

-- | Run a monadic action with the current stack set
withWindowSet :: (WindowSet -> X a) -> X a
withWindowSet :: forall a. (WindowSet -> X a) -> X a
withWindowSet WindowSet -> X a
f = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WindowSet -> X a
f

-- | Safely access window attributes.
withWindowAttributes :: Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes :: Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
dpy Window
win WindowAttributes -> X ()
f = do
    Maybe WindowAttributes
wa <- forall a. X a -> X (Maybe a)
userCode (forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO WindowAttributes
getWindowAttributes Display
dpy Window
win)
    forall a. X a -> X a -> X a
catchX (forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe WindowAttributes
wa WindowAttributes -> X ()
f) (forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | True if the given window is the root window
isRoot :: Window -> X Bool
isRoot :: Window -> X Bool
isRoot Window
w = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ (Window
w forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> Window
theRoot

-- | Wrapper for the common case of atom internment
getAtom :: String -> X Atom
getAtom :: FilePath -> X Window
getAtom FilePath
str = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> FilePath -> Bool -> IO Window
internAtom Display
dpy FilePath
str Bool
False

-- | Common non-predefined atoms
atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_STATE, atom_WM_TAKE_FOCUS :: X Atom
atom_WM_PROTOCOLS :: X Window
atom_WM_PROTOCOLS       = FilePath -> X Window
getAtom FilePath
"WM_PROTOCOLS"
atom_WM_DELETE_WINDOW :: X Window
atom_WM_DELETE_WINDOW   = FilePath -> X Window
getAtom FilePath
"WM_DELETE_WINDOW"
atom_WM_STATE :: X Window
atom_WM_STATE           = FilePath -> X Window
getAtom FilePath
"WM_STATE"
atom_WM_TAKE_FOCUS :: X Window
atom_WM_TAKE_FOCUS      = FilePath -> X Window
getAtom FilePath
"WM_TAKE_FOCUS"

------------------------------------------------------------------------
-- LayoutClass handling. See particular instances in Operations.hs

-- | An existential type that can hold any object that is in 'Read'
--   and 'LayoutClass'.
data Layout a = forall l. (LayoutClass l a, Read (l a)) => Layout (l a)

-- | Using the 'Layout' as a witness, parse existentially wrapped windows
-- from a 'String'.
readsLayout :: Layout a -> String -> [(Layout a, String)]
readsLayout :: forall a. Layout a -> FilePath -> [(Layout a, FilePath)]
readsLayout (Layout l a
l) FilePath
s = [(forall a (l :: * -> *).
(LayoutClass l a, Read (l a)) =>
l a -> Layout a
Layout (forall a. a -> a -> a
asTypeOf l a
x l a
l), FilePath
rs) | (l a
x, FilePath
rs) <- forall a. Read a => ReadS a
reads FilePath
s]

-- | Every layout must be an instance of 'LayoutClass', which defines
-- the basic layout operations along with a sensible default for each.
--
-- All of the methods have default implementations, so there is no
-- minimal complete definition.  They do, however, have a dependency
-- structure by default; this is something to be aware of should you
-- choose to implement one of these methods.  Here is how a minimal
-- complete definition would look like if we did not provide any default
-- implementations:
--
-- * 'runLayout' || (('doLayout' || 'pureLayout') && 'emptyLayout')
--
-- * 'handleMessage' || 'pureMessage'
--
-- * 'description'
--
-- Note that any code which /uses/ 'LayoutClass' methods should only
-- ever call 'runLayout', 'handleMessage', and 'description'!  In
-- other words, the only calls to 'doLayout', 'pureMessage', and other
-- such methods should be from the default implementations of
-- 'runLayout', 'handleMessage', and so on.  This ensures that the
-- proper methods will be used, regardless of the particular methods
-- that any 'LayoutClass' instance chooses to define.
class (Show (layout a), Typeable layout) => LayoutClass layout a where

    -- | By default, 'runLayout' calls 'doLayout' if there are any
    --   windows to be laid out, and 'emptyLayout' otherwise.  Most
    --   instances of 'LayoutClass' probably do not need to implement
    --   'runLayout'; it is only useful for layouts which wish to make
    --   use of more of the 'Workspace' information (for example,
    --   "XMonad.Layout.PerWorkspace").
    runLayout :: Workspace WorkspaceId (layout a) a
              -> Rectangle
              -> X ([(a, Rectangle)], Maybe (layout a))
    runLayout (Workspace FilePath
_ layout a
l Maybe (Stack a)
ms) Rectangle
r = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
emptyLayout layout a
l Rectangle
r) (forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a
-> Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (layout a))
doLayout layout a
l Rectangle
r) Maybe (Stack a)
ms

    -- | Given a 'Rectangle' in which to place the windows, and a 'Stack'
    -- of windows, return a list of windows and their corresponding
    -- Rectangles.  If an element is not given a Rectangle by
    -- 'doLayout', then it is not shown on screen.  The order of
    -- windows in this list should be the desired stacking order.
    --
    -- Also possibly return a modified layout (by returning @Just
    -- newLayout@), if this layout needs to be modified (e.g. if it
    -- keeps track of some sort of state).  Return @Nothing@ if the
    -- layout does not need to be modified.
    --
    -- Layouts which do not need access to the 'X' monad ('IO', window
    -- manager state, or configuration) and do not keep track of their
    -- own state should implement 'pureLayout' instead of 'doLayout'.
    doLayout    :: layout a -> Rectangle -> Stack a
                -> X ([(a, Rectangle)], Maybe (layout a))
    doLayout layout a
l Rectangle
r Stack a
s   = forall (m :: * -> *) a. Monad m => a -> m a
return (forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout layout a
l Rectangle
r Stack a
s, forall a. Maybe a
Nothing)

    -- | This is a pure version of 'doLayout', for cases where we
    -- don't need access to the 'X' monad to determine how to lay out
    -- the windows, and we don't need to modify the layout itself.
    pureLayout  :: layout a -> Rectangle -> Stack a -> [(a, Rectangle)]
    pureLayout layout a
_ Rectangle
r Stack a
s = [(forall a. Stack a -> a
focus Stack a
s, Rectangle
r)]

    -- | 'emptyLayout' is called when there are no windows.
    emptyLayout :: layout a -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
    emptyLayout layout a
_ Rectangle
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall a. Maybe a
Nothing)

    -- | 'handleMessage' performs message handling.  If
    -- 'handleMessage' returns @Nothing@, then the layout did not
    -- respond to the message and the screen is not refreshed.
    -- Otherwise, 'handleMessage' returns an updated layout and the
    -- screen is refreshed.
    --
    -- Layouts which do not need access to the 'X' monad to decide how
    -- to handle messages should implement 'pureMessage' instead of
    -- 'handleMessage' (this restricts the risk of error, and makes
    -- testing much easier).
    handleMessage :: layout a -> SomeMessage -> X (Maybe (layout a))
    handleMessage layout a
l  = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> Maybe (layout a)
pureMessage layout a
l

    -- | Respond to a message by (possibly) changing our layout, but
    -- taking no other action.  If the layout changes, the screen will
    -- be refreshed.
    pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
    pureMessage layout a
_ SomeMessage
_  = forall a. Maybe a
Nothing

    -- | This should be a human-readable string that is used when
    -- selecting layouts by name.  The default implementation is
    -- 'show', which is in some cases a poor default.
    description :: layout a -> String
    description      = forall a. Show a => a -> FilePath
show

instance LayoutClass Layout Window where
    runLayout :: Workspace FilePath (Layout Window) Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (Layout Window))
runLayout (Workspace FilePath
i (Layout l Window
l) Maybe (Stack Window)
ms) Rectangle
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a (l :: * -> *).
(LayoutClass l a, Read (l a)) =>
l a -> Layout a
Layout) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace FilePath (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
Workspace FilePath
i l Window
l Maybe (Stack Window)
ms) Rectangle
r
    doLayout :: Layout Window
-> Rectangle
-> Stack Window
-> X ([(Window, Rectangle)], Maybe (Layout Window))
doLayout (Layout l Window
l) Rectangle
r Stack Window
s  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a (l :: * -> *).
(LayoutClass l a, Read (l a)) =>
l a -> Layout a
Layout) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a
-> Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (layout a))
doLayout l Window
l Rectangle
r Stack Window
s
    emptyLayout :: Layout Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (Layout Window))
emptyLayout (Layout l Window
l) Rectangle
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a (l :: * -> *).
(LayoutClass l a, Read (l a)) =>
l a -> Layout a
Layout) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
emptyLayout l Window
l Rectangle
r
    handleMessage :: Layout Window -> SomeMessage -> X (Maybe (Layout Window))
handleMessage (Layout l Window
l) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a (l :: * -> *).
(LayoutClass l a, Read (l a)) =>
l a -> Layout a
Layout) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l Window
l
    description :: Layout Window -> FilePath
description (Layout l Window
l)   = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> FilePath
description l Window
l

instance Show (Layout a) where show :: Layout a -> FilePath
show (Layout l a
l) = forall a. Show a => a -> FilePath
show l a
l

-- | Based on ideas in /An Extensible Dynamically-Typed Hierarchy of
-- Exceptions/, Simon Marlow, 2006. Use extensible messages to the
-- 'handleMessage' handler.
--
-- User-extensible messages must be a member of this class.
--
class Typeable a => Message a

-- |
-- A wrapped value of some type in the 'Message' class.
--
data SomeMessage = forall a. Message a => SomeMessage a

-- |
-- And now, unwrap a given, unknown 'Message' type, performing a (dynamic)
-- type check on the result.
--
fromMessage :: Message m => SomeMessage -> Maybe m
fromMessage :: forall m. Message m => SomeMessage -> Maybe m
fromMessage (SomeMessage a
m) = forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
m

-- X Events are valid Messages.
instance Message Event

-- | 'LayoutMessages' are core messages that all layouts (especially stateful
-- layouts) should consider handling.
data LayoutMessages = Hide              -- ^ sent when a layout becomes non-visible
                    | ReleaseResources  -- ^ sent when xmonad is exiting or restarting
    deriving LayoutMessages -> LayoutMessages -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayoutMessages -> LayoutMessages -> Bool
$c/= :: LayoutMessages -> LayoutMessages -> Bool
== :: LayoutMessages -> LayoutMessages -> Bool
$c== :: LayoutMessages -> LayoutMessages -> Bool
Eq

instance Message LayoutMessages

-- ---------------------------------------------------------------------
-- Extensible state/config
--

-- | Every module must make the data it wants to store
-- an instance of this class.
--
-- Minimal complete definition: initialValue
class Typeable a => ExtensionClass a where
    {-# MINIMAL initialValue #-}
    -- | Defines an initial value for the state extension
    initialValue :: a
    -- | Specifies whether the state extension should be
    -- persistent. Setting this method to 'PersistentExtension'
    -- will make the stored data survive restarts, but
    -- requires a to be an instance of Read and Show.
    --
    -- It defaults to 'StateExtension', i.e. no persistence.
    extensionType :: a -> StateExtension
    extensionType = forall a. ExtensionClass a => a -> StateExtension
StateExtension

-- | Existential type to store a state extension.
data StateExtension =
    forall a. ExtensionClass a => StateExtension a
    -- ^ Non-persistent state extension
  | forall a. (Read a, Show a, ExtensionClass a) => PersistentExtension a
    -- ^ Persistent extension

-- | Existential type to store a config extension.
data ConfExtension = forall a. Typeable a => ConfExtension a

-- ---------------------------------------------------------------------
-- General utilities

-- | If-then-else lifted to a 'Monad'.
ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM :: forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
mb m a
t m a
f = m Bool
mb forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> if Bool
b then m a
t else m a
f

-- | Lift an 'IO' action into the 'X' monad
io :: MonadIO m => IO a -> m a
io :: forall (m :: * -> *) a. MonadIO m => IO a -> m a
io = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | Lift an 'IO' action into the 'X' monad.  If the action results in an 'IO'
-- exception, log the exception to stderr and continue normal execution.
catchIO :: MonadIO m => IO () -> m ()
catchIO :: forall (m :: * -> *). MonadIO m => IO () -> m ()
catchIO IO ()
f = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO ()
f forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(SomeException e
e) -> forall a. Show a => Handle -> a -> IO ()
hPrint Handle
stderr e
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
stderr)

-- | spawn. Launch an external application. Specifically, it double-forks and
-- runs the 'String' you pass as a command to \/bin\/sh.
--
-- Note this function assumes your locale uses utf8.
spawn :: MonadIO m => String -> m ()
spawn :: forall (m :: * -> *). MonadIO m => FilePath -> m ()
spawn FilePath
x = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => FilePath -> m ProcessID
spawnPID FilePath
x

-- | Like 'spawn', but returns the 'ProcessID' of the launched application
spawnPID :: MonadIO m => String -> m ProcessID
spawnPID :: forall (m :: * -> *). MonadIO m => FilePath -> m ProcessID
spawnPID FilePath
x = forall (m :: * -> *). MonadIO m => IO () -> m ProcessID
xfork forall a b. (a -> b) -> a -> b
$ forall a.
FilePath
-> Bool -> [FilePath] -> Maybe [(FilePath, FilePath)] -> IO a
executeFile FilePath
"/bin/sh" Bool
False [FilePath
"-c", FilePath
x] forall a. Maybe a
Nothing

-- | A replacement for 'forkProcess' which resets default signal handlers.
xfork :: MonadIO m => IO () -> m ProcessID
xfork :: forall (m :: * -> *). MonadIO m => IO () -> m ProcessID
xfork IO ()
x = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ProcessID
forkProcess forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. IO a -> IO b -> IO a
finally IO ()
nullStdin forall a b. (a -> b) -> a -> b
$ do
                forall (m :: * -> *). MonadIO m => m ()
uninstallSignalHandlers
                IO ProcessID
createSession
                IO ()
x
 where
    nullStdin :: IO ()
nullStdin = do
#if MIN_VERSION_unix(2,8,0)
        fd <- openFd "/dev/null" ReadOnly defaultFileFlags
#else
        Fd
fd <- FilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd
openFd FilePath
"/dev/null" OpenMode
ReadOnly forall a. Maybe a
Nothing OpenFileFlags
defaultFileFlags
#endif
        Fd -> Fd -> IO Fd
dupTo Fd
fd Fd
stdInput
        Fd -> IO ()
closeFd Fd
fd

-- | Use @xmessage@ to show information to the user.
xmessage :: MonadIO m => String -> m ()
xmessage :: forall (m :: * -> *). MonadIO m => FilePath -> m ()
xmessage FilePath
msg = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadIO m => IO () -> m ProcessID
xfork forall a b. (a -> b) -> a -> b
$ do
    FilePath
xmessageBin <- forall a. a -> Maybe a -> a
fromMaybe FilePath
"xmessage" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"XMONAD_XMESSAGE")
    forall a.
FilePath
-> Bool -> [FilePath] -> Maybe [(FilePath, FilePath)] -> IO a
executeFile FilePath
xmessageBin Bool
True
        [ FilePath
"-default", FilePath
"okay"
        , FilePath
"-xrm", FilePath
"*international:true"
        , FilePath
"-xrm", FilePath
"*fontSet:-*-fixed-medium-r-normal-*-18-*-*-*-*-*-*-*,-*-fixed-*-*-*-*-18-*-*-*-*-*-*-*,-*-*-*-*-*-*-18-*-*-*-*-*-*-*"
        , FilePath
msg
        ] forall a. Maybe a
Nothing

-- | This is basically a map function, running a function in the 'X' monad on
-- each workspace with the output of that function being the modified workspace.
runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X ()
runOnWorkspaces :: (Workspace FilePath (Layout Window) Window
 -> X (Workspace FilePath (Layout Window) Window))
-> X ()
runOnWorkspaces Workspace FilePath (Layout Window) Window
-> X (Workspace FilePath (Layout Window) Window)
job = do
    WindowSet
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
    [Workspace FilePath (Layout Window) Window]
h <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Workspace FilePath (Layout Window) Window
-> X (Workspace FilePath (Layout Window) Window)
job forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
hidden WindowSet
ws
    Screen FilePath (Layout Window) Window ScreenId ScreenDetail
c:[Screen FilePath (Layout Window) Window ScreenId ScreenDetail]
v <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Screen FilePath (Layout Window) Window ScreenId ScreenDetail
s -> (\Workspace FilePath (Layout Window) Window
w -> Screen FilePath (Layout Window) Window ScreenId ScreenDetail
s { workspace :: Workspace FilePath (Layout Window) Window
workspace = Workspace FilePath (Layout Window) Window
w}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Workspace FilePath (Layout Window) Window
-> X (Workspace FilePath (Layout Window) Window)
job (forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace Screen FilePath (Layout Window) Window ScreenId ScreenDetail
s))
             forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current WindowSet
ws forall a. a -> [a] -> [a]
: forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible WindowSet
ws
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XState
s -> XState
s { windowset :: WindowSet
windowset = WindowSet
ws { current :: Screen FilePath (Layout Window) Window ScreenId ScreenDetail
current = Screen FilePath (Layout Window) Window ScreenId ScreenDetail
c, visible :: [Screen FilePath (Layout Window) Window ScreenId ScreenDetail]
visible = [Screen FilePath (Layout Window) Window ScreenId ScreenDetail]
v, hidden :: [Workspace FilePath (Layout Window) Window]
hidden = [Workspace FilePath (Layout Window) Window]
h } }

-- | All the directories that xmonad will use.  They will be used for
-- the following purposes:
--
-- * @dataDir@: This directory is used by XMonad to store data files
-- such as the run-time state file.
--
-- * @cfgDir@: This directory is where user configuration files are
-- stored (e.g, the xmonad.hs file).  You may also create a @lib@
-- subdirectory in the configuration directory and the default recompile
-- command will add it to the GHC include path.
--
-- * @cacheDir@: This directory is used to store temporary files that
-- can easily be recreated such as the configuration binary and any
-- intermediate object files generated by GHC.
-- Also, the XPrompt history file goes here.
--
-- For how these directories are chosen, see 'getDirectories'.
--
data Directories' a = Directories
    { forall a. Directories' a -> a
dataDir  :: !a
    , forall a. Directories' a -> a
cfgDir   :: !a
    , forall a. Directories' a -> a
cacheDir :: !a
    }
    deriving (Int -> Directories' a -> ShowS
forall a. Show a => Int -> Directories' a -> ShowS
forall a. Show a => [Directories' a] -> ShowS
forall a. Show a => Directories' a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Directories' a] -> ShowS
$cshowList :: forall a. Show a => [Directories' a] -> ShowS
show :: Directories' a -> FilePath
$cshow :: forall a. Show a => Directories' a -> FilePath
showsPrec :: Int -> Directories' a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Directories' a -> ShowS
Show, forall a b. a -> Directories' b -> Directories' a
forall a b. (a -> b) -> Directories' a -> Directories' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Directories' b -> Directories' a
$c<$ :: forall a b. a -> Directories' b -> Directories' a
fmap :: forall a b. (a -> b) -> Directories' a -> Directories' b
$cfmap :: forall a b. (a -> b) -> Directories' a -> Directories' b
Functor, forall a. Eq a => a -> Directories' a -> Bool
forall a. Num a => Directories' a -> a
forall a. Ord a => Directories' a -> a
forall m. Monoid m => Directories' m -> m
forall a. Directories' a -> Bool
forall a. Directories' a -> Int
forall a. Directories' a -> [a]
forall a. (a -> a -> a) -> Directories' a -> a
forall m a. Monoid m => (a -> m) -> Directories' a -> m
forall b a. (b -> a -> b) -> b -> Directories' a -> b
forall a b. (a -> b -> b) -> b -> Directories' a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Directories' a -> a
$cproduct :: forall a. Num a => Directories' a -> a
sum :: forall a. Num a => Directories' a -> a
$csum :: forall a. Num a => Directories' a -> a
minimum :: forall a. Ord a => Directories' a -> a
$cminimum :: forall a. Ord a => Directories' a -> a
maximum :: forall a. Ord a => Directories' a -> a
$cmaximum :: forall a. Ord a => Directories' a -> a
elem :: forall a. Eq a => a -> Directories' a -> Bool
$celem :: forall a. Eq a => a -> Directories' a -> Bool
length :: forall a. Directories' a -> Int
$clength :: forall a. Directories' a -> Int
null :: forall a. Directories' a -> Bool
$cnull :: forall a. Directories' a -> Bool
toList :: forall a. Directories' a -> [a]
$ctoList :: forall a. Directories' a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Directories' a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Directories' a -> a
foldr1 :: forall a. (a -> a -> a) -> Directories' a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Directories' a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Directories' a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Directories' a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Directories' a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Directories' a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Directories' a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Directories' a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Directories' a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Directories' a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Directories' a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Directories' a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Directories' a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Directories' a -> m
fold :: forall m. Monoid m => Directories' m -> m
$cfold :: forall m. Monoid m => Directories' m -> m
Foldable, Functor Directories'
Foldable Directories'
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Directories' (m a) -> m (Directories' a)
forall (f :: * -> *) a.
Applicative f =>
Directories' (f a) -> f (Directories' a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Directories' a -> m (Directories' b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Directories' a -> f (Directories' b)
sequence :: forall (m :: * -> *) a.
Monad m =>
Directories' (m a) -> m (Directories' a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
Directories' (m a) -> m (Directories' a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Directories' a -> m (Directories' b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Directories' a -> m (Directories' b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Directories' (f a) -> f (Directories' a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Directories' (f a) -> f (Directories' a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Directories' a -> f (Directories' b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Directories' a -> f (Directories' b)
Traversable)

-- | Convenient type alias for the most common case in which one might
-- want to use the 'Directories' type.
type Directories = Directories' FilePath

-- | Build up the 'Dirs' that xmonad will use.  They are chosen as
-- follows:
--
-- 1. If all three of xmonad's environment variables (@XMONAD_DATA_DIR@,
--    @XMONAD_CONFIG_DIR@, and @XMONAD_CACHE_DIR@) are set, use them.
-- 2. If there is a build script called @build@ or configuration
--    @xmonad.hs@ in @~\/.xmonad@, set all three directories to
--    @~\/.xmonad@.
-- 3. Otherwise, use the @xmonad@ directory in @XDG_DATA_HOME@,
--    @XDG_CONFIG_HOME@, and @XDG_CACHE_HOME@ (or their respective
--    fallbacks).  These directories are created if necessary.
--
-- The xmonad configuration file (or the build script, if present) is
-- always assumed to be in @cfgDir@.
--
getDirectories :: IO Directories
getDirectories :: IO Directories
getDirectories = IO Directories
xmEnvDirs forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IO Directories
xmDirs forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IO Directories
xdgDirs
  where
    -- | Check for xmonad's environment variables first
    xmEnvDirs :: IO Directories
    xmEnvDirs :: IO Directories
xmEnvDirs = do
        let xmEnvs :: Directories
xmEnvs = Directories{ dataDir :: FilePath
dataDir  = FilePath
"XMONAD_DATA_DIR"
                                , cfgDir :: FilePath
cfgDir   = FilePath
"XMONAD_CONFIG_DIR"
                                , cacheDir :: FilePath
cacheDir = FilePath
"XMONAD_CACHE_DIR"
                                }
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. Alternative f => f a
empty forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO (Maybe FilePath)
getEnv Directories
xmEnvs

    -- | Check whether the config file or a build script is in the
    -- @~\/.xmonad@ directory
    xmDirs :: IO Directories
    xmDirs :: IO Directories
xmDirs = do
        FilePath
xmDir <- FilePath -> IO FilePath
getAppUserDataDirectory FilePath
"xmonad"
        Bool
conf  <- FilePath -> IO Bool
doesFileExist forall a b. (a -> b) -> a -> b
$ FilePath
xmDir FilePath -> ShowS
</> FilePath
"xmonad.hs"
        Bool
build <- FilePath -> IO Bool
doesFileExist forall a b. (a -> b) -> a -> b
$ FilePath
xmDir FilePath -> ShowS
</> FilePath
"build"

        -- Place *everything* in ~/.xmonad if yes
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool
conf Bool -> Bool -> Bool
|| Bool
build
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Directories{ dataDir :: FilePath
dataDir = FilePath
xmDir, cfgDir :: FilePath
cfgDir = FilePath
xmDir, cacheDir :: FilePath
cacheDir = FilePath
xmDir }

    -- | Use XDG directories as a fallback
    xdgDirs :: IO Directories
    xdgDirs :: IO Directories
xdgDirs =
        forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Directories{ dataDir :: XdgDirectory
dataDir = XdgDirectory
XdgData, cfgDir :: XdgDirectory
cfgDir = XdgDirectory
XdgConfig, cacheDir :: XdgDirectory
cacheDir = XdgDirectory
XdgCache }
            forall a b. (a -> b) -> a -> b
$ \XdgDirectory
dir -> do FilePath
d <- XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
dir FilePath
"xmonad"
                         FilePath
d forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
d

-- | Return the path to the xmonad configuration directory.
getXMonadDir :: X String
getXMonadDir :: X FilePath
getXMonadDir = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall a. Directories' a -> a
cfgDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> Directories
directories)
{-# DEPRECATED getXMonadDir "Use `asks (cfgDir . directories)' instead." #-}

-- | Return the path to the xmonad cache directory.
getXMonadCacheDir :: X String
getXMonadCacheDir :: X FilePath
getXMonadCacheDir = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall a. Directories' a -> a
cacheDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> Directories
directories)
{-# DEPRECATED getXMonadCacheDir "Use `asks (cacheDir . directories)' instead." #-}

-- | Return the path to the xmonad data directory.
getXMonadDataDir :: X String
getXMonadDataDir :: X FilePath
getXMonadDataDir = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall a. Directories' a -> a
dataDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> Directories
directories)
{-# DEPRECATED getXMonadDataDir "Use `asks (dataDir . directories)' instead." #-}

binFileName, buildDirName :: Directories -> FilePath
binFileName :: Directories -> FilePath
binFileName  Directories{ FilePath
cacheDir :: FilePath
cacheDir :: forall a. Directories' a -> a
cacheDir } = FilePath
cacheDir FilePath -> ShowS
</> FilePath
"xmonad-" forall a. Semigroup a => a -> a -> a
<> FilePath
arch forall a. Semigroup a => a -> a -> a
<> FilePath
"-" forall a. Semigroup a => a -> a -> a
<> FilePath
os
buildDirName :: Directories -> FilePath
buildDirName Directories{ FilePath
cacheDir :: FilePath
cacheDir :: forall a. Directories' a -> a
cacheDir } = FilePath
cacheDir FilePath -> ShowS
</> FilePath
"build-" forall a. Semigroup a => a -> a -> a
<> FilePath
arch forall a. Semigroup a => a -> a -> a
<> FilePath
"-" forall a. Semigroup a => a -> a -> a
<> FilePath
os

errFileName, stateFileName :: Directories -> FilePath
errFileName :: Directories -> FilePath
errFileName   Directories{ FilePath
dataDir :: FilePath
dataDir :: forall a. Directories' a -> a
dataDir } = FilePath
dataDir FilePath -> ShowS
</> FilePath
"xmonad.errors"
stateFileName :: Directories -> FilePath
stateFileName Directories{ FilePath
dataDir :: FilePath
dataDir :: forall a. Directories' a -> a
dataDir } = FilePath
dataDir FilePath -> ShowS
</> FilePath
"xmonad.state"

srcFileName, libFileName :: Directories -> FilePath
srcFileName :: Directories -> FilePath
srcFileName Directories{ FilePath
cfgDir :: FilePath
cfgDir :: forall a. Directories' a -> a
cfgDir } = FilePath
cfgDir FilePath -> ShowS
</> FilePath
"xmonad.hs"
libFileName :: Directories -> FilePath
libFileName Directories{ FilePath
cfgDir :: FilePath
cfgDir :: forall a. Directories' a -> a
cfgDir } = FilePath
cfgDir FilePath -> ShowS
</> FilePath
"lib"

buildScriptFileName, stackYamlFileName, nixFlakeFileName, nixDefaultFileName :: Directories -> FilePath
buildScriptFileName :: Directories -> FilePath
buildScriptFileName Directories{ FilePath
cfgDir :: FilePath
cfgDir :: forall a. Directories' a -> a
cfgDir } = FilePath
cfgDir FilePath -> ShowS
</> FilePath
"build"
stackYamlFileName :: Directories -> FilePath
stackYamlFileName   Directories{ FilePath
cfgDir :: FilePath
cfgDir :: forall a. Directories' a -> a
cfgDir } = FilePath
cfgDir FilePath -> ShowS
</> FilePath
"stack.yaml"
nixFlakeFileName :: Directories -> FilePath
nixFlakeFileName    Directories{ FilePath
cfgDir :: FilePath
cfgDir :: forall a. Directories' a -> a
cfgDir } = FilePath
cfgDir FilePath -> ShowS
</> FilePath
"flake.nix"
nixDefaultFileName :: Directories -> FilePath
nixDefaultFileName  Directories{ FilePath
cfgDir :: FilePath
cfgDir :: forall a. Directories' a -> a
cfgDir } = FilePath
cfgDir FilePath -> ShowS
</> FilePath
"default.nix"

-- | Compilation method for xmonad configuration.
data Compile
  = CompileGhc
  | CompileStackGhc FilePath
  | CompileNixFlake
  | CompileNixDefault
  | CompileScript FilePath
    deriving (Int -> Compile -> ShowS
[Compile] -> ShowS
Compile -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Compile] -> ShowS
$cshowList :: [Compile] -> ShowS
show :: Compile -> FilePath
$cshow :: Compile -> FilePath
showsPrec :: Int -> Compile -> ShowS
$cshowsPrec :: Int -> Compile -> ShowS
Show)

-- | Detect compilation method by looking for known file names in xmonad
-- configuration directory.
detectCompile :: Directories -> IO Compile
detectCompile :: Directories -> IO Compile
detectCompile Directories
dirs =
  IO Compile
tryScript forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IO Compile
tryStack forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IO Compile
tryNixFlake forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IO Compile
tryNixDefault forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IO Compile
useGhc
  where
    buildScript :: FilePath
buildScript = Directories -> FilePath
buildScriptFileName Directories
dirs
    stackYaml :: FilePath
stackYaml = Directories -> FilePath
stackYamlFileName Directories
dirs
    flakeNix :: FilePath
flakeNix = Directories -> FilePath
nixFlakeFileName Directories
dirs
    defaultNix :: FilePath
defaultNix = Directories -> FilePath
nixDefaultFileName Directories
dirs

    tryScript :: IO Compile
tryScript = do
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO Bool
doesFileExist FilePath
buildScript
        Bool
isExe <- FilePath -> IO Bool
isExecutable FilePath
buildScript
        if Bool
isExe
          then do
            forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace forall a b. (a -> b) -> a -> b
$ FilePath
"XMonad will use build script at " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
buildScript forall a. Semigroup a => a -> a -> a
<> FilePath
" to recompile."
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Compile
CompileScript FilePath
buildScript
          else do
            forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace forall a b. (a -> b) -> a -> b
$ FilePath
"XMonad will not use build script, because " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
buildScript forall a. Semigroup a => a -> a -> a
<> FilePath
" is not executable."
            forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace forall a b. (a -> b) -> a -> b
$ FilePath
"Suggested resolution to use it: chmod u+x " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
buildScript
            forall (f :: * -> *) a. Alternative f => f a
empty

    tryNixFlake :: IO Compile
tryNixFlake = do
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO Bool
doesFileExist FilePath
flakeNix
      FilePath
canonNixFlake <- FilePath -> IO FilePath
canonicalizePath FilePath
flakeNix
      forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace forall a b. (a -> b) -> a -> b
$ FilePath
"XMonad will use nix flake at " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
canonNixFlake forall a. Semigroup a => a -> a -> a
<> FilePath
" to recompile"
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Compile
CompileNixFlake

    tryNixDefault :: IO Compile
tryNixDefault = do
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO Bool
doesFileExist FilePath
defaultNix
      FilePath
canonNixDefault <- FilePath -> IO FilePath
canonicalizePath FilePath
defaultNix
      forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace forall a b. (a -> b) -> a -> b
$ FilePath
"XMonad will use nix file at " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
canonNixDefault forall a. Semigroup a => a -> a -> a
<> FilePath
" to recompile"
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Compile
CompileNixDefault

    tryStack :: IO Compile
tryStack = do
        forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO Bool
doesFileExist FilePath
stackYaml
        FilePath
canonStackYaml <- FilePath -> IO FilePath
canonicalizePath FilePath
stackYaml
        forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace forall a b. (a -> b) -> a -> b
$ FilePath
"XMonad will use stack ghc --stack-yaml " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
canonStackYaml forall a. Semigroup a => a -> a -> a
<> FilePath
" to recompile."
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Compile
CompileStackGhc FilePath
canonStackYaml

    useGhc :: IO Compile
useGhc = do
        forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace forall a b. (a -> b) -> a -> b
$ FilePath
"XMonad will use ghc to recompile, because none of "
                forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", "
                     [ forall a. Show a => a -> FilePath
show FilePath
buildScript
                     , forall a. Show a => a -> FilePath
show FilePath
stackYaml
                     , forall a. Show a => a -> FilePath
show FilePath
flakeNix
                     , forall a. Show a => a -> FilePath
show FilePath
defaultNix
                     ] forall a. Semigroup a => a -> a -> a
<> FilePath
" exist."
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Compile
CompileGhc

-- | Determine whether or not the file found at the provided filepath is executable.
isExecutable :: FilePath -> IO Bool
isExecutable :: FilePath -> IO Bool
isExecutable FilePath
f = forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (Permissions -> Bool
executable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Permissions
getPermissions FilePath
f) (\(SomeException e
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

-- | Should we recompile xmonad configuration? Is it newer than the compiled
-- binary?
shouldCompile :: Directories -> Compile -> IO Bool
shouldCompile :: Directories -> Compile -> IO Bool
shouldCompile Directories
dirs Compile
CompileGhc = do
    [Maybe UTCTime]
libTs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO (Maybe UTCTime)
getModTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter FilePath -> Bool
isSource forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
allFiles (Directories -> FilePath
libFileName Directories
dirs)
    Maybe UTCTime
srcT <- FilePath -> IO (Maybe UTCTime)
getModTime (Directories -> FilePath
srcFileName Directories
dirs)
    Maybe UTCTime
binT <- FilePath -> IO (Maybe UTCTime)
getModTime (Directories -> FilePath
binFileName Directories
dirs)
    if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe UTCTime
binT forall a. Ord a => a -> a -> Bool
<) (Maybe UTCTime
srcT forall a. a -> [a] -> [a]
: [Maybe UTCTime]
libTs)
        then Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace FilePath
"XMonad recompiling because some files have changed."
        else Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace FilePath
"XMonad skipping recompile because it is not forced (e.g. via --recompile), and neither xmonad.hs nor any *.hs / *.lhs / *.hsc files in lib/ have been changed."
  where
    isSource :: FilePath -> Bool
isSource = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [FilePath
".hs",FilePath
".lhs",FilePath
".hsc"] forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeExtension
    allFiles :: FilePath -> IO [FilePath]
allFiles FilePath
t = do
        let prep :: [FilePath] -> [FilePath]
prep = forall a b. (a -> b) -> [a] -> [b]
map (FilePath
tFilePath -> ShowS
</>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath
".",FilePath
".."])
        [FilePath]
cs <- [FilePath] -> [FilePath]
prep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (FilePath -> IO [FilePath]
getDirectoryContents FilePath
t) (\(SomeException e
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return [])
        [FilePath]
ds <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesDirectoryExist [FilePath]
cs
        forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([FilePath]
cs forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
ds)forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO [FilePath]
allFiles [FilePath]
ds
shouldCompile Directories
dirs CompileStackGhc{} = do
    Maybe UTCTime
stackYamlT <- FilePath -> IO (Maybe UTCTime)
getModTime (Directories -> FilePath
stackYamlFileName Directories
dirs)
    Maybe UTCTime
binT <- FilePath -> IO (Maybe UTCTime)
getModTime (Directories -> FilePath
binFileName Directories
dirs)
    if Maybe UTCTime
binT forall a. Ord a => a -> a -> Bool
< Maybe UTCTime
stackYamlT
        then Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace FilePath
"XMonad recompiling because some files have changed."
        else Directories -> Compile -> IO Bool
shouldCompile Directories
dirs Compile
CompileGhc
shouldCompile Directories
_dirs CompileNixFlake{} = Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace FilePath
"XMonad recompiling because flake recompilation is being used."
shouldCompile Directories
_dirs CompileNixDefault{} = Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace FilePath
"XMonad recompiling because nix recompilation is being used."
shouldCompile Directories
_dirs CompileScript{} =
    Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace FilePath
"XMonad recompiling because a custom build script is being used."

getModTime :: FilePath -> IO (Maybe UTCTime)
getModTime :: FilePath -> IO (Maybe UTCTime)
getModTime FilePath
f = forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO UTCTime
getModificationTime FilePath
f) (\(SomeException e
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)

-- | Compile the configuration.
compile :: Directories -> Compile -> IO ExitCode
compile :: Directories -> Compile -> IO ExitCode
compile Directories
dirs Compile
method =
    forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ forall (m :: * -> *). MonadIO m => m ()
uninstallSignalHandlers forall (m :: * -> *). MonadIO m => m ()
installSignalHandlers forall a b. (a -> b) -> a -> b
$
        forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile (Directories -> FilePath
errFileName Directories
dirs) IOMode
WriteMode forall a b. (a -> b) -> a -> b
$ \Handle
err -> do
            let run :: FilePath -> [FilePath] -> IO ExitCode
run = FilePath -> Handle -> FilePath -> [FilePath] -> IO ExitCode
runProc (forall a. Directories' a -> a
cfgDir Directories
dirs) Handle
err
            case Compile
method of
                Compile
CompileGhc -> do
                    FilePath
ghc <- forall a. a -> Maybe a -> a
fromMaybe FilePath
"ghc" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"XMONAD_GHC"
                    FilePath -> [FilePath] -> IO ExitCode
run FilePath
ghc [FilePath]
ghcArgs
                CompileStackGhc FilePath
stackYaml ->
                    FilePath -> [FilePath] -> IO ExitCode
run FilePath
"stack" [FilePath
"build", FilePath
"--silent", FilePath
"--stack-yaml", FilePath
stackYaml] forall {m :: * -> *}.
Monad m =>
m ExitCode -> m ExitCode -> m ExitCode
.&&.
                    FilePath -> [FilePath] -> IO ExitCode
run FilePath
"stack" (FilePath
"ghc" forall a. a -> [a] -> [a]
: FilePath
"--stack-yaml" forall a. a -> [a] -> [a]
: FilePath
stackYaml forall a. a -> [a] -> [a]
: FilePath
"--" forall a. a -> [a] -> [a]
: [FilePath]
ghcArgs)
                Compile
CompileNixFlake ->
                    FilePath -> [FilePath] -> IO ExitCode
run FilePath
"nix" [FilePath
"build"] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExitCode -> IO ExitCode
andCopyFromResultDir
                Compile
CompileNixDefault ->
                    FilePath -> [FilePath] -> IO ExitCode
run FilePath
"nix-build" [] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExitCode -> IO ExitCode
andCopyFromResultDir
                CompileScript FilePath
script ->
                    FilePath -> [FilePath] -> IO ExitCode
run FilePath
script [Directories -> FilePath
binFileName Directories
dirs]
  where
    ghcArgs :: [FilePath]
ghcArgs = [ FilePath
"--make"
              , FilePath
"xmonad.hs"
              , FilePath
"-i" -- only look in @lib@
              , FilePath
"-ilib"
              , FilePath
"-fforce-recomp"
              , FilePath
"-main-is", FilePath
"main"
              , FilePath
"-v0"
              , FilePath
"-outputdir", Directories -> FilePath
buildDirName Directories
dirs
              , FilePath
"-o", Directories -> FilePath
binFileName Directories
dirs
              ]
    andCopyFromResultDir :: ExitCode -> IO ExitCode
andCopyFromResultDir ExitCode
exitCode = do
      if ExitCode
exitCode forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess then IO ExitCode
copyFromResultDir else forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
exitCode
    findM :: (a -> m Bool) -> t a -> m (Maybe a)
findM a -> m Bool
p = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x -> forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (a -> m Bool
p a
x) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
x)) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)
    catchAny :: IO a -> (SomeException -> IO a) -> IO a
    catchAny :: forall a. IO a -> (SomeException -> IO a) -> IO a
catchAny = forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
    copyFromResultDir :: IO ExitCode
copyFromResultDir = do
      let binaryDirectory :: FilePath
binaryDirectory = forall a. Directories' a -> a
cfgDir Directories
dirs FilePath -> ShowS
</> FilePath
"result" FilePath -> ShowS
</> FilePath
"bin"
      [FilePath]
binFiles <- forall a b. (a -> b) -> [a] -> [b]
map (FilePath
binaryDirectory FilePath -> ShowS
</>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IO a -> (SomeException -> IO a) -> IO a
catchAny (FilePath -> IO [FilePath]
listDirectory FilePath
binaryDirectory) (\SomeException
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [])
      Maybe FilePath
mfilepath <- forall {t :: * -> *} {m :: * -> *} {a}.
(Foldable t, Monad m) =>
(a -> m Bool) -> t a -> m (Maybe a)
findM FilePath -> IO Bool
isExecutable [FilePath]
binFiles
      case Maybe FilePath
mfilepath of
        Just FilePath
filepath -> FilePath -> FilePath -> IO ()
copyFile FilePath
filepath (Directories -> FilePath
binFileName Directories
dirs) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess
        Maybe FilePath
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1

    -- waitForProcess =<< System.Process.runProcess, but without closing the err handle
    runProc :: FilePath -> Handle -> FilePath -> [FilePath] -> IO ExitCode
runProc FilePath
cwd Handle
err FilePath
exe [FilePath]
args = do
        Handle -> FilePath -> IO ()
hPutStrLn Handle
err forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords forall a b. (a -> b) -> a -> b
$ FilePath
"$" forall a. a -> [a] -> [a]
: FilePath
exe forall a. a -> [a] -> [a]
: [FilePath]
args
        Handle -> IO ()
hFlush Handle
err
        (Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
h) <- FilePath
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ FilePath
"runProc" (FilePath -> [FilePath] -> CreateProcess
proc FilePath
exe [FilePath]
args){ cwd :: Maybe FilePath
cwd = forall a. a -> Maybe a
Just FilePath
cwd, std_err :: StdStream
std_err = Handle -> StdStream
UseHandle Handle
err }
        ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
h

    m ExitCode
cmd1 .&&. :: m ExitCode -> m ExitCode -> m ExitCode
.&&. m ExitCode
cmd2 = m ExitCode
cmd1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        ExitCode
ExitSuccess -> m ExitCode
cmd2
        ExitCode
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ExitCode
e

-- | Check GHC output for deprecation warnings and notify the user if there
-- were any. Report success otherwise.
checkCompileWarnings :: Directories -> IO ()
checkCompileWarnings :: Directories -> IO ()
checkCompileWarnings Directories
dirs = do
    FilePath
ghcErr <- FilePath -> IO FilePath
readFile (Directories -> FilePath
errFileName Directories
dirs)
    if FilePath
"-Wdeprecations" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` FilePath
ghcErr
      then do
        let msg :: FilePath
msg = [FilePath] -> FilePath
unlines forall a b. (a -> b) -> a -> b
$
                [FilePath
"Deprecations detected while compiling xmonad config: " forall a. Semigroup a => a -> a -> a
<> Directories -> FilePath
srcFileName Directories
dirs]
                forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath]
lines FilePath
ghcErr
                forall a. [a] -> [a] -> [a]
++ [FilePath
"",FilePath
"Please correct them or silence using {-# OPTIONS_GHC -Wno-deprecations #-}."]
        forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace FilePath
msg
        forall (m :: * -> *). MonadIO m => FilePath -> m ()
xmessage FilePath
msg
      else
        forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace FilePath
"XMonad recompilation process exited with success!"

-- | Notify the user that compilation failed and what was wrong.
compileFailed :: Directories -> ExitCode -> IO ()
compileFailed :: Directories -> ExitCode -> IO ()
compileFailed Directories
dirs ExitCode
status = do
    FilePath
ghcErr <- FilePath -> IO FilePath
readFile (Directories -> FilePath
errFileName Directories
dirs)
    let msg :: FilePath
msg = [FilePath] -> FilePath
unlines forall a b. (a -> b) -> a -> b
$
            [FilePath
"Errors detected while compiling xmonad config: " forall a. Semigroup a => a -> a -> a
<> Directories -> FilePath
srcFileName Directories
dirs]
            forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath]
lines (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
ghcErr then forall a. Show a => a -> FilePath
show ExitCode
status else FilePath
ghcErr)
            forall a. [a] -> [a] -> [a]
++ [FilePath
"",FilePath
"Please check the file for errors."]
    -- nb, the ordering of printing, then forking, is crucial due to
    -- lazy evaluation
    forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace FilePath
msg
    forall (m :: * -> *). MonadIO m => FilePath -> m ()
xmessage FilePath
msg

-- | Recompile the xmonad configuration file when any of the following apply:
--
--  * force is 'True'
--
--  * the xmonad executable does not exist
--
--  * the xmonad executable is older than @xmonad.hs@ or any file in
--    the @lib@ directory (under the configuration directory)
--
--  * custom @build@ script is being used
--
-- The -i flag is used to restrict recompilation to the xmonad.hs file only,
-- and any files in the aforementioned @lib@ directory.
--
-- Compilation errors (if any) are logged to the @xmonad.errors@ file
-- in the xmonad data directory.  If GHC indicates failure with a
-- non-zero exit code, an xmessage displaying that file is spawned.
--
-- 'False' is returned if there are compilation errors.
--
recompile :: MonadIO m => Directories -> Bool -> m Bool
recompile :: forall (m :: * -> *). MonadIO m => Directories -> Bool -> m Bool
recompile Directories
dirs Bool
force = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
    Compile
method <- Directories -> IO Compile
detectCompile Directories
dirs
    Bool
willCompile <- if Bool
force
        then Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace FilePath
"XMonad recompiling (forced)."
        else Directories -> Compile -> IO Bool
shouldCompile Directories
dirs Compile
method
    if Bool
willCompile
      then do
        ExitCode
status <- Directories -> Compile -> IO ExitCode
compile Directories
dirs Compile
method
        if ExitCode
status forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
            then Directories -> IO ()
checkCompileWarnings Directories
dirs
            else Directories -> ExitCode -> IO ()
compileFailed Directories
dirs ExitCode
status
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ExitCode
status forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
      else
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

-- | Conditionally run an action, using a @Maybe a@ to decide.
whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust :: forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
mg a -> m ()
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) a -> m ()
f Maybe a
mg

-- | Conditionally run an action, using a 'X' event to decide
whenX :: X Bool -> X () -> X ()
whenX :: X Bool -> X () -> X ()
whenX X Bool
a X ()
f = X Bool
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b X ()
f

-- | A 'trace' for the 'X' monad. Logs a string to stderr. The result may
-- be found in your .xsession-errors file
trace :: MonadIO m => String -> m ()
trace :: forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr

-- | Ignore SIGPIPE to avoid termination when a pipe is full, and SIGCHLD to
-- avoid zombie processes, and clean up any extant zombie processes.
installSignalHandlers :: MonadIO m => m ()
installSignalHandlers :: forall (m :: * -> *). MonadIO m => m ()
installSignalHandlers = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
    Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
openEndedPipe Handler
Ignore forall a. Maybe a
Nothing
    Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
sigCHLD Handler
Ignore forall a. Maybe a
Nothing
    (forall e a. Exception e => IO a -> IO (Either e a)
try :: IO a -> IO (Either SomeException a))
      forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a
fix forall a b. (a -> b) -> a -> b
$ \IO ()
more -> do
        Maybe (ProcessID, ProcessStatus)
x <- Bool -> Bool -> IO (Maybe (ProcessID, ProcessStatus))
getAnyProcessStatus Bool
False Bool
False
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe (ProcessID, ProcessStatus)
x) IO ()
more
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

uninstallSignalHandlers :: MonadIO m => m ()
uninstallSignalHandlers :: forall (m :: * -> *). MonadIO m => m ()
uninstallSignalHandlers = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
    Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
openEndedPipe Handler
Default forall a. Maybe a
Nothing
    Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
sigCHLD Handler
Default forall a. Maybe a
Nothing
    forall (m :: * -> *) a. Monad m => a -> m a
return ()