Rename XMonad to MetaTile

1 files changed, 0 insertions, 574 deletions

diff --git a/XMonad/Core.hs b/XMonad/Core.hs
deleted file mode 100644
index 18ca213..0000000
--- a/XMonad/Core.hs
+++ /dev/null
@@ -1,574 +0,0 @@
-{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving, PatternGuards,
-             MultiParamTypeClasses, TypeSynonymInstances, CPP, DeriveDataTypeable #-}
-
------------------------------------------------------------------------------
--- |
--- 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, BorderWidth(..), WindowState(..),
-    ScreenId(..), ScreenDetail(..), XState(..),
-    XConf(..), XConfig(..), LayoutClass(..),
-    Layout(..), readsLayout, Typeable, Message,
-    SomeMessage(..), fromMessage, LayoutMessages(..),
-    StateExtension(..), ExtensionClass(..),
-    runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers,
-    withDisplay, withWindowSet, isRoot, runOnWorkspaces, getWindowState, getsWindowState, setWindowState, modifyWindowState,
-    getAtom, spawn, spawnPID, xfork, getXMonadDir, recompile, trace, whenJust, whenX,
-    atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, ManageHook, Query(..), runQuery
-  ) where
-
-import XMonad.StackSet hiding (modify)
-
-import Prelude hiding ( catch )
-import Codec.Binary.UTF8.String (encodeString)
-import Control.Exception.Extensible (catch, fromException, try, bracket, throw, finally, SomeException(..))
-import Control.Applicative
-import Control.Arrow ((&&&))
-import Control.Monad.State
-import Control.Monad.Reader
-import Data.Default
-import Data.Function (on)
-import System.FilePath
-import System.IO
-import System.Info
-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 hiding (Screen)
-import Graphics.X11.Xlib.Extras (Event, none)
-import Data.Typeable
-import Data.List ((\\))
-import Data.Maybe (isJust,fromMaybe)
-import Data.Monoid
-
-import qualified Data.Map as M
-
-
-data BorderWidth = BorderWidth
-    { bwTop    :: !Dimension
-    , bwRight  :: !Dimension
-    , bwBottom :: !Dimension
-    , bwLeft   :: !Dimension
-    } deriving Show
-
-data WindowState = WindowState
-    { wsMapped       :: !Bool
-    , wsWaitingUnmap :: !Int         -- ^ the number of expected UnmapEvents
-    , wsFrame        :: !Window
-    , wsBorderWidth  :: !BorderWidth
-    } deriving Show
-
-instance Eq WindowState where
-  (==) = (==) `on` (wsMapped &&& wsWaitingUnmap &&& wsFrame)
-
-
--- | XState, the (mutable) window manager state.
-data XState = XState
-    { windowset        :: !WindowSet                     -- ^ workspace list
-    , windowState      :: !(M.Map Window WindowState)    -- ^ the extended window state
-    , dragging         :: !(Maybe (Position -> Position -> X (), X ()))
-    , numberlockMask   :: !KeyMask                       -- ^ The numlock modifier
-    , extensibleState  :: !(M.Map String (Either String StateExtension))
-    -- ^ stores custom state information.
-    --
-    -- The module "XMonad.Utils.ExtensibleState" in xmonad-contrib
-    -- provides additional information and a simple interface for using this.
-    }
-
--- | XConf, the (read-only) window manager configuration.
-data XConf = XConf
-    { display       :: Display        -- ^ the X11 display
-    , config        :: !(XConfig Layout)       -- ^ initial user configuration
-    , theRoot       :: !Window        -- ^ the root window
-    , normalBorder  :: !Pixel         -- ^ border color of unfocused windows
-    , focusedBorder :: !Pixel         -- ^ border color of the focused window
-    , keyActions    :: !(M.Map (KeyMask, KeySym) (X ()))
-                                      -- ^ a mapping of key presses to actions
-    , buttonActions :: !(M.Map (KeyMask, Button) (Window -> X ()))
-                                      -- ^ a mapping of button presses to actions
-    , mouseFocused :: !Bool           -- ^ was refocus caused by mouse action?
-    , mousePosition :: !(Maybe (Position, Position))
-                                      -- ^ position of the mouse according to
-                                      -- the event currently being processed
-    , currentEvent :: !(Maybe Event)
-                                      -- ^ event currently being processed
-    }
-
--- todo, better name
-data XConfig l = XConfig
-    { normalBorderColor  :: !String              -- ^ Non focused windows border color. Default: \"#dddddd\"
-    , focusedBorderColor :: !String              -- ^ Focused windows border color. Default: \"#ff0000\"
-    , defaultBorderWidth :: !BorderWidth
-    , terminal           :: !String              -- ^ The preferred terminal application. Default: \"xterm\"
-    , layoutHook         :: !(l Window)          -- ^ The available layouts
-    , manageHook         :: !ManageHook          -- ^ The action to run when a new window is opened
-    , 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.
-    , workspaces         :: ![String]            -- ^ The list of workspaces' names
-    , modMask            :: !KeyMask             -- ^ the mod modifier
-    , keys               :: !(XConfig Layout -> M.Map (ButtonMask,KeySym) (X ()))
-                                                 -- ^ The key binding: a map from key presses and actions
-    , mouseBindings      :: !(XConfig Layout -> M.Map (ButtonMask, Button) (Window -> X ()))
-                                                 -- ^ The mouse bindings
-    , logHook            :: !(X ())              -- ^ The action to perform when the windows set is changed
-    , startupHook        :: !(X ())              -- ^ The action to perform on startup
-    , focusFollowsMouse  :: !Bool                -- ^ Whether window entry events can change focus
-    , clickJustFocuses   :: !Bool                -- ^ False to make a click which changes focus to be additionally passed to the window
-    , clientMask         :: !EventMask           -- ^ The client events that xmonad is interested in
-    , frameMask          :: !EventMask           -- ^ The frame events that xmonad is interested in
-    , rootMask           :: !EventMask           -- ^ The root events that xmonad is interested in
-    }
-
-
-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 (Eq,Ord,Show,Read,Enum,Num,Integral,Real)
-
--- | The 'Rectangle' with screen dimensions
-data ScreenDetail   = SD { screenRect :: !Rectangle } deriving (Eq,Show, 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 (Functor, Monad, MonadIO, MonadState XState, MonadReader XConf, Typeable)
-
-instance Applicative X where
-  pure = return
-  (<*>) = ap
-
-instance (Monoid a) => Monoid (X a) where
-    mempty  = return mempty
-    mappend = liftM2 mappend
-
-instance Default a => Default (X a) where
-    def = return def
-
-type ManageHook = Query (Endo WindowSet)
-newtype Query a = Query (ReaderT Window X a)
-    deriving (Functor, Monad, MonadReader Window, MonadIO)
-
-runQuery :: Query a -> Window -> X a
-runQuery (Query m) w = runReaderT m w
-
-instance Monoid a => Monoid (Query a) where
-    mempty  = return mempty
-    mappend = liftM2 mappend
-
-instance Default a => Default (Query a) where
-    def = return 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 c st (X a) = runStateT (runReaderT a c) 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 job errcase = do
-    st <- get
-    c <- ask
-    (a, s') <- io $ runX c st job `catch` \e -> case fromException e of
-                        Just x -> throw e `const` (x `asTypeOf` ExitSuccess)
-                        _ -> do hPrint stderr e; runX c st errcase
-    put s'
-    return 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 a = catchX (Just `liftM` a) (return 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 defValue a = fromMaybe defValue `liftM` userCode a
-
--- ---------------------------------------------------------------------
--- Convenient wrappers to state
-
--- | Run a monad action with the current display settings
-withDisplay :: (Display -> X a) -> X a
-withDisplay   f = asks display >>= f
-
--- | Run a monadic action with the current stack set
-withWindowSet :: (WindowSet -> X a) -> X a
-withWindowSet f = gets windowset >>= f
-
--- | True if the given window is the root window
-isRoot :: Window -> X Bool
-isRoot w = (w==) <$> asks theRoot
-
--- | Wrapper for the common case of atom internment
-getAtom :: String -> X Atom
-getAtom str = withDisplay $ \dpy -> io $ internAtom dpy str False
-
-emptyWindowState :: X WindowState
-emptyWindowState = asks (defaultBorderWidth . config) >>= return . WindowState False 0 none
-
-getWindowState :: Window -> X WindowState
-getWindowState w = do
-  ws <- gets $ (M.lookup w) . windowState
-  case ws of
-    Just s  -> return s
-    Nothing -> emptyWindowState
-
-getsWindowState :: (WindowState -> a) -> Window -> X a
-getsWindowState f w = f <$> getWindowState w
-
-setWindowState :: Window -> WindowState -> X ()
-setWindowState w ws = do
-  emptyState <- emptyWindowState
-  let  f | ws == emptyState = M.delete w
-         | otherwise        = M.insert w ws
-  modify $ \s -> s { windowState = f (windowState s) }
-
-modifyWindowState :: (WindowState -> WindowState) -> Window -> X ()
-modifyWindowState f w = getWindowState w >>= return . f >>= setWindowState w
-
--- | Common non-predefined atoms
-atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_STATE, atom_WM_TAKE_FOCUS :: X Atom
-atom_WM_PROTOCOLS       = getAtom "WM_PROTOCOLS"
-atom_WM_DELETE_WINDOW   = getAtom "WM_DELETE_WINDOW"
-atom_WM_STATE           = getAtom "WM_STATE"
-atom_WM_TAKE_FOCUS      = getAtom "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 (Layout l) s = [(Layout (asTypeOf x l), rs) | (x, rs) <- reads s]
-
--- | Every layout must be an instance of 'LayoutClass', which defines
--- the basic layout operations along with a sensible default for each.
---
--- Minimal complete definition:
---
--- * 'runLayout' || (('doLayout' || 'pureLayout') && 'emptyLayout'), and
---
--- * 'handleMessage' || 'pureMessage'
---
--- You should also strongly consider implementing 'description',
--- although it is not required.
---
--- 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) => 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 _ l ms) r = maybe (emptyLayout l r) (doLayout l r) 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 l r s   = return (pureLayout l r s, 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 _ r s = [(focus s, r)]
-
-    -- | 'emptyLayout' is called when there are no windows.
-    emptyLayout :: layout a -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
-    emptyLayout _ _ = return ([], 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 l  = return . pureMessage 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 _ _  = 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      = show
-
-instance LayoutClass Layout Window where
-    runLayout (Workspace i (Layout l) ms) r = fmap (fmap Layout) `fmap` runLayout (Workspace i l ms) r
-    doLayout (Layout l) r s  = fmap (fmap Layout) `fmap` doLayout l r s
-    emptyLayout (Layout l) r = fmap (fmap Layout) `fmap` emptyLayout l r
-    handleMessage (Layout l) = fmap (fmap Layout) . handleMessage l
-    description (Layout l)   = description l
-
-instance Show (Layout a) where show (Layout l) = show 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 (SomeMessage m) = cast 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 (Typeable, Eq)
-
-instance Message LayoutMessages
-
--- ---------------------------------------------------------------------
--- Extensible state
---
-
--- | 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
-    -- | 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 = 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
-
--- ---------------------------------------------------------------------
--- | General utilities
---
--- Lift an 'IO' action into the 'X' monad
-io :: MonadIO m => IO a -> m a
-io = 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 f = io (f `catch` \(SomeException e) -> hPrint stderr e >> hFlush 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 x = spawnPID x >> return ()
-
--- | Like 'spawn', but returns the 'ProcessID' of the launched application
-spawnPID :: MonadIO m => String -> m ProcessID
-spawnPID x = xfork $ executeFile "/bin/sh" False ["-c", encodeString x] Nothing
-
--- | A replacement for 'forkProcess' which resets default signal handlers.
-xfork :: MonadIO m => IO () -> m ProcessID
-xfork x = io . forkProcess . finally nullStdin $ do
-                uninstallSignalHandlers
-                createSession
-                x
- where
-    nullStdin = do
-        fd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
-        dupTo fd stdInput
-        closeFd fd
-
--- | 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 job = do
-    ws <- gets windowset
-    c:v <- mapM runOnScreen $ current ws : visible ws
-    modify $ \s -> s { windowset = ws { current = c, visible = v } }
-  where
-    runOnScreen scr@Screen { screenWorkspace = w, screenHidden = ws } = do
-      w':ws' <- mapM job (w:ws)
-      return scr { screenWorkspace = w', screenHidden = ws' }
-
--- | Return the path to @~\/.xmonad@.
-getXMonadDir :: MonadIO m => m String
-getXMonadDir = io $ getAppUserDataDirectory "xmonad"
-
--- | 'recompile force', recompile @~\/.xmonad\/xmonad.hs@ 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
---        ~\/.xmonad\/lib
---
--- The -i flag is used to restrict recompilation to the xmonad.hs file only,
--- and any files in the ~\/.xmonad\/lib directory.
---
--- Compilation errors (if any) are logged to ~\/.xmonad\/xmonad.errors.  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 => Bool -> m Bool
-recompile force = io $ do
-    dir <- getXMonadDir
-    let binn = "xmonad-"++arch++"-"++os
-        bin  = dir </> binn
-        base = dir </> "xmonad"
-        err  = base ++ ".errors"
-        src  = base ++ ".hs"
-        lib  = dir </> "lib"
-    libTs <- mapM getModTime . Prelude.filter isSource =<< allFiles lib
-    srcT <- getModTime src
-    binT <- getModTime bin
-    if force || any (binT <) (srcT : libTs)
-      then do
-        -- temporarily disable SIGCHLD ignoring:
-        uninstallSignalHandlers
-        status <- bracket (openFile err WriteMode) hClose $ \h ->
-            waitForProcess =<< runProcess "ghc" ["--make", "xmonad.hs", "-i", "-ilib", "-fforce-recomp", "-main-is", "main", "-v0", "-o",binn] (Just dir)
-                                    Nothing Nothing Nothing (Just h)
-
-        -- re-enable SIGCHLD:
-        installSignalHandlers
-
-        -- now, if it fails, run xmessage to let the user know:
-        when (status /= ExitSuccess) $ do
-            ghcErr <- readFile err
-            let msg = unlines $
-                    ["Error detected while loading xmonad configuration file: " ++ src]
-                    ++ lines (if null ghcErr then show status else ghcErr)
-                    ++ ["","Please check the file for errors."]
-            -- nb, the ordering of printing, then forking, is crucial due to
-            -- lazy evaluation
-            hPutStrLn stderr msg
-            forkProcess $ executeFile "xmessage" True ["-default", "okay", msg] Nothing
-            return ()
-        return (status == ExitSuccess)
-      else return True
- where getModTime f = catch (Just <$> getModificationTime f) (\(SomeException _) -> return Nothing)
-       isSource = flip elem [".hs",".lhs",".hsc"] . takeExtension
-       allFiles t = do
-            let prep = map (t</>) . Prelude.filter (`notElem` [".",".."])
-            cs <- prep <$> catch (getDirectoryContents t) (\(SomeException _) -> return [])
-            ds <- filterM doesDirectoryExist cs
-            concat . ((cs \\ ds):) <$> mapM allFiles ds
-
--- | Conditionally run an action, using a @Maybe a@ to decide.
-whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
-whenJust mg f = maybe (return ()) f mg
-
--- | Conditionally run an action, using a 'X' event to decide
-whenX :: X Bool -> X () -> X ()
-whenX a f = a >>= \b -> when b 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 = io . hPutStrLn 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 = io $ do
-    installHandler openEndedPipe Ignore Nothing
-    installHandler sigCHLD Ignore Nothing
-    (try :: IO a -> IO (Either SomeException a))
-      $ fix $ \more -> do
-        x <- getAnyProcessStatus False False
-        when (isJust x) more
-    return ()
-
-uninstallSignalHandlers :: MonadIO m => m ()
-uninstallSignalHandlers = io $ do
-    installHandler openEndedPipe Default Nothing
-    installHandler sigCHLD Default Nothing
-    return ()