module XMonad.Util.EntryHelper.Util
( safeIO
, safeIO'
, isHaskellSourceFile
, allFiles
, sendRestart
) where
import Control.Applicative
import Control.Monad
import Control.Exception.Extensible
import System.Directory
import System.FilePath
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras
import Data.List
safeIO :: a -> IO a -> IO a
safeIO def action =
catch action (\(SomeException _) -> return def)
safeIO' :: IO a -> IO (Maybe a)
safeIO' action = safeIO Nothing (Just <$> action)
isHaskellSourceFile :: FilePath -> Bool
isHaskellSourceFile = (`elem` words ".hs .lhs .hsc") . takeExtension
allFiles :: FilePath -> IO [FilePath]
allFiles t = do
let prep = map (t </>) . filter (`notElem` [".", ".."])
cs <- prep <$> safeIO [] (getDirectoryContents t)
ds <- filterM doesDirectoryExist cs
concat . ((cs \\ ds):) <$> mapM allFiles ds
sendRestart :: IO ()
sendRestart = do
dpy <- openDisplay ""
rw <- rootWindow dpy $ defaultScreen dpy
xmonad_restart <- internAtom dpy "XMONAD_RESTART" False
allocaXEvent $ \e -> do
setEventType e clientMessage
setClientMessageEvent e rw xmonad_restart 32 0 currentTime
sendEvent dpy rw False structureNotifyMask e
sync dpy False