{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DerivingVia #-}
module XMonad.Core (
X, WindowSet, WindowSpace, WorkspaceId,
ScreenId(..), ScreenDetail(..), XState(..),
XConf(..), XConfig(..), LayoutClass(..),
Layout(..), readsLayout, Typeable, Message,
SomeMessage(..), fromMessage, LayoutMessages(..),
StateExtension(..), ExtensionClass(..), ConfExtension(..),
runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers,
withDisplay, withWindowSet, isRoot, runOnWorkspaces,
getAtom, spawn, spawnPID, xfork, xmessage, recompile, trace, whenJust, whenX, ifM,
getXMonadDir, getXMonadCacheDir, getXMonadDataDir, stateFileName, binFileName,
atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, withWindowAttributes,
ManageHook, Query(..), runQuery, Directories'(..), Directories, getDirectories,
) where
import XMonad.StackSet hiding (modify)
import Prelude
import Control.Exception (fromException, try, bracket_, throw, finally, SomeException(..))
import qualified Control.Exception as E
import Control.Applicative ((<|>), empty)
import Control.Monad.Fail
import Control.Monad.Fix (fix)
import Control.Monad.State
import Control.Monad.Reader
import Control.Monad (filterM, guard, void, when)
import Data.Semigroup
import Data.Traversable (for)
import Data.Time.Clock (UTCTime)
import Data.Default.Class
import System.Environment (lookupEnv)
import Data.List (isInfixOf, intercalate, (\\))
import System.FilePath
import System.IO
import System.Info
import System.Posix.Env (getEnv)
import System.Posix.Process (executeFile, forkProcess, getAnyProcessStatus, createSession)
import System.Posix.Signals
import System.Posix.IO
import System.Posix.Types (ProcessID)
import System.Process
import System.Directory
import System.Exit
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras (getWindowAttributes, WindowAttributes, Event)
import Data.Typeable
import Data.Maybe (isJust,fromMaybe)
import Data.Monoid (Ap(..))
import qualified Data.Map as M
import qualified Data.Set as S
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 FilePath (Either FilePath 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, Button) (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)
, XConf -> Directories
directories :: !Directories
}
data XConfig l = XConfig
{ forall (l :: * -> *). XConfig l -> FilePath
normalBorderColor :: !String
, forall (l :: * -> *). XConfig l -> FilePath
focusedBorderColor :: !String
, forall (l :: * -> *). XConfig l -> FilePath
terminal :: !String
, forall (l :: * -> *). XConfig l -> l Window
layoutHook :: !(l Window)
, forall (l :: * -> *). XConfig l -> ManageHook
manageHook :: !ManageHook
, forall (l :: * -> *). XConfig l -> Event -> X All
handleEventHook :: !(Event -> X All)
, forall (l :: * -> *). XConfig l -> [FilePath]
workspaces :: ![String]
, forall (l :: * -> *). XConfig l -> KeyMask
modMask :: !KeyMask
, forall (l :: * -> *).
XConfig l -> XConfig Layout -> Map (KeyMask, Window) (X ())
keys :: !(XConfig Layout -> M.Map (ButtonMask,KeySym) (X ()))
, forall (l :: * -> *).
XConfig l
-> XConfig Layout -> Map (KeyMask, Button) (Window -> X ())
mouseBindings :: !(XConfig Layout -> M.Map (ButtonMask, Button) (Window -> X ()))
, forall (l :: * -> *). XConfig l -> Button
borderWidth :: !Dimension
, forall (l :: * -> *). XConfig l -> X ()
logHook :: !(X ())
, forall (l :: * -> *). XConfig l -> X ()
startupHook :: !(X ())
, forall (l :: * -> *). XConfig l -> Bool
focusFollowsMouse :: !Bool
, forall (l :: * -> *). XConfig l -> Bool
clickJustFocuses :: !Bool
, forall (l :: * -> *). XConfig l -> Window
clientMask :: !EventMask
, forall (l :: * -> *). XConfig l -> Window
rootMask :: !EventMask
, forall (l :: * -> *).
XConfig l -> [FilePath] -> XConfig Layout -> IO (XConfig Layout)
handleExtraArgs :: !([String] -> XConfig Layout -> IO (XConfig Layout))
, forall (l :: * -> *). XConfig l -> Map TypeRep ConfExtension
extensibleConf :: !(M.Map TypeRep ConfExtension)
}
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScreenId -> ScreenId -> Bool
$c/= :: ScreenId -> ScreenId -> Bool
== :: ScreenId -> ScreenId -> Bool
$c== :: ScreenId -> ScreenId -> Bool
Eq,Eq ScreenId
ScreenId -> ScreenId -> Bool
ScreenId -> ScreenId -> Ordering
ScreenId -> ScreenId -> ScreenId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ScreenId -> ScreenId -> ScreenId
$cmin :: ScreenId -> ScreenId -> ScreenId
max :: ScreenId -> ScreenId -> ScreenId
$cmax :: ScreenId -> ScreenId -> ScreenId
>= :: ScreenId -> ScreenId -> Bool
$c>= :: ScreenId -> ScreenId -> Bool
> :: ScreenId -> ScreenId -> Bool
$c> :: ScreenId -> ScreenId -> Bool
<= :: ScreenId -> ScreenId -> Bool
$c<= :: ScreenId -> ScreenId -> Bool
< :: ScreenId -> ScreenId -> Bool
$c< :: ScreenId -> ScreenId -> Bool
compare :: ScreenId -> ScreenId -> Ordering
$ccompare :: ScreenId -> ScreenId -> Ordering
Ord,Int -> ScreenId -> ShowS
[ScreenId] -> ShowS
ScreenId -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ScreenId] -> ShowS
$cshowList :: [ScreenId] -> ShowS
show :: ScreenId -> FilePath
$cshow :: ScreenId -> FilePath
showsPrec :: Int -> ScreenId -> ShowS
$cshowsPrec :: Int -> ScreenId -> ShowS
Show,ReadPrec [ScreenId]
ReadPrec ScreenId
Int -> ReadS ScreenId
ReadS [ScreenId]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ScreenId]
$creadListPrec :: ReadPrec [ScreenId]
readPrec :: ReadPrec ScreenId
$creadPrec :: ReadPrec ScreenId
readList :: ReadS [ScreenId]
$creadList :: ReadS [ScreenId]
readsPrec :: Int -> ReadS ScreenId
$creadsPrec :: Int -> ReadS ScreenId
Read,Int -> ScreenId
ScreenId -> Int
ScreenId -> [ScreenId]
ScreenId -> ScreenId
ScreenId -> ScreenId -> [ScreenId]
ScreenId -> ScreenId -> ScreenId -> [ScreenId]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ScreenId -> ScreenId -> ScreenId -> [ScreenId]
$cenumFromThenTo :: ScreenId -> ScreenId -> ScreenId -> [ScreenId]
enumFromTo :: ScreenId -> ScreenId -> [ScreenId]
$cenumFromTo :: ScreenId -> ScreenId -> [ScreenId]
enumFromThen :: ScreenId -> ScreenId -> [ScreenId]
$cenumFromThen :: ScreenId -> ScreenId -> [ScreenId]
enumFrom :: ScreenId -> [ScreenId]
$cenumFrom :: ScreenId -> [ScreenId]
fromEnum :: ScreenId -> Int
$cfromEnum :: ScreenId -> Int
toEnum :: Int -> ScreenId
$ctoEnum :: Int -> ScreenId
pred :: ScreenId -> ScreenId
$cpred :: ScreenId -> ScreenId
succ :: ScreenId -> ScreenId
$csucc :: ScreenId -> ScreenId
Enum,Integer -> ScreenId
ScreenId -> ScreenId
ScreenId -> ScreenId -> ScreenId
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> ScreenId
$cfromInteger :: Integer -> ScreenId
signum :: ScreenId -> ScreenId
$csignum :: ScreenId -> ScreenId
abs :: ScreenId -> ScreenId
$cabs :: ScreenId -> ScreenId
negate :: ScreenId -> ScreenId
$cnegate :: ScreenId -> ScreenId
* :: ScreenId -> ScreenId -> ScreenId
$c* :: ScreenId -> ScreenId -> ScreenId
- :: ScreenId -> ScreenId -> ScreenId
$c- :: ScreenId -> ScreenId -> ScreenId
+ :: ScreenId -> ScreenId -> ScreenId
$c+ :: ScreenId -> ScreenId -> ScreenId
Num,Enum ScreenId
Real ScreenId
ScreenId -> Integer
ScreenId -> ScreenId -> (ScreenId, ScreenId)
ScreenId -> ScreenId -> ScreenId
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: ScreenId -> Integer
$ctoInteger :: ScreenId -> Integer
divMod :: ScreenId -> ScreenId -> (ScreenId, ScreenId)
$cdivMod :: ScreenId -> ScreenId -> (ScreenId, ScreenId)
quotRem :: ScreenId -> ScreenId -> (ScreenId, ScreenId)
$cquotRem :: ScreenId -> ScreenId -> (ScreenId, ScreenId)
mod :: ScreenId -> ScreenId -> ScreenId
$cmod :: ScreenId -> ScreenId -> ScreenId
div :: ScreenId -> ScreenId -> ScreenId
$cdiv :: ScreenId -> ScreenId -> ScreenId
rem :: ScreenId -> ScreenId -> ScreenId
$crem :: ScreenId -> ScreenId -> ScreenId
quot :: ScreenId -> ScreenId -> ScreenId
$cquot :: ScreenId -> ScreenId -> ScreenId
Integral,Num ScreenId
Ord ScreenId
ScreenId -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: ScreenId -> Rational
$ctoRational :: ScreenId -> Rational
Real)
newtype ScreenDetail = SD { ScreenDetail -> Rectangle
screenRect :: Rectangle }
deriving (ScreenDetail -> ScreenDetail -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScreenDetail -> ScreenDetail -> Bool
$c/= :: ScreenDetail -> ScreenDetail -> Bool
== :: ScreenDetail -> ScreenDetail -> Bool
$c== :: ScreenDetail -> ScreenDetail -> Bool
Eq,Int -> ScreenDetail -> ShowS
[ScreenDetail] -> ShowS
ScreenDetail -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ScreenDetail] -> ShowS
$cshowList :: [ScreenDetail] -> ShowS
show :: ScreenDetail -> FilePath
$cshow :: ScreenDetail -> FilePath
showsPrec :: Int -> ScreenDetail -> ShowS
$cshowsPrec :: Int -> ScreenDetail -> ShowS
Show, ReadPrec [ScreenDetail]
ReadPrec ScreenDetail
Int -> ReadS ScreenDetail
ReadS [ScreenDetail]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ScreenDetail]
$creadListPrec :: ReadPrec [ScreenDetail]
readPrec :: ReadPrec ScreenDetail
$creadPrec :: ReadPrec ScreenDetail
readList :: ReadS [ScreenDetail]
$creadList :: ReadS [ScreenDetail]
readsPrec :: Int -> ReadS ScreenDetail
$creadsPrec :: Int -> ReadS ScreenDetail
Read)
newtype X a = X (ReaderT XConf (StateT XState IO) a)
deriving (forall a b. a -> X b -> X a
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> X b -> X a
$c<$ :: forall a b. a -> X b -> X a
fmap :: forall a b. (a -> b) -> X a -> X b
$cfmap :: forall a b. (a -> b) -> X a -> X b
Functor, Functor X
forall a. a -> X a
forall a b. X a -> X b -> X a
forall a b. X a -> X b -> X b
forall a b. X (a -> b) -> X a -> X b
forall a b c. (a -> b -> c) -> X a -> X b -> X c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. X a -> X b -> X a
$c<* :: forall a b. X a -> X b -> X a
*> :: forall a b. X a -> X b -> X b
$c*> :: forall a b. X a -> X b -> X b
liftA2 :: forall a b c. (a -> b -> c) -> X a -> X b -> X c
$cliftA2 :: forall a b c. (a -> b -> c) -> X a -> X b -> X c
<*> :: forall a b. X (a -> b) -> X a -> X b
$c<*> :: forall a b. X (a -> b) -> X a -> X b
pure :: forall a. a -> X a
$cpure :: forall a. a -> X a
Applicative, Applicative X
forall a. a -> X a
forall a b. X a -> X b -> X b
forall a b. X a -> (a -> X b) -> X b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> X a
$creturn :: forall a. a -> X a
>> :: forall a b. X a -> X b -> X b
$c>> :: forall a b. X a -> X b -> X b
>>= :: forall a b. X a -> (a -> X b) -> X b
$c>>= :: forall a b. X a -> (a -> X b) -> X b
Monad, Monad X
forall a. FilePath -> X a
forall (m :: * -> *).
Monad m -> (forall a. FilePath -> m a) -> MonadFail m
fail :: forall a. FilePath -> X a
$cfail :: forall a. FilePath -> X a
MonadFail, Monad X
forall a. IO a -> X a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> X a
$cliftIO :: forall a. IO a -> X a
MonadIO, MonadState XState, MonadReader XConf)
deriving (NonEmpty (X a) -> X a
X a -> X a -> X a
forall b. Integral b => b -> X a -> X a
forall a. Semigroup a => NonEmpty (X a) -> X a
forall a. Semigroup a => X a -> X a -> X a
forall a b. (Semigroup a, Integral b) => b -> X a -> X a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> X a -> X a
$cstimes :: forall a b. (Semigroup a, Integral b) => b -> X a -> X a
sconcat :: NonEmpty (X a) -> X a
$csconcat :: forall a. Semigroup a => NonEmpty (X a) -> X a
<> :: X a -> X a -> X a
$c<> :: forall a. Semigroup a => X a -> X a -> X a
Semigroup, X a
[X a] -> X a
X a -> X a -> X a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall {a}. Monoid a => Semigroup (X a)
forall a. Monoid a => X a
forall a. Monoid a => [X a] -> X a
forall a. Monoid a => X a -> X a -> X a
mconcat :: [X a] -> X a
$cmconcat :: forall a. Monoid a => [X a] -> X a
mappend :: X a -> X a -> X a
$cmappend :: forall a. Monoid a => X a -> X a -> X a
mempty :: X a
$cmempty :: forall a. Monoid a => X a
Monoid) via Ap X a
instance Default a => Default (X a) where
def :: X a
def = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Default a => a
def
type ManageHook = Query (Endo WindowSet)
newtype Query a = Query (ReaderT Window X a)
deriving (forall a b. a -> Query b -> Query a
forall a b. (a -> b) -> Query a -> Query b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Query b -> Query a
$c<$ :: forall a b. a -> Query b -> Query a
fmap :: forall a b. (a -> b) -> Query a -> Query b
$cfmap :: forall a b. (a -> b) -> Query a -> Query b
Functor, Functor Query
forall a. a -> Query a
forall a b. Query a -> Query b -> Query a
forall a b. Query a -> Query b -> Query b
forall a b. Query (a -> b) -> Query a -> Query b
forall a b c. (a -> b -> c) -> Query a -> Query b -> Query c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Query a -> Query b -> Query a
$c<* :: forall a b. Query a -> Query b -> Query a
*> :: forall a b. Query a -> Query b -> Query b
$c*> :: forall a b. Query a -> Query b -> Query b
liftA2 :: forall a b c. (a -> b -> c) -> Query a -> Query b -> Query c
$cliftA2 :: forall a b c. (a -> b -> c) -> Query a -> Query b -> Query c
<*> :: forall a b. Query (a -> b) -> Query a -> Query b
$c<*> :: forall a b. Query (a -> b) -> Query a -> Query b
pure :: forall a. a -> Query a
$cpure :: forall a. a -> Query a
Applicative, Applicative Query
forall a. a -> Query a
forall a b. Query a -> Query b -> Query b
forall a b. Query a -> (a -> Query b) -> Query b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Query a
$creturn :: forall a. a -> Query a
>> :: forall a b. Query a -> Query b -> Query b
$c>> :: forall a b. Query a -> Query b -> Query b
>>= :: forall a b. Query a -> (a -> Query b) -> Query b
$c>>= :: forall a b. Query a -> (a -> Query b) -> Query b
Monad, MonadReader Window, Monad Query
forall a. IO a -> Query a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Query a
$cliftIO :: forall a. IO a -> Query a
MonadIO)
deriving (NonEmpty (Query a) -> Query a
Query a -> Query a -> Query a
forall b. Integral b => b -> Query a -> Query a
forall a. Semigroup a => NonEmpty (Query a) -> Query a
forall a. Semigroup a => Query a -> Query a -> Query a
forall a b. (Semigroup a, Integral b) => b -> Query a -> Query a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Query a -> Query a
$cstimes :: forall a b. (Semigroup a, Integral b) => b -> Query a -> Query a
sconcat :: NonEmpty (Query a) -> Query a
$csconcat :: forall a. Semigroup a => NonEmpty (Query a) -> Query a
<> :: Query a -> Query a -> Query a
$c<> :: forall a. Semigroup a => Query a -> Query a -> Query a
Semigroup, Query a
[Query a] -> Query a
Query a -> Query a -> Query a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall {a}. Monoid a => Semigroup (Query a)
forall a. Monoid a => Query a
forall a. Monoid a => [Query a] -> Query a
forall a. Monoid a => Query a -> Query a -> Query a
mconcat :: [Query a] -> Query a
$cmconcat :: forall a. Monoid a => [Query a] -> Query a
mappend :: Query a -> Query a -> Query a
$cmappend :: forall a. Monoid a => Query a -> Query a -> Query a
mempty :: Query a
$cmempty :: forall a. Monoid a => Query a
Monoid) via Ap Query a
runQuery :: Query a -> Window -> X a
runQuery :: forall a. Query a -> Window -> X a
runQuery (Query ReaderT Window X a
m) = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT Window X a
m
instance Default a => Default (Query a) where
def :: Query a
def = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Default a => a
def
runX :: XConf -> XState -> X a -> IO (a, XState)
runX :: forall a. XConf -> XState -> X a -> IO (a, XState)
runX XConf
c XState
st (X ReaderT XConf (StateT XState IO) a
a) = forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT XConf (StateT XState IO) a
a XConf
c) XState
st
catchX :: X a -> X a -> X a
catchX :: forall a. X a -> X a -> X a
catchX X a
job X a
errcase = do
XState
st <- forall s (m :: * -> *). MonadState s m => m s
get
XConf
c <- forall r (m :: * -> *). MonadReader r m => m r
ask
(a
a, XState
s') <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ forall a. XConf -> XState -> X a -> IO (a, XState)
runX XConf
c XState
st X a
job forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \SomeException
e -> case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just (ExitCode
_ :: ExitCode) -> forall a e. Exception e => e -> a
throw SomeException
e
Maybe ExitCode
_ -> do forall a. Show a => Handle -> a -> IO ()
hPrint Handle
stderr SomeException
e; forall a. XConf -> XState -> X a -> IO (a, XState)
runX XConf
c XState
st X a
errcase
forall s (m :: * -> *). MonadState s m => s -> m ()
put XState
s'
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
userCode :: X a -> X (Maybe a)
userCode :: forall a. X a -> X (Maybe a)
userCode X a
a = forall a. X a -> X a -> X a
catchX (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> X a
a) (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
userCodeDef :: a -> X a -> X a
userCodeDef :: forall a. a -> X a -> X a
userCodeDef a
defValue X a
a = forall a. a -> Maybe a -> a
fromMaybe a
defValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. X a -> X (Maybe a)
userCode X a
a
withDisplay :: (Display -> X a) -> X a
withDisplay :: forall a. (Display -> X a) -> X a
withDisplay Display -> X a
f = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Display -> X a
f
withWindowSet :: (WindowSet -> X a) -> X a
withWindowSet :: forall a. (WindowSet -> X a) -> X a
withWindowSet WindowSet -> X a
f = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WindowSet -> X a
f
withWindowAttributes :: Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes :: Display -> Window -> (WindowAttributes -> X ()) -> X ()
withWindowAttributes Display
dpy Window
win WindowAttributes -> X ()
f = do
Maybe WindowAttributes
wa <- forall a. X a -> X (Maybe a)
userCode (forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Window -> IO WindowAttributes
getWindowAttributes Display
dpy Window
win)
forall a. X a -> X a -> X a
catchX (forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe WindowAttributes
wa WindowAttributes -> X ()
f) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
isRoot :: Window -> X Bool
isRoot :: Window -> X Bool
isRoot Window
w = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ (Window
w forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> Window
theRoot
getAtom :: String -> X Atom
getAtom :: FilePath -> X Window
getAtom FilePath
str = forall a. (Display -> X a) -> X a
withDisplay forall a b. (a -> b) -> a -> b
$ \Display
dpy -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> FilePath -> Bool -> IO Window
internAtom Display
dpy FilePath
str Bool
False
atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_STATE, atom_WM_TAKE_FOCUS :: X Atom
atom_WM_PROTOCOLS :: X Window
atom_WM_PROTOCOLS = FilePath -> X Window
getAtom FilePath
"WM_PROTOCOLS"
atom_WM_DELETE_WINDOW :: X Window
atom_WM_DELETE_WINDOW = FilePath -> X Window
getAtom FilePath
"WM_DELETE_WINDOW"
atom_WM_STATE :: X Window
atom_WM_STATE = FilePath -> X Window
getAtom FilePath
"WM_STATE"
atom_WM_TAKE_FOCUS :: X Window
atom_WM_TAKE_FOCUS = FilePath -> X Window
getAtom FilePath
"WM_TAKE_FOCUS"
data Layout a = forall l. (LayoutClass l a, Read (l a)) => Layout (l a)
readsLayout :: Layout a -> String -> [(Layout a, String)]
readsLayout :: forall a. Layout a -> FilePath -> [(Layout a, FilePath)]
readsLayout (Layout l a
l) FilePath
s = [(forall a (l :: * -> *).
(LayoutClass l a, Read (l a)) =>
l a -> Layout a
Layout (forall a. a -> a -> a
asTypeOf l a
x l a
l), FilePath
rs) | (l a
x, FilePath
rs) <- forall a. Read a => ReadS a
reads FilePath
s]
class (Show (layout a), Typeable layout) => LayoutClass layout a where
runLayout :: Workspace WorkspaceId (layout a) a
-> Rectangle
-> X ([(a, Rectangle)], Maybe (layout a))
runLayout (Workspace FilePath
_ layout a
l Maybe (Stack a)
ms) Rectangle
r = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
emptyLayout layout a
l Rectangle
r) (forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a
-> Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (layout a))
doLayout layout a
l Rectangle
r) Maybe (Stack a)
ms
doLayout :: layout a -> Rectangle -> Stack a
-> X ([(a, Rectangle)], Maybe (layout a))
doLayout layout a
l Rectangle
r Stack a
s = forall (m :: * -> *) a. Monad m => a -> m a
return (forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout layout a
l Rectangle
r Stack a
s, forall a. Maybe a
Nothing)
pureLayout :: layout a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout layout a
_ Rectangle
r Stack a
s = [(forall a. Stack a -> a
focus Stack a
s, Rectangle
r)]
emptyLayout :: layout a -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
emptyLayout layout a
_ Rectangle
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ([], forall a. Maybe a
Nothing)
handleMessage :: layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage layout a
l = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> Maybe (layout a)
pureMessage layout a
l
pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
pureMessage layout a
_ SomeMessage
_ = forall a. Maybe a
Nothing
description :: layout a -> String
description = forall a. Show a => a -> FilePath
show
instance LayoutClass Layout Window where
runLayout :: Workspace FilePath (Layout Window) Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (Layout Window))
runLayout (Workspace FilePath
i (Layout l Window
l) Maybe (Stack Window)
ms) Rectangle
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a (l :: * -> *).
(LayoutClass l a, Read (l a)) =>
l a -> Layout a
Layout) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace FilePath (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
Workspace FilePath
i l Window
l Maybe (Stack Window)
ms) Rectangle
r
doLayout :: Layout Window
-> Rectangle
-> Stack Window
-> X ([(Window, Rectangle)], Maybe (Layout Window))
doLayout (Layout l Window
l) Rectangle
r Stack Window
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a (l :: * -> *).
(LayoutClass l a, Read (l a)) =>
l a -> Layout a
Layout) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a
-> Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (layout a))
doLayout l Window
l Rectangle
r Stack Window
s
emptyLayout :: Layout Window
-> Rectangle -> X ([(Window, Rectangle)], Maybe (Layout Window))
emptyLayout (Layout l Window
l) Rectangle
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a (l :: * -> *).
(LayoutClass l a, Read (l a)) =>
l a -> Layout a
Layout) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
emptyLayout l Window
l Rectangle
r
handleMessage :: Layout Window -> SomeMessage -> X (Maybe (Layout Window))
handleMessage (Layout l Window
l) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a (l :: * -> *).
(LayoutClass l a, Read (l a)) =>
l a -> Layout a
Layout) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l Window
l
description :: Layout Window -> FilePath
description (Layout l Window
l) = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> FilePath
description l Window
l
instance Show (Layout a) where show :: Layout a -> FilePath
show (Layout l a
l) = forall a. Show a => a -> FilePath
show l a
l
class Typeable a => Message a
data SomeMessage = forall a. Message a => SomeMessage a
fromMessage :: Message m => SomeMessage -> Maybe m
fromMessage :: forall m. Message m => SomeMessage -> Maybe m
fromMessage (SomeMessage a
m) = forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a
m
instance Message Event
data LayoutMessages = Hide
| ReleaseResources
deriving LayoutMessages -> LayoutMessages -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayoutMessages -> LayoutMessages -> Bool
$c/= :: LayoutMessages -> LayoutMessages -> Bool
== :: LayoutMessages -> LayoutMessages -> Bool
$c== :: LayoutMessages -> LayoutMessages -> Bool
Eq
instance Message LayoutMessages
class Typeable a => ExtensionClass a where
{-# MINIMAL initialValue #-}
initialValue :: a
extensionType :: a -> StateExtension
extensionType = 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
data ConfExtension = forall a. Typeable a => ConfExtension a
ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM :: forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
mb m a
t m a
f = m Bool
mb forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> if Bool
b then m a
t else m a
f
io :: MonadIO m => IO a -> m a
io :: forall (m :: * -> *) a. MonadIO m => IO a -> m a
io = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
catchIO :: MonadIO m => IO () -> m ()
catchIO :: forall (m :: * -> *). MonadIO m => IO () -> m ()
catchIO IO ()
f = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO ()
f forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` \(SomeException e
e) -> forall a. Show a => Handle -> a -> IO ()
hPrint Handle
stderr e
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
stderr)
spawn :: MonadIO m => String -> m ()
spawn :: forall (m :: * -> *). MonadIO m => FilePath -> m ()
spawn FilePath
x = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => FilePath -> m ProcessID
spawnPID FilePath
x
spawnPID :: MonadIO m => String -> m ProcessID
spawnPID :: forall (m :: * -> *). MonadIO m => FilePath -> m ProcessID
spawnPID FilePath
x = forall (m :: * -> *). MonadIO m => IO () -> m ProcessID
xfork forall a b. (a -> b) -> a -> b
$ forall a.
FilePath
-> Bool -> [FilePath] -> Maybe [(FilePath, FilePath)] -> IO a
executeFile FilePath
"/bin/sh" Bool
False [FilePath
"-c", FilePath
x] forall a. Maybe a
Nothing
xfork :: MonadIO m => IO () -> m ProcessID
xfork :: forall (m :: * -> *). MonadIO m => IO () -> m ProcessID
xfork IO ()
x = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ProcessID
forkProcess forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. IO a -> IO b -> IO a
finally IO ()
nullStdin forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *). MonadIO m => m ()
uninstallSignalHandlers
IO ProcessID
createSession
IO ()
x
where
nullStdin :: IO ()
nullStdin = do
#if MIN_VERSION_unix(2,8,0)
fd <- openFd "/dev/null" ReadOnly defaultFileFlags
#else
Fd
fd <- FilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd
openFd FilePath
"/dev/null" OpenMode
ReadOnly forall a. Maybe a
Nothing OpenFileFlags
defaultFileFlags
#endif
Fd -> Fd -> IO Fd
dupTo Fd
fd Fd
stdInput
Fd -> IO ()
closeFd Fd
fd
xmessage :: MonadIO m => String -> m ()
xmessage :: forall (m :: * -> *). MonadIO m => FilePath -> m ()
xmessage FilePath
msg = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadIO m => IO () -> m ProcessID
xfork forall a b. (a -> b) -> a -> b
$ do
FilePath
xmessageBin <- forall a. a -> Maybe a -> a
fromMaybe FilePath
"xmessage" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"XMONAD_XMESSAGE")
forall a.
FilePath
-> Bool -> [FilePath] -> Maybe [(FilePath, FilePath)] -> IO a
executeFile FilePath
xmessageBin Bool
True
[ FilePath
"-default", FilePath
"okay"
, FilePath
"-xrm", FilePath
"*international:true"
, FilePath
"-xrm", FilePath
"*fontSet:-*-fixed-medium-r-normal-*-18-*-*-*-*-*-*-*,-*-fixed-*-*-*-*-18-*-*-*-*-*-*-*,-*-*-*-*-*-*-18-*-*-*-*-*-*-*"
, FilePath
msg
] forall a. Maybe a
Nothing
runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X ()
runOnWorkspaces :: (Workspace FilePath (Layout Window) Window
-> X (Workspace FilePath (Layout Window) Window))
-> X ()
runOnWorkspaces Workspace FilePath (Layout Window) Window
-> X (Workspace FilePath (Layout Window) Window)
job = do
WindowSet
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
[Workspace FilePath (Layout Window) Window]
h <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Workspace FilePath (Layout Window) Window
-> X (Workspace FilePath (Layout Window) Window)
job forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> [Workspace i l a]
hidden WindowSet
ws
Screen FilePath (Layout Window) Window ScreenId ScreenDetail
c:[Screen FilePath (Layout Window) Window ScreenId ScreenDetail]
v <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Screen FilePath (Layout Window) Window ScreenId ScreenDetail
s -> (\Workspace FilePath (Layout Window) Window
w -> Screen FilePath (Layout Window) Window ScreenId ScreenDetail
s { workspace :: Workspace FilePath (Layout Window) Window
workspace = Workspace FilePath (Layout Window) Window
w}) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Workspace FilePath (Layout Window) Window
-> X (Workspace FilePath (Layout Window) Window)
job (forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
workspace Screen FilePath (Layout Window) Window ScreenId ScreenDetail
s))
forall a b. (a -> b) -> a -> b
$ forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
current WindowSet
ws forall a. a -> [a] -> [a]
: forall i l a sid sd. StackSet i l a sid sd -> [Screen i l a sid sd]
visible WindowSet
ws
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \XState
s -> XState
s { windowset :: WindowSet
windowset = WindowSet
ws { current :: Screen FilePath (Layout Window) Window ScreenId ScreenDetail
current = Screen FilePath (Layout Window) Window ScreenId ScreenDetail
c, visible :: [Screen FilePath (Layout Window) Window ScreenId ScreenDetail]
visible = [Screen FilePath (Layout Window) Window ScreenId ScreenDetail]
v, hidden :: [Workspace FilePath (Layout Window) Window]
hidden = [Workspace FilePath (Layout Window) Window]
h } }
data Directories' a = Directories
{ forall a. Directories' a -> a
dataDir :: !a
, forall a. Directories' a -> a
cfgDir :: !a
, forall a. Directories' a -> a
cacheDir :: !a
}
deriving (Int -> Directories' a -> ShowS
forall a. Show a => Int -> Directories' a -> ShowS
forall a. Show a => [Directories' a] -> ShowS
forall a. Show a => Directories' a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Directories' a] -> ShowS
$cshowList :: forall a. Show a => [Directories' a] -> ShowS
show :: Directories' a -> FilePath
$cshow :: forall a. Show a => Directories' a -> FilePath
showsPrec :: Int -> Directories' a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Directories' a -> ShowS
Show, forall a b. a -> Directories' b -> Directories' a
forall a b. (a -> b) -> Directories' a -> Directories' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Directories' b -> Directories' a
$c<$ :: forall a b. a -> Directories' b -> Directories' a
fmap :: forall a b. (a -> b) -> Directories' a -> Directories' b
$cfmap :: forall a b. (a -> b) -> Directories' a -> Directories' b
Functor, forall a. Eq a => a -> Directories' a -> Bool
forall a. Num a => Directories' a -> a
forall a. Ord a => Directories' a -> a
forall m. Monoid m => Directories' m -> m
forall a. Directories' a -> Bool
forall a. Directories' a -> Int
forall a. Directories' a -> [a]
forall a. (a -> a -> a) -> Directories' a -> a
forall m a. Monoid m => (a -> m) -> Directories' a -> m
forall b a. (b -> a -> b) -> b -> Directories' a -> b
forall a b. (a -> b -> b) -> b -> Directories' a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Directories' a -> a
$cproduct :: forall a. Num a => Directories' a -> a
sum :: forall a. Num a => Directories' a -> a
$csum :: forall a. Num a => Directories' a -> a
minimum :: forall a. Ord a => Directories' a -> a
$cminimum :: forall a. Ord a => Directories' a -> a
maximum :: forall a. Ord a => Directories' a -> a
$cmaximum :: forall a. Ord a => Directories' a -> a
elem :: forall a. Eq a => a -> Directories' a -> Bool
$celem :: forall a. Eq a => a -> Directories' a -> Bool
length :: forall a. Directories' a -> Int
$clength :: forall a. Directories' a -> Int
null :: forall a. Directories' a -> Bool
$cnull :: forall a. Directories' a -> Bool
toList :: forall a. Directories' a -> [a]
$ctoList :: forall a. Directories' a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Directories' a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Directories' a -> a
foldr1 :: forall a. (a -> a -> a) -> Directories' a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Directories' a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Directories' a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Directories' a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Directories' a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Directories' a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Directories' a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Directories' a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Directories' a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Directories' a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Directories' a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Directories' a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Directories' a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Directories' a -> m
fold :: forall m. Monoid m => Directories' m -> m
$cfold :: forall m. Monoid m => Directories' m -> m
Foldable, Functor Directories'
Foldable Directories'
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Directories' (m a) -> m (Directories' a)
forall (f :: * -> *) a.
Applicative f =>
Directories' (f a) -> f (Directories' a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Directories' a -> m (Directories' b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Directories' a -> f (Directories' b)
sequence :: forall (m :: * -> *) a.
Monad m =>
Directories' (m a) -> m (Directories' a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
Directories' (m a) -> m (Directories' a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Directories' a -> m (Directories' b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Directories' a -> m (Directories' b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Directories' (f a) -> f (Directories' a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Directories' (f a) -> f (Directories' a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Directories' a -> f (Directories' b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Directories' a -> f (Directories' b)
Traversable)
type Directories = Directories' FilePath
getDirectories :: IO Directories
getDirectories :: IO Directories
getDirectories = IO Directories
xmEnvDirs forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IO Directories
xmDirs forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IO Directories
xdgDirs
where
xmEnvDirs :: IO Directories
xmEnvDirs :: IO Directories
xmEnvDirs = do
let xmEnvs :: Directories
xmEnvs = Directories{ dataDir :: FilePath
dataDir = FilePath
"XMONAD_DATA_DIR"
, cfgDir :: FilePath
cfgDir = FilePath
"XMONAD_CONFIG_DIR"
, cacheDir :: FilePath
cacheDir = FilePath
"XMONAD_CACHE_DIR"
}
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. Alternative f => f a
empty forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO (Maybe FilePath)
getEnv Directories
xmEnvs
xmDirs :: IO Directories
xmDirs :: IO Directories
xmDirs = do
FilePath
xmDir <- FilePath -> IO FilePath
getAppUserDataDirectory FilePath
"xmonad"
Bool
conf <- FilePath -> IO Bool
doesFileExist forall a b. (a -> b) -> a -> b
$ FilePath
xmDir FilePath -> ShowS
</> FilePath
"xmonad.hs"
Bool
build <- FilePath -> IO Bool
doesFileExist forall a b. (a -> b) -> a -> b
$ FilePath
xmDir FilePath -> ShowS
</> FilePath
"build"
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool
conf Bool -> Bool -> Bool
|| Bool
build
forall (f :: * -> *) a. Applicative f => a -> f a
pure Directories{ dataDir :: FilePath
dataDir = FilePath
xmDir, cfgDir :: FilePath
cfgDir = FilePath
xmDir, cacheDir :: FilePath
cacheDir = FilePath
xmDir }
xdgDirs :: IO Directories
xdgDirs :: IO Directories
xdgDirs =
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Directories{ dataDir :: XdgDirectory
dataDir = XdgDirectory
XdgData, cfgDir :: XdgDirectory
cfgDir = XdgDirectory
XdgConfig, cacheDir :: XdgDirectory
cacheDir = XdgDirectory
XdgCache }
forall a b. (a -> b) -> a -> b
$ \XdgDirectory
dir -> do FilePath
d <- XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
dir FilePath
"xmonad"
FilePath
d forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
d
getXMonadDir :: X String
getXMonadDir :: X FilePath
getXMonadDir = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall a. Directories' a -> a
cfgDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> Directories
directories)
{-# DEPRECATED getXMonadDir "Use `asks (cfgDir . directories)' instead." #-}
getXMonadCacheDir :: X String
getXMonadCacheDir :: X FilePath
getXMonadCacheDir = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall a. Directories' a -> a
cacheDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> Directories
directories)
{-# DEPRECATED getXMonadCacheDir "Use `asks (cacheDir . directories)' instead." #-}
getXMonadDataDir :: X String
getXMonadDataDir :: X FilePath
getXMonadDataDir = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall a. Directories' a -> a
dataDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. XConf -> Directories
directories)
{-# DEPRECATED getXMonadDataDir "Use `asks (dataDir . directories)' instead." #-}
binFileName, buildDirName :: Directories -> FilePath
binFileName :: Directories -> FilePath
binFileName Directories{ FilePath
cacheDir :: FilePath
cacheDir :: forall a. Directories' a -> a
cacheDir } = FilePath
cacheDir FilePath -> ShowS
</> FilePath
"xmonad-" forall a. Semigroup a => a -> a -> a
<> FilePath
arch forall a. Semigroup a => a -> a -> a
<> FilePath
"-" forall a. Semigroup a => a -> a -> a
<> FilePath
os
buildDirName :: Directories -> FilePath
buildDirName Directories{ FilePath
cacheDir :: FilePath
cacheDir :: forall a. Directories' a -> a
cacheDir } = FilePath
cacheDir FilePath -> ShowS
</> FilePath
"build-" forall a. Semigroup a => a -> a -> a
<> FilePath
arch forall a. Semigroup a => a -> a -> a
<> FilePath
"-" forall a. Semigroup a => a -> a -> a
<> FilePath
os
errFileName, stateFileName :: Directories -> FilePath
errFileName :: Directories -> FilePath
errFileName Directories{ FilePath
dataDir :: FilePath
dataDir :: forall a. Directories' a -> a
dataDir } = FilePath
dataDir FilePath -> ShowS
</> FilePath
"xmonad.errors"
stateFileName :: Directories -> FilePath
stateFileName Directories{ FilePath
dataDir :: FilePath
dataDir :: forall a. Directories' a -> a
dataDir } = FilePath
dataDir FilePath -> ShowS
</> FilePath
"xmonad.state"
srcFileName, libFileName :: Directories -> FilePath
srcFileName :: Directories -> FilePath
srcFileName Directories{ FilePath
cfgDir :: FilePath
cfgDir :: forall a. Directories' a -> a
cfgDir } = FilePath
cfgDir FilePath -> ShowS
</> FilePath
"xmonad.hs"
libFileName :: Directories -> FilePath
libFileName Directories{ FilePath
cfgDir :: FilePath
cfgDir :: forall a. Directories' a -> a
cfgDir } = FilePath
cfgDir FilePath -> ShowS
</> FilePath
"lib"
buildScriptFileName, stackYamlFileName, nixFlakeFileName, nixDefaultFileName :: Directories -> FilePath
buildScriptFileName :: Directories -> FilePath
buildScriptFileName Directories{ FilePath
cfgDir :: FilePath
cfgDir :: forall a. Directories' a -> a
cfgDir } = FilePath
cfgDir FilePath -> ShowS
</> FilePath
"build"
stackYamlFileName :: Directories -> FilePath
stackYamlFileName Directories{ FilePath
cfgDir :: FilePath
cfgDir :: forall a. Directories' a -> a
cfgDir } = FilePath
cfgDir FilePath -> ShowS
</> FilePath
"stack.yaml"
nixFlakeFileName :: Directories -> FilePath
nixFlakeFileName Directories{ FilePath
cfgDir :: FilePath
cfgDir :: forall a. Directories' a -> a
cfgDir } = FilePath
cfgDir FilePath -> ShowS
</> FilePath
"flake.nix"
nixDefaultFileName :: Directories -> FilePath
nixDefaultFileName Directories{ FilePath
cfgDir :: FilePath
cfgDir :: forall a. Directories' a -> a
cfgDir } = FilePath
cfgDir FilePath -> ShowS
</> FilePath
"default.nix"
data Compile
= CompileGhc
| CompileStackGhc FilePath
| CompileNixFlake
| CompileNixDefault
| CompileScript FilePath
deriving (Int -> Compile -> ShowS
[Compile] -> ShowS
Compile -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Compile] -> ShowS
$cshowList :: [Compile] -> ShowS
show :: Compile -> FilePath
$cshow :: Compile -> FilePath
showsPrec :: Int -> Compile -> ShowS
$cshowsPrec :: Int -> Compile -> ShowS
Show)
detectCompile :: Directories -> IO Compile
detectCompile :: Directories -> IO Compile
detectCompile Directories
dirs =
IO Compile
tryScript forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IO Compile
tryStack forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IO Compile
tryNixFlake forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IO Compile
tryNixDefault forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IO Compile
useGhc
where
buildScript :: FilePath
buildScript = Directories -> FilePath
buildScriptFileName Directories
dirs
stackYaml :: FilePath
stackYaml = Directories -> FilePath
stackYamlFileName Directories
dirs
flakeNix :: FilePath
flakeNix = Directories -> FilePath
nixFlakeFileName Directories
dirs
defaultNix :: FilePath
defaultNix = Directories -> FilePath
nixDefaultFileName Directories
dirs
tryScript :: IO Compile
tryScript = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO Bool
doesFileExist FilePath
buildScript
Bool
isExe <- FilePath -> IO Bool
isExecutable FilePath
buildScript
if Bool
isExe
then do
forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace forall a b. (a -> b) -> a -> b
$ FilePath
"XMonad will use build script at " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
buildScript forall a. Semigroup a => a -> a -> a
<> FilePath
" to recompile."
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Compile
CompileScript FilePath
buildScript
else do
forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace forall a b. (a -> b) -> a -> b
$ FilePath
"XMonad will not use build script, because " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
buildScript forall a. Semigroup a => a -> a -> a
<> FilePath
" is not executable."
forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace forall a b. (a -> b) -> a -> b
$ FilePath
"Suggested resolution to use it: chmod u+x " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
buildScript
forall (f :: * -> *) a. Alternative f => f a
empty
tryNixFlake :: IO Compile
tryNixFlake = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO Bool
doesFileExist FilePath
flakeNix
FilePath
canonNixFlake <- FilePath -> IO FilePath
canonicalizePath FilePath
flakeNix
forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace forall a b. (a -> b) -> a -> b
$ FilePath
"XMonad will use nix flake at " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
canonNixFlake forall a. Semigroup a => a -> a -> a
<> FilePath
" to recompile"
forall (f :: * -> *) a. Applicative f => a -> f a
pure Compile
CompileNixFlake
tryNixDefault :: IO Compile
tryNixDefault = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO Bool
doesFileExist FilePath
defaultNix
FilePath
canonNixDefault <- FilePath -> IO FilePath
canonicalizePath FilePath
defaultNix
forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace forall a b. (a -> b) -> a -> b
$ FilePath
"XMonad will use nix file at " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
canonNixDefault forall a. Semigroup a => a -> a -> a
<> FilePath
" to recompile"
forall (f :: * -> *) a. Applicative f => a -> f a
pure Compile
CompileNixDefault
tryStack :: IO Compile
tryStack = do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO Bool
doesFileExist FilePath
stackYaml
FilePath
canonStackYaml <- FilePath -> IO FilePath
canonicalizePath FilePath
stackYaml
forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace forall a b. (a -> b) -> a -> b
$ FilePath
"XMonad will use stack ghc --stack-yaml " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
canonStackYaml forall a. Semigroup a => a -> a -> a
<> FilePath
" to recompile."
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Compile
CompileStackGhc FilePath
canonStackYaml
useGhc :: IO Compile
useGhc = do
forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace forall a b. (a -> b) -> a -> b
$ FilePath
"XMonad will use ghc to recompile, because none of "
forall a. Semigroup a => a -> a -> a
<> forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", "
[ forall a. Show a => a -> FilePath
show FilePath
buildScript
, forall a. Show a => a -> FilePath
show FilePath
stackYaml
, forall a. Show a => a -> FilePath
show FilePath
flakeNix
, forall a. Show a => a -> FilePath
show FilePath
defaultNix
] forall a. Semigroup a => a -> a -> a
<> FilePath
" exist."
forall (f :: * -> *) a. Applicative f => a -> f a
pure Compile
CompileGhc
isExecutable :: FilePath -> IO Bool
isExecutable :: FilePath -> IO Bool
isExecutable FilePath
f = forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (Permissions -> Bool
executable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Permissions
getPermissions FilePath
f) (\(SomeException e
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
shouldCompile :: Directories -> Compile -> IO Bool
shouldCompile :: Directories -> Compile -> IO Bool
shouldCompile Directories
dirs Compile
CompileGhc = do
[Maybe UTCTime]
libTs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO (Maybe UTCTime)
getModTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter FilePath -> Bool
isSource forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
allFiles (Directories -> FilePath
libFileName Directories
dirs)
Maybe UTCTime
srcT <- FilePath -> IO (Maybe UTCTime)
getModTime (Directories -> FilePath
srcFileName Directories
dirs)
Maybe UTCTime
binT <- FilePath -> IO (Maybe UTCTime)
getModTime (Directories -> FilePath
binFileName Directories
dirs)
if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe UTCTime
binT forall a. Ord a => a -> a -> Bool
<) (Maybe UTCTime
srcT forall a. a -> [a] -> [a]
: [Maybe UTCTime]
libTs)
then Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace FilePath
"XMonad recompiling because some files have changed."
else Bool
False forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace FilePath
"XMonad skipping recompile because it is not forced (e.g. via --recompile), and neither xmonad.hs nor any *.hs / *.lhs / *.hsc files in lib/ have been changed."
where
isSource :: FilePath -> Bool
isSource = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [FilePath
".hs",FilePath
".lhs",FilePath
".hsc"] forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeExtension
allFiles :: FilePath -> IO [FilePath]
allFiles FilePath
t = do
let prep :: [FilePath] -> [FilePath]
prep = forall a b. (a -> b) -> [a] -> [b]
map (FilePath
tFilePath -> ShowS
</>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath
".",FilePath
".."])
[FilePath]
cs <- [FilePath] -> [FilePath]
prep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (FilePath -> IO [FilePath]
getDirectoryContents FilePath
t) (\(SomeException e
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return [])
[FilePath]
ds <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesDirectoryExist [FilePath]
cs
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([FilePath]
cs forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
ds)forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO [FilePath]
allFiles [FilePath]
ds
shouldCompile Directories
dirs CompileStackGhc{} = do
Maybe UTCTime
stackYamlT <- FilePath -> IO (Maybe UTCTime)
getModTime (Directories -> FilePath
stackYamlFileName Directories
dirs)
Maybe UTCTime
binT <- FilePath -> IO (Maybe UTCTime)
getModTime (Directories -> FilePath
binFileName Directories
dirs)
if Maybe UTCTime
binT forall a. Ord a => a -> a -> Bool
< Maybe UTCTime
stackYamlT
then Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace FilePath
"XMonad recompiling because some files have changed."
else Directories -> Compile -> IO Bool
shouldCompile Directories
dirs Compile
CompileGhc
shouldCompile Directories
_dirs CompileNixFlake{} = Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace FilePath
"XMonad recompiling because flake recompilation is being used."
shouldCompile Directories
_dirs CompileNixDefault{} = Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace FilePath
"XMonad recompiling because nix recompilation is being used."
shouldCompile Directories
_dirs CompileScript{} =
Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace FilePath
"XMonad recompiling because a custom build script is being used."
getModTime :: FilePath -> IO (Maybe UTCTime)
getModTime :: FilePath -> IO (Maybe UTCTime)
getModTime FilePath
f = forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO UTCTime
getModificationTime FilePath
f) (\(SomeException e
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
compile :: Directories -> Compile -> IO ExitCode
compile :: Directories -> Compile -> IO ExitCode
compile Directories
dirs Compile
method =
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ forall (m :: * -> *). MonadIO m => m ()
uninstallSignalHandlers forall (m :: * -> *). MonadIO m => m ()
installSignalHandlers forall a b. (a -> b) -> a -> b
$
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile (Directories -> FilePath
errFileName Directories
dirs) IOMode
WriteMode forall a b. (a -> b) -> a -> b
$ \Handle
err -> do
let run :: FilePath -> [FilePath] -> IO ExitCode
run = FilePath -> Handle -> FilePath -> [FilePath] -> IO ExitCode
runProc (forall a. Directories' a -> a
cfgDir Directories
dirs) Handle
err
case Compile
method of
Compile
CompileGhc -> do
FilePath
ghc <- forall a. a -> Maybe a -> a
fromMaybe FilePath
"ghc" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"XMONAD_GHC"
FilePath -> [FilePath] -> IO ExitCode
run FilePath
ghc [FilePath]
ghcArgs
CompileStackGhc FilePath
stackYaml ->
FilePath -> [FilePath] -> IO ExitCode
run FilePath
"stack" [FilePath
"build", FilePath
"--silent", FilePath
"--stack-yaml", FilePath
stackYaml] forall {m :: * -> *}.
Monad m =>
m ExitCode -> m ExitCode -> m ExitCode
.&&.
FilePath -> [FilePath] -> IO ExitCode
run FilePath
"stack" (FilePath
"ghc" forall a. a -> [a] -> [a]
: FilePath
"--stack-yaml" forall a. a -> [a] -> [a]
: FilePath
stackYaml forall a. a -> [a] -> [a]
: FilePath
"--" forall a. a -> [a] -> [a]
: [FilePath]
ghcArgs)
Compile
CompileNixFlake ->
FilePath -> [FilePath] -> IO ExitCode
run FilePath
"nix" [FilePath
"build"] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExitCode -> IO ExitCode
andCopyFromResultDir
Compile
CompileNixDefault ->
FilePath -> [FilePath] -> IO ExitCode
run FilePath
"nix-build" [] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExitCode -> IO ExitCode
andCopyFromResultDir
CompileScript FilePath
script ->
FilePath -> [FilePath] -> IO ExitCode
run FilePath
script [Directories -> FilePath
binFileName Directories
dirs]
where
ghcArgs :: [FilePath]
ghcArgs = [ FilePath
"--make"
, FilePath
"xmonad.hs"
, FilePath
"-i"
, FilePath
"-ilib"
, FilePath
"-fforce-recomp"
, FilePath
"-main-is", FilePath
"main"
, FilePath
"-v0"
, FilePath
"-outputdir", Directories -> FilePath
buildDirName Directories
dirs
, FilePath
"-o", Directories -> FilePath
binFileName Directories
dirs
]
andCopyFromResultDir :: ExitCode -> IO ExitCode
andCopyFromResultDir ExitCode
exitCode = do
if ExitCode
exitCode forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess then IO ExitCode
copyFromResultDir else forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
exitCode
findM :: (a -> m Bool) -> t a -> m (Maybe a)
findM a -> m Bool
p = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x -> forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (a -> m Bool
p a
x) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
x)) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)
catchAny :: IO a -> (SomeException -> IO a) -> IO a
catchAny :: forall a. IO a -> (SomeException -> IO a) -> IO a
catchAny = forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
copyFromResultDir :: IO ExitCode
copyFromResultDir = do
let binaryDirectory :: FilePath
binaryDirectory = forall a. Directories' a -> a
cfgDir Directories
dirs FilePath -> ShowS
</> FilePath
"result" FilePath -> ShowS
</> FilePath
"bin"
[FilePath]
binFiles <- forall a b. (a -> b) -> [a] -> [b]
map (FilePath
binaryDirectory FilePath -> ShowS
</>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IO a -> (SomeException -> IO a) -> IO a
catchAny (FilePath -> IO [FilePath]
listDirectory FilePath
binaryDirectory) (\SomeException
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [])
Maybe FilePath
mfilepath <- forall {t :: * -> *} {m :: * -> *} {a}.
(Foldable t, Monad m) =>
(a -> m Bool) -> t a -> m (Maybe a)
findM FilePath -> IO Bool
isExecutable [FilePath]
binFiles
case Maybe FilePath
mfilepath of
Just FilePath
filepath -> FilePath -> FilePath -> IO ()
copyFile FilePath
filepath (Directories -> FilePath
binFileName Directories
dirs) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess
Maybe FilePath
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
1
runProc :: FilePath -> Handle -> FilePath -> [FilePath] -> IO ExitCode
runProc FilePath
cwd Handle
err FilePath
exe [FilePath]
args = do
Handle -> FilePath -> IO ()
hPutStrLn Handle
err forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords forall a b. (a -> b) -> a -> b
$ FilePath
"$" forall a. a -> [a] -> [a]
: FilePath
exe forall a. a -> [a] -> [a]
: [FilePath]
args
Handle -> IO ()
hFlush Handle
err
(Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
h) <- FilePath
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ FilePath
"runProc" (FilePath -> [FilePath] -> CreateProcess
proc FilePath
exe [FilePath]
args){ cwd :: Maybe FilePath
cwd = forall a. a -> Maybe a
Just FilePath
cwd, std_err :: StdStream
std_err = Handle -> StdStream
UseHandle Handle
err }
ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
h
m ExitCode
cmd1 .&&. :: m ExitCode -> m ExitCode -> m ExitCode
.&&. m ExitCode
cmd2 = m ExitCode
cmd1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ExitCode
ExitSuccess -> m ExitCode
cmd2
ExitCode
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ExitCode
e
checkCompileWarnings :: Directories -> IO ()
checkCompileWarnings :: Directories -> IO ()
checkCompileWarnings Directories
dirs = do
FilePath
ghcErr <- FilePath -> IO FilePath
readFile (Directories -> FilePath
errFileName Directories
dirs)
if FilePath
"-Wdeprecations" forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` FilePath
ghcErr
then do
let msg :: FilePath
msg = [FilePath] -> FilePath
unlines forall a b. (a -> b) -> a -> b
$
[FilePath
"Deprecations detected while compiling xmonad config: " forall a. Semigroup a => a -> a -> a
<> Directories -> FilePath
srcFileName Directories
dirs]
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath]
lines FilePath
ghcErr
forall a. [a] -> [a] -> [a]
++ [FilePath
"",FilePath
"Please correct them or silence using {-# OPTIONS_GHC -Wno-deprecations #-}."]
forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace FilePath
msg
forall (m :: * -> *). MonadIO m => FilePath -> m ()
xmessage FilePath
msg
else
forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace FilePath
"XMonad recompilation process exited with success!"
compileFailed :: Directories -> ExitCode -> IO ()
compileFailed :: Directories -> ExitCode -> IO ()
compileFailed Directories
dirs ExitCode
status = do
FilePath
ghcErr <- FilePath -> IO FilePath
readFile (Directories -> FilePath
errFileName Directories
dirs)
let msg :: FilePath
msg = [FilePath] -> FilePath
unlines forall a b. (a -> b) -> a -> b
$
[FilePath
"Errors detected while compiling xmonad config: " forall a. Semigroup a => a -> a -> a
<> Directories -> FilePath
srcFileName Directories
dirs]
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath]
lines (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
ghcErr then forall a. Show a => a -> FilePath
show ExitCode
status else FilePath
ghcErr)
forall a. [a] -> [a] -> [a]
++ [FilePath
"",FilePath
"Please check the file for errors."]
forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace FilePath
msg
forall (m :: * -> *). MonadIO m => FilePath -> m ()
xmessage FilePath
msg
recompile :: MonadIO m => Directories -> Bool -> m Bool
recompile :: forall (m :: * -> *). MonadIO m => Directories -> Bool -> m Bool
recompile Directories
dirs Bool
force = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
Compile
method <- Directories -> IO Compile
detectCompile Directories
dirs
Bool
willCompile <- if Bool
force
then Bool
True forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace FilePath
"XMonad recompiling (forced)."
else Directories -> Compile -> IO Bool
shouldCompile Directories
dirs Compile
method
if Bool
willCompile
then do
ExitCode
status <- Directories -> Compile -> IO ExitCode
compile Directories
dirs Compile
method
if ExitCode
status forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
then Directories -> IO ()
checkCompileWarnings Directories
dirs
else Directories -> ExitCode -> IO ()
compileFailed Directories
dirs ExitCode
status
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ExitCode
status forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess
else
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust :: forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
mg a -> m ()
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) a -> m ()
f Maybe a
mg
whenX :: X Bool -> X () -> X ()
whenX :: X Bool -> X () -> X ()
whenX X Bool
a X ()
f = X Bool
a forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b X ()
f
trace :: MonadIO m => String -> m ()
trace :: forall (m :: * -> *). MonadIO m => FilePath -> m ()
trace = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr
installSignalHandlers :: MonadIO m => m ()
installSignalHandlers :: forall (m :: * -> *). MonadIO m => m ()
installSignalHandlers = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
openEndedPipe Handler
Ignore forall a. Maybe a
Nothing
Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
sigCHLD Handler
Ignore forall a. Maybe a
Nothing
(forall e a. Exception e => IO a -> IO (Either e a)
try :: IO a -> IO (Either SomeException a))
forall a b. (a -> b) -> a -> b
$ forall a. (a -> a) -> a
fix forall a b. (a -> b) -> a -> b
$ \IO ()
more -> do
Maybe (ProcessID, ProcessStatus)
x <- Bool -> Bool -> IO (Maybe (ProcessID, ProcessStatus))
getAnyProcessStatus Bool
False Bool
False
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe (ProcessID, ProcessStatus)
x) IO ()
more
forall (m :: * -> *) a. Monad m => a -> m a
return ()
uninstallSignalHandlers :: MonadIO m => m ()
uninstallSignalHandlers :: forall (m :: * -> *). MonadIO m => m ()
uninstallSignalHandlers = forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ do
Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
openEndedPipe Handler
Default forall a. Maybe a
Nothing
Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
sigCHLD Handler
Default forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return ()