{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving,
MultiParamTypeClasses, TypeSynonymInstances, DeriveDataTypeable #-}
module XMonad.Core (
X, WindowSet, WindowSpace, WorkspaceId,
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,
getAtom, spawn, spawnPID, xfork, recompile, trace, whenJust, whenX,
getXMonadDir, getXMonadCacheDir, getXMonadDataDir, stateFileName,
atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, withWindowAttributes,
ManageHook, Query(..), runQuery
) where
import XMonad.StackSet hiding (modify)
import Prelude
import Control.Exception.Extensible (fromException, try, bracket, throw, finally, SomeException(..))
import qualified Control.Exception.Extensible as E
import Control.Applicative(Applicative, pure, (<$>), (<*>))
import Control.Monad.Fail
import Control.Monad.State
import Control.Monad.Reader
import Data.Semigroup
import Data.Default
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.List ((\\))
import Data.Maybe (isJust,fromMaybe)
import Data.Monoid hiding ((<>))
import System.Environment (lookupEnv)
import qualified Data.Map as M
import qualified Data.Set as S
data XState = XState
{ XState -> WindowSet
windowset :: !WindowSet
, XState -> Set Window
mapped :: !(S.Set Window)
, XState -> Map Window Int
waitingUnmap :: !(M.Map Window Int)
, XState -> Maybe (Position -> Position -> X (), X ())
dragging :: !(Maybe (Position -> Position -> X (), X ()))
, XState -> KeyMask
numberlockMask :: !KeyMask
, XState -> Map String (Either String StateExtension)
extensibleState :: !(M.Map String (Either String StateExtension))
}
data XConf = XConf
{ XConf -> Display
display :: Display
, XConf -> XConfig Layout
config :: !(XConfig Layout)
, XConf -> Window
theRoot :: !Window
, XConf -> Window
normalBorder :: !Pixel
, XConf -> Window
focusedBorder :: !Pixel
, XConf -> Map (KeyMask, Window) (X ())
keyActions :: !(M.Map (KeyMask, KeySym) (X ()))
, XConf -> Map (KeyMask, Window) (Window -> X ())
buttonActions :: !(M.Map (KeyMask, Button) (Window -> X ()))
, XConf -> Bool
mouseFocused :: !Bool
, XConf -> Maybe (Position, Position)
mousePosition :: !(Maybe (Position, Position))
, XConf -> Maybe Event
currentEvent :: !(Maybe Event)
}
data XConfig l = XConfig
{ XConfig l -> String
normalBorderColor :: !String
, XConfig l -> String
focusedBorderColor :: !String
, XConfig l -> String
terminal :: !String
, XConfig l -> l Window
layoutHook :: !(l Window)
, XConfig l -> ManageHook
manageHook :: !ManageHook
, XConfig l -> Event -> X All
handleEventHook :: !(Event -> X All)
, XConfig l -> [String]
workspaces :: ![String]
, XConfig l -> KeyMask
modMask :: !KeyMask
, XConfig l -> XConfig Layout -> Map (KeyMask, Window) (X ())
keys :: !(XConfig Layout -> M.Map (ButtonMask,KeySym) (X ()))
, XConfig l
-> XConfig Layout -> Map (KeyMask, Window) (Window -> X ())
mouseBindings :: !(XConfig Layout -> M.Map (ButtonMask, Button) (Window -> X ()))
, XConfig l -> Window
borderWidth :: !Dimension
, XConfig l -> X ()
logHook :: !(X ())
, XConfig l -> X ()
startupHook :: !(X ())
, XConfig l -> Bool
focusFollowsMouse :: !Bool
, XConfig l -> Bool
clickJustFocuses :: !Bool
, XConfig l -> Window
clientMask :: !EventMask
, XConfig l -> Window
rootMask :: !EventMask
, XConfig l -> [String] -> XConfig Layout -> IO (XConfig Layout)
handleExtraArgs :: !([String] -> XConfig Layout -> IO (XConfig Layout))
}
type WindowSet = StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
type WindowSpace = Workspace WorkspaceId (Layout Window) Window
type WorkspaceId = String
newtype ScreenId = S Int deriving (ScreenId -> ScreenId -> Bool
(ScreenId -> ScreenId -> Bool)
-> (ScreenId -> ScreenId -> Bool) -> Eq ScreenId
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
Eq ScreenId =>
(ScreenId -> ScreenId -> Ordering)
-> (ScreenId -> ScreenId -> Bool)
-> (ScreenId -> ScreenId -> Bool)
-> (ScreenId -> ScreenId -> Bool)
-> (ScreenId -> ScreenId -> Bool)
-> (ScreenId -> ScreenId -> ScreenId)
-> (ScreenId -> ScreenId -> ScreenId)
-> Ord 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
$cp1Ord :: Eq ScreenId
Ord,Int -> ScreenId -> ShowS
[ScreenId] -> ShowS
ScreenId -> String
(Int -> ScreenId -> ShowS)
-> (ScreenId -> String) -> ([ScreenId] -> ShowS) -> Show ScreenId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScreenId] -> ShowS
$cshowList :: [ScreenId] -> ShowS
show :: ScreenId -> String
$cshow :: ScreenId -> String
showsPrec :: Int -> ScreenId -> ShowS
$cshowsPrec :: Int -> ScreenId -> ShowS
Show,ReadPrec [ScreenId]
ReadPrec ScreenId
Int -> ReadS ScreenId
ReadS [ScreenId]
(Int -> ReadS ScreenId)
-> ReadS [ScreenId]
-> ReadPrec ScreenId
-> ReadPrec [ScreenId]
-> Read 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]
(ScreenId -> ScreenId)
-> (ScreenId -> ScreenId)
-> (Int -> ScreenId)
-> (ScreenId -> Int)
-> (ScreenId -> [ScreenId])
-> (ScreenId -> ScreenId -> [ScreenId])
-> (ScreenId -> ScreenId -> [ScreenId])
-> (ScreenId -> ScreenId -> ScreenId -> [ScreenId])
-> Enum 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
(ScreenId -> ScreenId -> ScreenId)
-> (ScreenId -> ScreenId -> ScreenId)
-> (ScreenId -> ScreenId -> ScreenId)
-> (ScreenId -> ScreenId)
-> (ScreenId -> ScreenId)
-> (ScreenId -> ScreenId)
-> (Integer -> ScreenId)
-> Num 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
(Real ScreenId, Enum ScreenId) =>
(ScreenId -> ScreenId -> ScreenId)
-> (ScreenId -> ScreenId -> ScreenId)
-> (ScreenId -> ScreenId -> ScreenId)
-> (ScreenId -> ScreenId -> ScreenId)
-> (ScreenId -> ScreenId -> (ScreenId, ScreenId))
-> (ScreenId -> ScreenId -> (ScreenId, ScreenId))
-> (ScreenId -> Integer)
-> Integral 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
$cp2Integral :: Enum ScreenId
$cp1Integral :: Real ScreenId
Integral,Num ScreenId
Ord ScreenId
(Num ScreenId, Ord ScreenId) =>
(ScreenId -> Rational) -> Real ScreenId
ScreenId -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
toRational :: ScreenId -> Rational
$ctoRational :: ScreenId -> Rational
$cp2Real :: Ord ScreenId
$cp1Real :: Num ScreenId
Real)
data ScreenDetail = SD { ScreenDetail -> Rectangle
screenRect :: !Rectangle } deriving (ScreenDetail -> ScreenDetail -> Bool
(ScreenDetail -> ScreenDetail -> Bool)
-> (ScreenDetail -> ScreenDetail -> Bool) -> Eq ScreenDetail
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 -> String
(Int -> ScreenDetail -> ShowS)
-> (ScreenDetail -> String)
-> ([ScreenDetail] -> ShowS)
-> Show ScreenDetail
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScreenDetail] -> ShowS
$cshowList :: [ScreenDetail] -> ShowS
show :: ScreenDetail -> String
$cshow :: ScreenDetail -> String
showsPrec :: Int -> ScreenDetail -> ShowS
$cshowsPrec :: Int -> ScreenDetail -> ShowS
Show, ReadPrec [ScreenDetail]
ReadPrec ScreenDetail
Int -> ReadS ScreenDetail
ReadS [ScreenDetail]
(Int -> ReadS ScreenDetail)
-> ReadS [ScreenDetail]
-> ReadPrec ScreenDetail
-> ReadPrec [ScreenDetail]
-> Read 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)
newtype X a = X (ReaderT XConf (StateT XState IO) a)
deriving (a -> X b -> X a
(a -> b) -> X a -> X b
(forall a b. (a -> b) -> X a -> X b)
-> (forall a b. a -> X b -> X a) -> Functor X
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
<$ :: a -> X b -> X a
$c<$ :: forall a b. a -> X b -> X a
fmap :: (a -> b) -> X a -> X b
$cfmap :: forall a b. (a -> b) -> X a -> X b
Functor, Applicative X
a -> X a
Applicative X =>
(forall a b. X a -> (a -> X b) -> X b)
-> (forall a b. X a -> X b -> X b)
-> (forall a. a -> X a)
-> Monad X
X a -> (a -> X b) -> X b
X a -> X b -> X b
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 :: a -> X a
$creturn :: forall a. a -> X a
>> :: X a -> X b -> X b
$c>> :: forall a b. X a -> X b -> X b
>>= :: X a -> (a -> X b) -> X b
$c>>= :: forall a b. X a -> (a -> X b) -> X b
$cp1Monad :: Applicative X
Monad, Monad X
Monad X => (forall a. String -> X a) -> MonadFail X
String -> X a
forall a. String -> X a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
fail :: String -> X a
$cfail :: forall a. String -> X a
$cp1MonadFail :: Monad X
MonadFail, Monad X
Monad X => (forall a. IO a -> X a) -> MonadIO X
IO a -> X a
forall a. IO a -> X a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> X a
$cliftIO :: forall a. IO a -> X a
$cp1MonadIO :: Monad X
MonadIO, MonadState XState, MonadReader XConf, Typeable)
instance Applicative X where
pure :: a -> X a
pure = a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: X (a -> b) -> X a -> X b
(<*>) = X (a -> b) -> X a -> X b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Semigroup a => Semigroup (X a) where
<> :: X a -> X a -> X a
(<>) = (a -> a -> a) -> X a -> X a -> X a
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
instance (Monoid a) => Monoid (X a) where
mempty :: X a
mempty = a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
mappend :: X a -> X a -> X a
mappend = (a -> a -> a) -> X a -> X a -> X a
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> a
forall a. Monoid a => a -> a -> a
mappend
instance Default a => Default (X a) where
def :: X a
def = a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Default a => a
def
type ManageHook = Query (Endo WindowSet)
newtype Query a = Query (ReaderT Window X a)
deriving (a -> Query b -> Query a
(a -> b) -> Query a -> Query b
(forall a b. (a -> b) -> Query a -> Query b)
-> (forall a b. a -> Query b -> Query a) -> Functor Query
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
<$ :: a -> Query b -> Query a
$c<$ :: forall a b. a -> Query b -> Query a
fmap :: (a -> b) -> Query a -> Query b
$cfmap :: forall a b. (a -> b) -> Query a -> Query b
Functor, Functor Query
a -> Query a
Functor Query =>
(forall a. a -> Query a)
-> (forall a b. Query (a -> b) -> Query a -> Query b)
-> (forall a b c. (a -> b -> c) -> Query a -> Query b -> Query c)
-> (forall a b. Query a -> Query b -> Query b)
-> (forall a b. Query a -> Query b -> Query a)
-> Applicative Query
Query a -> Query b -> Query b
Query a -> Query b -> Query a
Query (a -> b) -> Query a -> Query b
(a -> b -> c) -> Query a -> Query b -> Query c
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
<* :: Query a -> Query b -> Query a
$c<* :: forall a b. Query a -> Query b -> Query a
*> :: Query a -> Query b -> Query b
$c*> :: forall a b. Query a -> Query b -> Query b
liftA2 :: (a -> b -> c) -> Query a -> Query b -> Query c
$cliftA2 :: forall a b c. (a -> b -> c) -> Query a -> Query b -> Query c
<*> :: Query (a -> b) -> Query a -> Query b
$c<*> :: forall a b. Query (a -> b) -> Query a -> Query b
pure :: a -> Query a
$cpure :: forall a. a -> Query a
$cp1Applicative :: Functor Query
Applicative, Applicative Query
a -> Query a
Applicative Query =>
(forall a b. Query a -> (a -> Query b) -> Query b)
-> (forall a b. Query a -> Query b -> Query b)
-> (forall a. a -> Query a)
-> Monad Query
Query a -> (a -> Query b) -> Query b
Query a -> Query b -> Query b
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 :: a -> Query a
$creturn :: forall a. a -> Query a
>> :: Query a -> Query b -> Query b
$c>> :: forall a b. Query a -> Query b -> Query b
>>= :: Query a -> (a -> Query b) -> Query b
$c>>= :: forall a b. Query a -> (a -> Query b) -> Query b
$cp1Monad :: Applicative Query
Monad, MonadReader Window, Monad Query
Monad Query => (forall a. IO a -> Query a) -> MonadIO Query
IO a -> Query a
forall a. IO a -> Query a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Query a
$cliftIO :: forall a. IO a -> Query a
$cp1MonadIO :: Monad Query
MonadIO)
runQuery :: Query a -> Window -> X a
runQuery :: Query a -> Window -> X a
runQuery (Query m :: ReaderT Window X a
m) w :: Window
w = ReaderT Window X a -> Window -> X a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Window X a
m Window
w
instance Semigroup a => Semigroup (Query a) where
<> :: Query a -> Query a -> Query a
(<>) = (a -> a -> a) -> Query a -> Query a -> Query a
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
instance Monoid a => Monoid (Query a) where
mempty :: Query a
mempty = a -> Query a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty
mappend :: Query a -> Query a -> Query a
mappend = (a -> a -> a) -> Query a -> Query a -> Query a
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> a -> a
forall a. Monoid a => a -> a -> a
mappend
instance Default a => Default (Query a) where
def :: Query a
def = a -> Query a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Default a => a
def
runX :: XConf -> XState -> X a -> IO (a, XState)
runX :: XConf -> XState -> X a -> IO (a, XState)
runX c :: XConf
c st :: XState
st (X a :: ReaderT XConf (StateT XState IO) a
a) = StateT XState IO a -> XState -> IO (a, XState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ReaderT XConf (StateT XState IO) a -> XConf -> StateT XState IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT XConf (StateT XState IO) a
a XConf
c) XState
st
catchX :: X a -> X a -> X a
catchX :: X a -> X a -> X a
catchX job :: X a
job errcase :: X a
errcase = do
XState
st <- X XState
forall s (m :: * -> *). MonadState s m => m s
get
XConf
c <- X XConf
forall r (m :: * -> *). MonadReader r m => m r
ask
(a :: a
a, s' :: XState
s') <- IO (a, XState) -> X (a, XState)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (a, XState) -> X (a, XState))
-> IO (a, XState) -> X (a, XState)
forall a b. (a -> b) -> a -> b
$ XConf -> XState -> X a -> IO (a, XState)
forall a. XConf -> XState -> X a -> IO (a, XState)
runX XConf
c XState
st X a
job IO (a, XState)
-> (SomeException -> IO (a, XState)) -> IO (a, XState)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \e :: SomeException
e -> case SomeException -> Maybe ExitCode
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just x :: ExitCode
x -> SomeException -> IO (a, XState)
forall a e. Exception e => e -> a
throw SomeException
e IO (a, XState) -> ExitCode -> IO (a, XState)
forall a b. a -> b -> a
`const` (ExitCode
x ExitCode -> ExitCode -> ExitCode
forall a. a -> a -> a
`asTypeOf` ExitCode
ExitSuccess)
_ -> do Handle -> SomeException -> IO ()
forall a. Show a => Handle -> a -> IO ()
hPrint Handle
stderr SomeException
e; XConf -> XState -> X a -> IO (a, XState)
forall a. XConf -> XState -> X a -> IO (a, XState)
runX XConf
c XState
st X a
errcase
XState -> X ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put XState
s'
a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
userCode :: X a -> X (Maybe a)
userCode :: X a -> X (Maybe a)
userCode a :: X a
a = X (Maybe a) -> X (Maybe a) -> X (Maybe a)
forall a. X a -> X a -> X a
catchX (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> X a -> X (Maybe a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` X a
a) (Maybe a -> X (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing)
userCodeDef :: a -> X a -> X a
userCodeDef :: a -> X a -> X a
userCodeDef defValue :: a
defValue a :: X a
a = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
defValue (Maybe a -> a) -> X (Maybe a) -> X a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` X a -> X (Maybe a)
forall a. X a -> X (Maybe a)
userCode X a
a
withDisplay :: (Display -> X a) -> X a
withDisplay :: (Display -> X a) -> X a
withDisplay f :: Display -> X a
f = (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display X Display -> (Display -> X a) -> X a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Display -> X a
f
withWindowSet :: (WindowSet -> X a) -> X a
withWindowSet :: (WindowSet -> X a) -> X a
withWindowSet f :: WindowSet -> X a
f = (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset X WindowSet -> (WindowSet -> X a) -> X a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WindowSet -> X a
f
withWindowAttributes :: Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes :: Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes dpy :: Display
dpy win :: Window
win f :: WindowAttributes -> X ()
f = do
Maybe WindowAttributes
wa <- X WindowAttributes -> X (Maybe WindowAttributes)
forall a. X a -> X (Maybe a)
userCode (IO WindowAttributes -> X WindowAttributes
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO WindowAttributes -> X WindowAttributes)
-> IO WindowAttributes -> X WindowAttributes
forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO WindowAttributes
getWindowAttributes Display
dpy Window
win)
X () -> X () -> X ()
forall a. X a -> X a -> X a
catchX (Maybe WindowAttributes -> (WindowAttributes -> X ()) -> X ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe WindowAttributes
wa WindowAttributes -> X ()
f) (() -> X ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
isRoot :: Window -> X Bool
isRoot :: Window -> X Bool
isRoot w :: Window
w = (Window
wWindow -> Window -> Bool
forall a. Eq a => a -> a -> Bool
==) (Window -> Bool) -> X Window -> X Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (XConf -> Window) -> X Window
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Window
theRoot
getAtom :: String -> X Atom
getAtom :: String -> X Window
getAtom str :: String
str = (Display -> X Window) -> X Window
forall a. (Display -> X a) -> X a
withDisplay ((Display -> X Window) -> X Window)
-> (Display -> X Window) -> X Window
forall a b. (a -> b) -> a -> b
$ \dpy :: Display
dpy -> IO Window -> X Window
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Window -> X Window) -> IO Window -> X Window
forall a b. (a -> b) -> a -> b
$ Display -> String -> Bool -> IO Window
internAtom Display
dpy String
str Bool
False
atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_STATE, atom_WM_TAKE_FOCUS :: X Atom
atom_WM_PROTOCOLS :: X Window
atom_WM_PROTOCOLS = String -> X Window
getAtom "WM_PROTOCOLS"
atom_WM_DELETE_WINDOW :: X Window
atom_WM_DELETE_WINDOW = String -> X Window
getAtom "WM_DELETE_WINDOW"
atom_WM_STATE :: X Window
atom_WM_STATE = String -> X Window
getAtom "WM_STATE"
atom_WM_TAKE_FOCUS :: X Window
atom_WM_TAKE_FOCUS = String -> X Window
getAtom "WM_TAKE_FOCUS"
data Layout a = forall l. (LayoutClass l a, Read (l a)) => Layout (l a)
readsLayout :: Layout a -> String -> [(Layout a, String)]
readsLayout :: Layout a -> String -> [(Layout a, String)]
readsLayout (Layout l :: l a
l) s :: String
s = [(l a -> Layout a
forall a (l :: * -> *).
(LayoutClass l a, Read (l a)) =>
l a -> Layout a
Layout (l a -> l a -> l a
forall a. a -> a -> a
asTypeOf l a
x l a
l), String
rs) | (x :: l a
x, rs :: String
rs) <- ReadS (l a)
forall a. Read a => ReadS a
reads String
s]
class Show (layout a) => LayoutClass layout a where
runLayout :: Workspace WorkspaceId (layout a) a
-> Rectangle
-> X ([(a, Rectangle)], Maybe (layout a))
runLayout (Workspace _ l :: layout a
l ms :: Maybe (Stack a)
ms) r :: Rectangle
r = X ([(a, Rectangle)], Maybe (layout a))
-> (Stack a -> X ([(a, Rectangle)], Maybe (layout a)))
-> Maybe (Stack a)
-> X ([(a, Rectangle)], Maybe (layout a))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (layout a -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
emptyLayout layout a
l Rectangle
r) (layout a
-> Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (layout a))
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
doLayout :: layout a -> Rectangle -> Stack a
-> X ([(a, Rectangle)], Maybe (layout a))
doLayout l :: layout a
l r :: Rectangle
r s :: Stack a
s = ([(a, Rectangle)], Maybe (layout a))
-> X ([(a, Rectangle)], Maybe (layout a))
forall (m :: * -> *) a. Monad m => a -> m a
return (layout a -> Rectangle -> Stack a -> [(a, Rectangle)]
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout layout a
l Rectangle
r Stack a
s, Maybe (layout a)
forall a. Maybe a
Nothing)
pureLayout :: layout a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout _ r :: Rectangle
r s :: Stack a
s = [(Stack a -> a
forall a. Stack a -> a
focus Stack a
s, Rectangle
r)]
emptyLayout :: layout a -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
emptyLayout _ _ = ([(a, Rectangle)], Maybe (layout a))
-> X ([(a, Rectangle)], Maybe (layout a))
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Maybe (layout a)
forall a. Maybe a
Nothing)
handleMessage :: layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l :: layout a
l = Maybe (layout a) -> X (Maybe (layout a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (layout a) -> X (Maybe (layout a)))
-> (SomeMessage -> Maybe (layout a))
-> SomeMessage
-> X (Maybe (layout a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. layout a -> SomeMessage -> Maybe (layout a)
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> Maybe (layout a)
pureMessage layout a
l
pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
pureMessage _ _ = Maybe (layout a)
forall a. Maybe a
Nothing
description :: layout a -> String
description = layout a -> String
forall a. Show a => a -> String
show
instance LayoutClass Layout Window where
runLayout :: Workspace String (Layout Window) Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (Layout Window))
runLayout (Workspace i :: String
i (Layout l :: l Window
l) ms :: Maybe (Stack Window)
ms) r :: Rectangle
r = (Maybe (l Window) -> Maybe (Layout Window))
-> ([(Window, Rectangle)], Maybe (l Window))
-> ([(Window, Rectangle)], Maybe (Layout Window))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((l Window -> Layout Window)
-> Maybe (l Window) -> Maybe (Layout Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap l Window -> Layout Window
forall a (l :: * -> *).
(LayoutClass l a, Read (l a)) =>
l a -> Layout a
Layout) (([(Window, Rectangle)], Maybe (l Window))
-> ([(Window, Rectangle)], Maybe (Layout Window)))
-> X ([(Window, Rectangle)], Maybe (l Window))
-> X ([(Window, Rectangle)], Maybe (Layout Window))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Workspace String (l Window) Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (l Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (String
-> l Window
-> Maybe (Stack Window)
-> Workspace String (l Window) Window
forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
Workspace String
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 :: l Window
l) r :: Rectangle
r s :: Stack Window
s = (Maybe (l Window) -> Maybe (Layout Window))
-> ([(Window, Rectangle)], Maybe (l Window))
-> ([(Window, Rectangle)], Maybe (Layout Window))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((l Window -> Layout Window)
-> Maybe (l Window) -> Maybe (Layout Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap l Window -> Layout Window
forall a (l :: * -> *).
(LayoutClass l a, Read (l a)) =>
l a -> Layout a
Layout) (([(Window, Rectangle)], Maybe (l Window))
-> ([(Window, Rectangle)], Maybe (Layout Window)))
-> X ([(Window, Rectangle)], Maybe (l Window))
-> X ([(Window, Rectangle)], Maybe (Layout Window))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` l Window
-> Rectangle
-> Stack Window
-> X ([(Window, Rectangle)], Maybe (l Window))
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 :: l Window
l) r :: Rectangle
r = (Maybe (l Window) -> Maybe (Layout Window))
-> ([(Window, Rectangle)], Maybe (l Window))
-> ([(Window, Rectangle)], Maybe (Layout Window))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((l Window -> Layout Window)
-> Maybe (l Window) -> Maybe (Layout Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap l Window -> Layout Window
forall a (l :: * -> *).
(LayoutClass l a, Read (l a)) =>
l a -> Layout a
Layout) (([(Window, Rectangle)], Maybe (l Window))
-> ([(Window, Rectangle)], Maybe (Layout Window)))
-> X ([(Window, Rectangle)], Maybe (l Window))
-> X ([(Window, Rectangle)], Maybe (Layout Window))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` l Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (l Window))
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 :: l Window
l) = (Maybe (l Window) -> Maybe (Layout Window))
-> X (Maybe (l Window)) -> X (Maybe (Layout Window))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((l Window -> Layout Window)
-> Maybe (l Window) -> Maybe (Layout Window)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap l Window -> Layout Window
forall a (l :: * -> *).
(LayoutClass l a, Read (l a)) =>
l a -> Layout a
Layout) (X (Maybe (l Window)) -> X (Maybe (Layout Window)))
-> (SomeMessage -> X (Maybe (l Window)))
-> SomeMessage
-> X (Maybe (Layout Window))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. l Window -> SomeMessage -> X (Maybe (l Window))
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l Window
l
description :: Layout Window -> String
description (Layout l :: l Window
l) = l Window -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l Window
l
instance Show (Layout a) where show :: Layout a -> String
show (Layout l :: l a
l) = l a -> String
forall a. Show a => a -> String
show l a
l
class Typeable a => Message a
data SomeMessage = forall a. Message a => SomeMessage a
fromMessage :: Message m => SomeMessage -> Maybe m
fromMessage :: SomeMessage -> Maybe m
fromMessage (SomeMessage m :: a
m) = a -> Maybe m
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
m
instance Message Event
data LayoutMessages = Hide
| ReleaseResources
deriving (Typeable, LayoutMessages -> LayoutMessages -> Bool
(LayoutMessages -> LayoutMessages -> Bool)
-> (LayoutMessages -> LayoutMessages -> Bool) -> Eq LayoutMessages
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
class Typeable a => ExtensionClass a where
initialValue :: a
extensionType :: a -> StateExtension
extensionType = a -> StateExtension
forall a. ExtensionClass a => a -> StateExtension
StateExtension
data StateExtension =
forall a. ExtensionClass a => StateExtension a
| forall a. (Read a, Show a, ExtensionClass a) => PersistentExtension a
io :: MonadIO m => IO a -> m a
io :: IO a -> m a
io = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
catchIO :: MonadIO m => IO () -> m ()
catchIO :: IO () -> m ()
catchIO f :: IO ()
f = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO ()
f IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(SomeException e :: e
e) -> Handle -> e -> IO ()
forall a. Show a => Handle -> a -> IO ()
hPrint Handle
stderr e
e IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
stderr)
spawn :: MonadIO m => String -> m ()
spawn :: String -> m ()
spawn x :: String
x = String -> m ProcessID
forall (m :: * -> *). MonadIO m => String -> m ProcessID
spawnPID String
x m ProcessID -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
spawnPID :: MonadIO m => String -> m ProcessID
spawnPID :: String -> m ProcessID
spawnPID x :: String
x = IO () -> m ProcessID
forall (m :: * -> *). MonadIO m => IO () -> m ProcessID
xfork (IO () -> m ProcessID) -> IO () -> m ProcessID
forall a b. (a -> b) -> a -> b
$ String -> Bool -> [String] -> Maybe [(String, String)] -> IO ()
forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
executeFile "/bin/sh" Bool
False ["-c", String
x] Maybe [(String, String)]
forall a. Maybe a
Nothing
xfork :: MonadIO m => IO () -> m ProcessID
xfork :: IO () -> m ProcessID
xfork x :: IO ()
x = IO ProcessID -> m ProcessID
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO ProcessID -> m ProcessID)
-> (IO () -> IO ProcessID) -> IO () -> m ProcessID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ProcessID
forkProcess (IO () -> IO ProcessID)
-> (IO () -> IO ()) -> IO () -> IO ProcessID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
finally IO ()
nullStdin (IO () -> m ProcessID) -> IO () -> m ProcessID
forall a b. (a -> b) -> a -> b
$ do
IO ()
forall (m :: * -> *). MonadIO m => m ()
uninstallSignalHandlers
IO ProcessID
createSession
IO ()
x
where
nullStdin :: IO ()
nullStdin = do
Fd
fd <- String -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd
openFd "/dev/null" OpenMode
ReadOnly Maybe FileMode
forall a. Maybe a
Nothing OpenFileFlags
defaultFileFlags
Fd -> Fd -> IO Fd
dupTo Fd
fd Fd
stdInput
Fd -> IO ()
closeFd Fd
fd
runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X ()
runOnWorkspaces :: (Workspace String (Layout Window) Window
-> X (Workspace String (Layout Window) Window))
-> X ()
runOnWorkspaces job :: Workspace String (Layout Window) Window
-> X (Workspace String (Layout Window) Window)
job = do
WindowSet
ws <- (XState -> WindowSet) -> X WindowSet
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
[Workspace String (Layout Window) Window]
h <- (Workspace String (Layout Window) Window
-> X (Workspace String (Layout Window) Window))
-> [Workspace String (Layout Window) Window]
-> X [Workspace String (Layout Window) Window]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Workspace String (Layout Window) Window
-> X (Workspace String (Layout Window) Window)
job ([Workspace String (Layout Window) Window]
-> X [Workspace String (Layout Window) Window])
-> [Workspace String (Layout Window) Window]
-> X [Workspace String (Layout Window) Window]
forall a b. (a -> b) -> a -> b
$ WindowSet -> [Workspace String (Layout Window) Window]
forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
hidden WindowSet
ws
c :: Screen String (Layout Window) Window ScreenId ScreenDetail
c:v :: [Screen String (Layout Window) Window ScreenId ScreenDetail]
v <- (Screen String (Layout Window) Window ScreenId ScreenDetail
-> X (Screen String (Layout Window) Window ScreenId ScreenDetail))
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
-> X [Screen String (Layout Window) Window ScreenId ScreenDetail]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\s :: Screen String (Layout Window) Window ScreenId ScreenDetail
s -> (\w :: Workspace String (Layout Window) Window
w -> Screen String (Layout Window) Window ScreenId ScreenDetail
s { workspace :: Workspace String (Layout Window) Window
workspace = Workspace String (Layout Window) Window
w}) (Workspace String (Layout Window) Window
-> Screen String (Layout Window) Window ScreenId ScreenDetail)
-> X (Workspace String (Layout Window) Window)
-> X (Screen String (Layout Window) Window ScreenId ScreenDetail)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Workspace String (Layout Window) Window
-> X (Workspace String (Layout Window) Window)
job (Screen String (Layout Window) Window ScreenId ScreenDetail
-> Workspace String (Layout Window) Window
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace Screen String (Layout Window) Window ScreenId ScreenDetail
s))
([Screen String (Layout Window) Window ScreenId ScreenDetail]
-> X [Screen String (Layout Window) Window ScreenId ScreenDetail])
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
-> X [Screen String (Layout Window) Window ScreenId ScreenDetail]
forall a b. (a -> b) -> a -> b
$ WindowSet
-> Screen String (Layout Window) Window ScreenId ScreenDetail
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current WindowSet
ws Screen String (Layout Window) Window ScreenId ScreenDetail
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
forall a. a -> [a] -> [a]
: WindowSet
-> [Screen String (Layout Window) Window ScreenId ScreenDetail]
forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible WindowSet
ws
(XState -> XState) -> X ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((XState -> XState) -> X ()) -> (XState -> XState) -> X ()
forall a b. (a -> b) -> a -> b
$ \s :: XState
s -> XState
s { windowset :: WindowSet
windowset = WindowSet
ws { current :: Screen String (Layout Window) Window ScreenId ScreenDetail
current = Screen String (Layout Window) Window ScreenId ScreenDetail
c, visible :: [Screen String (Layout Window) Window ScreenId ScreenDetail]
visible = [Screen String (Layout Window) Window ScreenId ScreenDetail]
v, hidden :: [Workspace String (Layout Window) Window]
hidden = [Workspace String (Layout Window) Window]
h } }
getXMonadDir :: MonadIO m => m String
getXMonadDir :: m String
getXMonadDir =
String -> [IO String] -> m String
forall (m :: * -> *).
MonadIO m =>
String -> [IO String] -> m String
findFirstDirWithEnv "XMONAD_CONFIG_DIR"
[ String -> IO String
getAppUserDataDirectory "xmonad"
, XDGDirectory -> String -> IO String
getXDGDirectory XDGDirectory
XDGConfig "xmonad"
]
getXMonadCacheDir :: MonadIO m => m String
getXMonadCacheDir :: m String
getXMonadCacheDir =
String -> [IO String] -> m String
forall (m :: * -> *).
MonadIO m =>
String -> [IO String] -> m String
findFirstDirWithEnv "XMONAD_CACHE_DIR"
[ String -> IO String
getAppUserDataDirectory "xmonad"
, XDGDirectory -> String -> IO String
getXDGDirectory XDGDirectory
XDGCache "xmonad"
]
getXMonadDataDir :: MonadIO m => m String
getXMonadDataDir :: m String
getXMonadDataDir =
String -> [IO String] -> m String
forall (m :: * -> *).
MonadIO m =>
String -> [IO String] -> m String
findFirstDirWithEnv "XMONAD_DATA_DIR"
[ String -> IO String
getAppUserDataDirectory "xmonad"
, XDGDirectory -> String -> IO String
getXDGDirectory XDGDirectory
XDGData "xmonad"
]
findFirstDirOf :: MonadIO m => [IO FilePath] -> m FilePath
findFirstDirOf :: [IO String] -> m String
findFirstDirOf [] = [IO String] -> m String
forall (m :: * -> *). MonadIO m => [IO String] -> m String
findFirstDirOf [String -> IO String
getAppUserDataDirectory "xmonad"]
findFirstDirOf possibles :: [IO String]
possibles = do
Maybe String
found <- [IO String] -> m (Maybe String)
forall (m :: * -> *). MonadIO m => [IO String] -> m (Maybe String)
go [IO String]
possibles
case Maybe String
found of
Just path :: String
path -> String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
path
Nothing -> do
String
primary <- IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io ([IO String] -> IO String
forall a. [a] -> a
head [IO String]
possibles)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
primary)
String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
primary
where
go :: [IO String] -> m (Maybe String)
go [] = Maybe String -> m (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
go (x :: IO String
x:xs :: [IO String]
xs) = do
String
dir <- IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io IO String
x
Bool
exists <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (String -> IO Bool
doesDirectoryExist String
dir)
if Bool
exists then Maybe String -> m (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe String
forall a. a -> Maybe a
Just String
dir) else [IO String] -> m (Maybe String)
go [IO String]
xs
findFirstDirWithEnv :: MonadIO m => String -> [IO FilePath] -> m FilePath
findFirstDirWithEnv :: String -> [IO String] -> m String
findFirstDirWithEnv envName :: String
envName paths :: [IO String]
paths = do
Maybe String
envPath' <- IO (Maybe String) -> m (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (String -> IO (Maybe String)
getEnv String
envName)
case Maybe String
envPath' of
Nothing -> [IO String] -> m String
forall (m :: * -> *). MonadIO m => [IO String] -> m String
findFirstDirOf [IO String]
paths
Just envPath :: String
envPath -> [IO String] -> m String
forall (m :: * -> *). MonadIO m => [IO String] -> m String
findFirstDirOf (String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
envPathIO String -> [IO String] -> [IO String]
forall a. a -> [a] -> [a]
:[IO String]
paths)
getXDGDirectory :: XDGDirectory -> FilePath -> IO FilePath
getXDGDirectory :: XDGDirectory -> String -> IO String
getXDGDirectory xdgDir :: XDGDirectory
xdgDir suffix :: String
suffix =
ShowS
normalise ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
</> String
suffix) ShowS -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
case XDGDirectory
xdgDir of
XDGData -> String -> String -> IO String
get "XDG_DATA_HOME" ".local/share"
XDGConfig -> String -> String -> IO String
get "XDG_CONFIG_HOME" ".config"
XDGCache -> String -> String -> IO String
get "XDG_CACHE_HOME" ".cache"
where
get :: String -> String -> IO String
get name :: String
name fallback :: String
fallback = do
Maybe String
env <- String -> IO (Maybe String)
lookupEnv String
name
case Maybe String
env of
Nothing -> IO String
fallback'
Just path :: String
path
| String -> Bool
isRelative String
path -> IO String
fallback'
| Bool
otherwise -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
path
where
fallback' :: IO String
fallback' = (String -> ShowS
</> String
fallback) ShowS -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getHomeDirectory
data XDGDirectory = XDGData | XDGConfig | XDGCache
stateFileName :: (Functor m, MonadIO m) => m FilePath
stateFileName :: m String
stateFileName = (String -> ShowS
</> "xmonad.state") ShowS -> m String -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String
forall (m :: * -> *). MonadIO m => m String
getXMonadDataDir
recompile :: MonadIO m => Bool -> m Bool
recompile :: Bool -> m Bool
recompile force :: Bool
force = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
String
cfgdir <- IO String
forall (m :: * -> *). MonadIO m => m String
getXMonadDir
String
datadir <- IO String
forall (m :: * -> *). MonadIO m => m String
getXMonadDataDir
let binn :: String
binn = "xmonad-"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
archString -> ShowS
forall a. [a] -> [a] -> [a]
++"-"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
os
bin :: String
bin = String
datadir String -> ShowS
</> String
binn
err :: String
err = String
datadir String -> ShowS
</> "xmonad.errors"
src :: String
src = String
cfgdir String -> ShowS
</> "xmonad.hs"
lib :: String
lib = String
cfgdir String -> ShowS
</> "lib"
buildscript :: String
buildscript = String
cfgdir String -> ShowS
</> "build"
[Maybe UTCTime]
libTs <- (String -> IO (Maybe UTCTime)) -> [String] -> IO [Maybe UTCTime]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (Maybe UTCTime)
getModTime ([String] -> IO [Maybe UTCTime])
-> ([String] -> [String]) -> [String] -> IO [Maybe UTCTime]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter String -> Bool
isSource ([String] -> IO [Maybe UTCTime])
-> IO [String] -> IO [Maybe UTCTime]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO [String]
allFiles String
lib
Maybe UTCTime
srcT <- String -> IO (Maybe UTCTime)
getModTime String
src
Maybe UTCTime
binT <- String -> IO (Maybe UTCTime)
getModTime String
bin
Bool
useBuildscript <- do
Bool
exists <- String -> IO Bool
doesFileExist String
buildscript
if Bool
exists
then do
Bool
isExe <- String -> IO Bool
isExecutable String
buildscript
if Bool
isExe
then do
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
trace (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "XMonad will use build script at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
buildscript String -> ShowS
forall a. [a] -> [a] -> [a]
++ " to recompile."
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else do
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
trace (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ "XMonad will not use build script, because " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
buildscript String -> ShowS
forall a. [a] -> [a] -> [a]
++ " is not executable."
, "Suggested resolution to use it: chmod u+x " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
buildscript
]
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else do
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
trace (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
"XMonad will use ghc to recompile, because " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
buildscript String -> ShowS
forall a. [a] -> [a] -> [a]
++ " does not exist."
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Bool
shouldRecompile <-
if Bool
useBuildscript Bool -> Bool -> Bool
|| Bool
force
then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else if (Maybe UTCTime -> Bool) -> [Maybe UTCTime] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe UTCTime
binT Maybe UTCTime -> Maybe UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<) (Maybe UTCTime
srcT Maybe UTCTime -> [Maybe UTCTime] -> [Maybe UTCTime]
forall a. a -> [a] -> [a]
: [Maybe UTCTime]
libTs)
then do
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
trace "XMonad doing recompile because some files have changed."
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else do
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
trace "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."
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
if Bool
shouldRecompile
then do
IO ()
forall (m :: * -> *). MonadIO m => m ()
uninstallSignalHandlers
ExitCode
status <- IO Handle
-> (Handle -> IO ()) -> (Handle -> IO ExitCode) -> IO ExitCode
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (String -> IOMode -> IO Handle
openFile String
err IOMode
WriteMode) Handle -> IO ()
hClose ((Handle -> IO ExitCode) -> IO ExitCode)
-> (Handle -> IO ExitCode) -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ \errHandle :: Handle
errHandle ->
ProcessHandle -> IO ExitCode
waitForProcess (ProcessHandle -> IO ExitCode) -> IO ProcessHandle -> IO ExitCode
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< if Bool
useBuildscript
then String -> String -> String -> Handle -> IO ProcessHandle
compileScript String
bin String
cfgdir String
buildscript Handle
errHandle
else String -> String -> Handle -> IO ProcessHandle
compileGHC String
bin String
cfgdir Handle
errHandle
IO ()
forall (m :: * -> *). MonadIO m => m ()
installSignalHandlers
if ExitCode
status ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
trace "XMonad recompilation process exited with success!"
else do
String
ghcErr <- String -> IO String
readFile String
err
let msg :: String
msg = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
["Error detected while loading xmonad configuration file: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
src]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
lines (if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ghcErr then ExitCode -> String
forall a. Show a => a -> String
show ExitCode
status else String
ghcErr)
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["","Please check the file for errors."]
Handle -> String -> IO ()
hPutStrLn Handle
stderr String
msg
IO () -> IO ProcessID
forkProcess (IO () -> IO ProcessID) -> IO () -> IO ProcessID
forall a b. (a -> b) -> a -> b
$ String -> Bool -> [String] -> Maybe [(String, String)] -> IO ()
forall a.
String -> Bool -> [String] -> Maybe [(String, String)] -> IO a
executeFile "xmessage" Bool
True ["-default", "okay", ShowS
replaceUnicode String
msg] Maybe [(String, String)]
forall a. Maybe a
Nothing
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
status ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess)
else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
where getModTime :: String -> IO (Maybe UTCTime)
getModTime f :: String
f = IO (Maybe UTCTime)
-> (SomeException -> IO (Maybe UTCTime)) -> IO (Maybe UTCTime)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just (UTCTime -> Maybe UTCTime) -> IO UTCTime -> IO (Maybe UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO UTCTime
getModificationTime String
f) (\(SomeException _) -> Maybe UTCTime -> IO (Maybe UTCTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe UTCTime
forall a. Maybe a
Nothing)
isSource :: String -> Bool
isSource = (String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [".hs",".lhs",".hsc"] (String -> Bool) -> ShowS -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeExtension
isExecutable :: String -> IO Bool
isExecutable f :: String
f = IO Bool -> (SomeException -> IO Bool) -> IO Bool
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (Permissions -> Bool
executable (Permissions -> Bool) -> IO Permissions -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Permissions
getPermissions String
f) (\(SomeException _) -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
allFiles :: String -> IO [String]
allFiles t :: String
t = do
let prep :: [String] -> [String]
prep = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
tString -> ShowS
</>) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [".",".."])
[String]
cs <- [String] -> [String]
prep ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String] -> (SomeException -> IO [String]) -> IO [String]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (String -> IO [String]
getDirectoryContents String
t) (\(SomeException _) -> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
[String]
ds <- (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesDirectoryExist [String]
cs
[[String]] -> [String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[String]] -> [String])
-> ([[String]] -> [[String]]) -> [[String]] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([String]
cs [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
ds)[String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
:) ([[String]] -> [String]) -> IO [[String]] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO [String]) -> [String] -> IO [[String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO [String]
allFiles [String]
ds
replaceUnicode :: ShowS
replaceUnicode = (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> ShowS) -> (Char -> Char) -> ShowS
forall a b. (a -> b) -> a -> b
$ \c :: Char
c -> case Char
c of
'\8226' -> '*'
'\8216' -> '`'
'\8217' -> '`'
_ -> Char
c
compileGHC :: String -> String -> Handle -> IO ProcessHandle
compileGHC bin :: String
bin dir :: String
dir errHandle :: Handle
errHandle =
String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> IO ProcessHandle
runProcess "ghc" ["--make"
, "xmonad.hs"
, "-i"
, "-ilib"
, "-fforce-recomp"
, "-main-is", "main"
, "-v0"
, "-o", String
bin
] (String -> Maybe String
forall a. a -> Maybe a
Just String
dir) Maybe [(String, String)]
forall a. Maybe a
Nothing Maybe Handle
forall a. Maybe a
Nothing Maybe Handle
forall a. Maybe a
Nothing (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
errHandle)
compileScript :: String -> String -> String -> Handle -> IO ProcessHandle
compileScript bin :: String
bin dir :: String
dir script :: String
script errHandle :: Handle
errHandle =
String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> IO ProcessHandle
runProcess String
script [String
bin] (String -> Maybe String
forall a. a -> Maybe a
Just String
dir) Maybe [(String, String)]
forall a. Maybe a
Nothing Maybe Handle
forall a. Maybe a
Nothing Maybe Handle
forall a. Maybe a
Nothing (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
errHandle)
whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust :: Maybe a -> (a -> m ()) -> m ()
whenJust mg :: Maybe a
mg f :: a -> m ()
f = m () -> (a -> m ()) -> Maybe a -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) a -> m ()
f Maybe a
mg
whenX :: X Bool -> X () -> X ()
whenX :: X Bool -> X () -> X ()
whenX a :: X Bool
a f :: X ()
f = X Bool
a X Bool -> (Bool -> X ()) -> X ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b :: Bool
b -> Bool -> X () -> X ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b X ()
f
trace :: MonadIO m => String -> m ()
trace :: String -> m ()
trace = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> String -> IO ()
hPutStrLn Handle
stderr
installSignalHandlers :: MonadIO m => m ()
installSignalHandlers :: m ()
installSignalHandlers = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
openEndedPipe Handler
Ignore Maybe SignalSet
forall a. Maybe a
Nothing
Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
sigCHLD Handler
Ignore Maybe SignalSet
forall a. Maybe a
Nothing
(forall a. IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
try :: IO a -> IO (Either SomeException a))
(IO () -> IO (Either SomeException ()))
-> IO () -> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ (IO () -> IO ()) -> IO ()
forall a. (a -> a) -> a
fix ((IO () -> IO ()) -> IO ()) -> (IO () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \more :: IO ()
more -> do
Maybe (ProcessID, ProcessStatus)
x <- Bool -> Bool -> IO (Maybe (ProcessID, ProcessStatus))
getAnyProcessStatus Bool
False Bool
False
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (ProcessID, ProcessStatus) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (ProcessID, ProcessStatus)
x) IO ()
more
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
uninstallSignalHandlers :: MonadIO m => m ()
uninstallSignalHandlers :: m ()
uninstallSignalHandlers = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
openEndedPipe Handler
Default Maybe SignalSet
forall a. Maybe a
Nothing
Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
sigCHLD Handler
Default Maybe SignalSet
forall a. Maybe a
Nothing
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()