summaryrefslogtreecommitdiffstats
path: root/XMonad/Core.hs
diff options
context:
space:
mode:
Diffstat (limited to 'XMonad/Core.hs')
-rw-r--r--XMonad/Core.hs574
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 ()