{-# LANGUAGE CPP #-}

------------------------------------------------------------------------------
-- |
-- Module: Xmobar.App.Compile
-- Copyright: (c) 2018 Jose Antonio Ortega Ruiz
-- License: BSD3-style (see LICENSE)
--
-- Maintainer: jao@gnu.org
-- Stability: unstable
-- Portability: portable
-- Created: Mon Nov 26, 2018 03:36
--
--
-- Utlities to compile xmobar executables on the fly
--
------------------------------------------------------------------------------


module Xmobar.App.Compile(recompile, trace, xmessage) where

import Control.Monad.IO.Class
import Control.Monad.Fix (fix)
import Control.Exception.Extensible (try, bracket, SomeException(..))
import qualified Control.Exception.Extensible as E
import Control.Monad (filterM, when)
import Data.List ((\\))
import Data.Maybe (isJust)
import System.FilePath((</>), takeExtension)
import System.IO
import System.Directory
import System.Process
import System.Exit
import System.Posix.Process(executeFile, forkProcess, getAnyProcessStatus)
import System.Posix.Types(ProcessID)
import System.Posix.Signals

isExecutable :: FilePath -> IO Bool
isExecutable :: FilePath -> IO Bool
isExecutable FilePath
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
<$> FilePath -> IO Permissions
getPermissions FilePath
f) (\(SomeException e
_) -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

checkBuildScript :: Bool -> FilePath -> IO Bool
checkBuildScript :: Bool -> FilePath -> IO Bool
checkBuildScript Bool
verb FilePath
buildscript = do
  Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
buildscript
  if Bool
exists
    then do
      Bool
isExe <- FilePath -> IO Bool
isExecutable FilePath
buildscript
      if Bool
isExe
        then do
          Bool -> FilePath -> IO ()
forall (m :: * -> *). MonadIO m => Bool -> FilePath -> m ()
trace Bool
verb (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Xmobar will use build script at "
                       FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
buildscript FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" to recompile."
          Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        else do
          Bool -> FilePath -> IO ()
forall (m :: * -> *). MonadIO m => Bool -> FilePath -> m ()
trace Bool
verb (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unlines
            [ FilePath
"Xmobar will not use build script, because "
              FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
buildscript FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" is not executable."
            , FilePath
"Suggested resolution to use it: chmod u+x "
              FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
buildscript
            ]
          Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    else do
      Bool -> FilePath -> IO ()
forall (m :: * -> *). MonadIO m => Bool -> FilePath -> m ()
trace Bool
verb (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Xmobar will use ghc to recompile, because "
                   FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
buildscript FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" does not exist."
      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

shouldRecompile :: Bool -> FilePath -> FilePath -> FilePath -> IO Bool
shouldRecompile :: Bool -> FilePath -> FilePath -> FilePath -> IO Bool
shouldRecompile Bool
verb FilePath
src FilePath
bin FilePath
lib = do
  [Maybe UTCTime]
libTs <- (FilePath -> IO (Maybe UTCTime))
-> [FilePath] -> IO [Maybe UTCTime]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO (Maybe UTCTime)
getModTime ([FilePath] -> IO [Maybe UTCTime])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> IO [Maybe UTCTime]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isSource ([FilePath] -> IO [Maybe UTCTime])
-> IO [FilePath] -> IO [Maybe UTCTime]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
allFiles FilePath
lib
  Maybe UTCTime
srcT <- FilePath -> IO (Maybe UTCTime)
getModTime FilePath
src
  Maybe UTCTime
binT <- FilePath -> IO (Maybe UTCTime)
getModTime FilePath
bin
  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
      Bool -> FilePath -> IO ()
forall (m :: * -> *). MonadIO m => Bool -> FilePath -> m ()
trace Bool
verb FilePath
"Xmobar recompiling because some files have changed."
      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    else do
      Bool -> FilePath -> IO ()
forall (m :: * -> *). MonadIO m => Bool -> FilePath -> m ()
trace Bool
verb (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
"Xmobar skipping recompile because it is not forced "
                   FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"(e.g. via --recompile), and not any *.hs / *.lhs / *.hsc"
                   FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" files in lib/ have been changed."
      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  where isSource :: FilePath -> Bool
isSource = (FilePath -> [FilePath] -> Bool) -> [FilePath] -> FilePath -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [FilePath
".hs",FilePath
".lhs",FilePath
".hsc"] (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtension
        allFiles :: FilePath -> IO [FilePath]
allFiles FilePath
t = do
            let prep :: [FilePath] -> [FilePath]
prep = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
tFilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [FilePath
".",FilePath
".."])
            [FilePath]
cs <- [FilePath] -> [FilePath]
prep ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [FilePath] -> (SomeException -> IO [FilePath]) -> IO [FilePath]
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (FilePath -> IO [FilePath]
getDirectoryContents FilePath
t)
                                   (\(SomeException e
_) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
            [FilePath]
ds <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesDirectoryExist [FilePath]
cs
            [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath])
-> ([[FilePath]] -> [[FilePath]]) -> [[FilePath]] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([FilePath]
cs [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
ds)[FilePath] -> [[FilePath]] -> [[FilePath]]
forall a. a -> [a] -> [a]
:) ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO [FilePath]
allFiles [FilePath]
ds
        getModTime :: FilePath -> IO (Maybe UTCTime)
getModTime FilePath
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
<$> FilePath -> IO UTCTime
getModificationTime FilePath
f)
                               (\(SomeException e
_) -> Maybe UTCTime -> IO (Maybe UTCTime)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe UTCTime
forall a. Maybe a
Nothing)

runProc :: FilePath -> [String] -> FilePath -> Handle -> IO ProcessHandle
runProc :: FilePath -> [FilePath] -> FilePath -> Handle -> IO ProcessHandle
runProc FilePath
bin [FilePath]
args FilePath
dir Handle
eh =
  FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> IO ProcessHandle
runProcess FilePath
bin [FilePath]
args (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
dir) Maybe [(FilePath, FilePath)]
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
eh)

xmessage :: String -> IO System.Posix.Types.ProcessID
xmessage :: FilePath -> IO ProcessID
xmessage FilePath
msg = IO () -> IO ProcessID
forkProcess (IO () -> IO ProcessID) -> IO () -> IO ProcessID
forall a b. (a -> b) -> a -> b
$
  FilePath
-> Bool -> [FilePath] -> Maybe [(FilePath, FilePath)] -> IO ()
forall a.
FilePath
-> Bool -> [FilePath] -> Maybe [(FilePath, FilePath)] -> IO a
executeFile FilePath
"xmessage" Bool
True [FilePath
"-default", FilePath
"okay", FilePath -> FilePath
replaceUnicode FilePath
msg] Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
  where -- Replace some of the unicode symbols GHC uses in its output
        replaceUnicode :: FilePath -> FilePath
replaceUnicode = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> FilePath -> FilePath)
-> (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ \Char
c -> case Char
c of
         Char
'\8226' -> Char
'*'  -- •
         Char
'\8216' -> Char
'`'  -- ‘
         Char
'\8217' -> Char
'`'  -- ’
         Char
_ -> Char
c

ghcErrorMsg :: (Monad m, Show a) => String -> a -> String -> m String
ghcErrorMsg :: FilePath -> a -> FilePath -> m FilePath
ghcErrorMsg FilePath
src a
status FilePath
ghcErr = FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> m FilePath)
-> ([FilePath] -> FilePath) -> [FilePath] -> m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unlines ([FilePath] -> m FilePath) -> [FilePath] -> m FilePath
forall a b. (a -> b) -> a -> b
$
  [FilePath
"Error detected while loading xmobar configuration file: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
src]
  [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath]
lines (if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
ghcErr then a -> FilePath
forall a. Show a => a -> FilePath
show a
status else FilePath
ghcErr)
  [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"",FilePath
"Please check the file for errors."]

-- | A 'trace' for the 'X' monad. Logs a string to stderr. The result may
-- be found in your .xsession-errors file
trace :: MonadIO m => Bool -> String -> m ()
trace :: Bool -> FilePath -> m ()
trace Bool
verb FilePath
msg = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verb (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
msg)

-- | 'recompile force', recompile the xmobar configuration file when
-- any of the following apply:
--
--      * force is 'True'
--
--      * the execName executable does not exist
--
--      * the xmobar executable is older than .hs or any file in
--        the @lib@ directory (under the configuration directory).
--
-- The -i flag is used to restrict recompilation to the xmobar.hs file only,
-- and any files in the aforementioned @lib@ directory.
--
-- Compilation errors (if any) are logged to the @xmobar.errors@ file
-- in the given directory.  If GHC indicates failure with a
-- non-zero exit code, an xmessage displaying that file is spawned.
--
-- 'False' is returned if there are compilation errors.
--
recompile :: MonadIO m => String -> String -> String -> Bool -> Bool -> m Bool
recompile :: FilePath -> FilePath -> FilePath -> Bool -> Bool -> m Bool
recompile FilePath
confDir FilePath
dataDir FilePath
execName Bool
force Bool
verb = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    let bin :: FilePath
bin  = FilePath
confDir FilePath -> FilePath -> FilePath
</> FilePath
execName
        err :: FilePath
err  = FilePath
dataDir FilePath -> FilePath -> FilePath
</> (FilePath
execName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".errors")
        src :: FilePath
src  = FilePath
confDir FilePath -> FilePath -> FilePath
</> (FilePath
execName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".hs")
        lib :: FilePath
lib  = FilePath
confDir FilePath -> FilePath -> FilePath
</> FilePath
"lib"
        script :: FilePath
script = FilePath
confDir FilePath -> FilePath -> FilePath
</> FilePath
"build"
    Bool
useScript <- Bool -> FilePath -> IO Bool
checkBuildScript Bool
verb FilePath
script
    Bool
sc <- if Bool
useScript Bool -> Bool -> Bool
|| Bool
force
          then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          else Bool -> FilePath -> FilePath -> FilePath -> IO Bool
shouldRecompile Bool
verb FilePath
src FilePath
bin FilePath
lib
    if Bool
sc
      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 (FilePath -> IOMode -> IO Handle
openFile FilePath
err IOMode
WriteMode) Handle -> IO ()
hClose ((Handle -> IO ExitCode) -> IO ExitCode)
-> (Handle -> IO ExitCode) -> IO ExitCode
forall a b. (a -> b) -> a -> b
$
                    \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
useScript
                        then FilePath -> FilePath -> FilePath -> Handle -> IO ProcessHandle
runScript FilePath
script FilePath
bin FilePath
confDir Handle
errHandle
                        else FilePath -> FilePath -> Handle -> IO ProcessHandle
runGHC FilePath
bin FilePath
confDir 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 Bool -> FilePath -> IO ()
forall (m :: * -> *). MonadIO m => Bool -> FilePath -> m ()
trace Bool
verb FilePath
"Xmobar recompilation process exited with success!"
            else do
                FilePath
msg <- FilePath -> IO FilePath
readFile FilePath
err IO FilePath -> (FilePath -> IO FilePath) -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> ExitCode -> FilePath -> IO FilePath
forall (m :: * -> *) a.
(Monad m, Show a) =>
FilePath -> a -> FilePath -> m FilePath
ghcErrorMsg FilePath
src ExitCode
status
                Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
msg
                ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
1)
        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 opts :: FilePath -> [FilePath]
opts FilePath
bin = [FilePath
"--make" , FilePath
execName FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
".hs" , FilePath
"-i" , FilePath
"-ilib"
                  , FilePath
"-fforce-recomp" , FilePath
"-main-is", FilePath
"main" , FilePath
"-v0"]
#ifdef THREADED_RUNTIME
                  ++ ["-threaded"]
#endif
#ifdef RTSOPTS
                  [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"-rtsopts", FilePath
"-with-rtsopts", FilePath
"-V0"]
#endif
                  [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"-o", FilePath
bin]
       runGHC :: FilePath -> FilePath -> Handle -> IO ProcessHandle
runGHC FilePath
bin = FilePath -> [FilePath] -> FilePath -> Handle -> IO ProcessHandle
runProc FilePath
"ghc" (FilePath -> [FilePath]
opts FilePath
bin)
       runScript :: FilePath -> FilePath -> FilePath -> Handle -> IO ProcessHandle
runScript FilePath
script FilePath
bin = FilePath -> [FilePath] -> FilePath -> Handle -> IO ProcessHandle
runProc FilePath
script [FilePath
bin]

-- | Ignore SIGPIPE to avoid termination when a pipe is full, and SIGCHLD to
-- avoid zombie processes, and clean up any extant zombie processes.
installSignalHandlers :: MonadIO m => m ()
installSignalHandlers :: m ()
installSignalHandlers = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (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
$ \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
liftIO (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 ()