    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE ViewPatterns #-}

    -- |
    -- Module      :  XMonad.Util.Process
    -- Description :  Utilities for unix processes.
    -- Copyright   :  (c) 2022 Tomáš Janoušek <tomi@nomi.cz>
    -- License     :  BSD3
    -- Maintainer  :  Tomáš Janoušek <tomi@nomi.cz>
    --
    -- This module should not be directly used by users, it's just common code for
    -- other modules.
    --
    module XMonad.Util.Process (
        getPPIDOf,
        getPPIDChain,
        ) where

    import Control.Exception (SomeException, handle)
    import System.Posix.Types (ProcessID)
    import qualified Data.ByteString.Char8 as B

    import XMonad.Prelude (fi)

    -- | Get the parent process id (PPID) of a given process.
    getPPIDOf :: ProcessID -> IO (Maybe ProcessID)
    getPPIDOf :: ProcessID -> IO (Maybe ProcessID)
    getPPIDOf ProcessID
    pid =
        (SomeException -> IO (Maybe ProcessID))
    -> IO (Maybe ProcessID) -> IO (Maybe ProcessID)
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
    handle
            (\(SomeException
    _ :: SomeException) -> Maybe ProcessID -> IO (Maybe ProcessID)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe ProcessID
    forall a. Maybe a
    Nothing)
            (ByteString -> Maybe ProcessID
    forall {a}. Num a => ByteString -> Maybe a
    parse (ByteString -> Maybe ProcessID)
    -> IO ByteString -> IO (Maybe ProcessID)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FilePath -> IO ByteString
    B.readFile (FilePath
    "/proc/" FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> ProcessID -> FilePath
    forall a. Show a => a -> FilePath
    show ProcessID
    pid FilePath -> FilePath -> FilePath
    forall a. Semigroup a => a -> a -> a
    <> FilePath
    "/stat"))
      where
        -- Parse PPID out of /proc/*/stat, being careful not to trip over
        -- processes with names like ":-) 1 2 3 4 5 6".
        -- Inspired by https://gitlab.com/procps-ng/procps/-/blob/bcce3e440a1e1ee130c7371251a39c031519336a/proc/readproc.c#L561
        parse :: ByteString -> Maybe a
    parse ByteString
    stat = case ByteString -> [ByteString]
    B.words (ByteString -> [ByteString]) -> ByteString -> [ByteString]
    forall a b. (a -> b) -> a -> b
    $ (ByteString, ByteString) -> ByteString
    forall a b. (a, b) -> b
    snd ((ByteString, ByteString) -> ByteString)
    -> (ByteString, ByteString) -> ByteString
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> ByteString -> (ByteString, ByteString)
    B.spanEnd (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ')') ByteString
    stat of
            ByteString
    _ : (ByteString -> Maybe (Int, ByteString)
    B.readInt -> Just (Int
    ppid, ByteString
    ""))  : [ByteString]
    _ -> a -> Maybe a
    forall a. a -> Maybe a
    Just (Int -> a
    forall a b. (Integral a, Num b) => a -> b
    fi Int
    ppid)
            [ByteString]
    _ -> Maybe a
    forall a. Maybe a
    Nothing

    -- | Get the chain of parent processes of a given pid. Starts with the given
    -- pid and continues up until the parent of all.
    getPPIDChain :: ProcessID -> IO [ProcessID]
    getPPIDChain :: ProcessID -> IO [ProcessID]
    getPPIDChain ProcessID
    pid = (ProcessID
    pid ProcessID -> [ProcessID] -> [ProcessID]
    forall a. a -> [a] -> [a]
    :) ([ProcessID] -> [ProcessID]) -> IO [ProcessID] -> IO [ProcessID]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (IO [ProcessID]
    -> (ProcessID -> IO [ProcessID])
    -> Maybe ProcessID
    -> IO [ProcessID]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ([ProcessID] -> IO [ProcessID]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure []) ProcessID -> IO [ProcessID]
    getPPIDChain (Maybe ProcessID -> IO [ProcessID])
    -> IO (Maybe ProcessID) -> IO [ProcessID]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ProcessID -> IO (Maybe ProcessID)
    getPPIDOf ProcessID
    pid)