{-# 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 =
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle
        (\(SomeException
_ :: SomeException) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)
        (forall {a}. Num a => ByteString -> Maybe a
parse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
B.readFile (FilePath
"/proc/" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show ProcessID
pid 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 forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> (ByteString, ByteString)
B.spanEnd (forall a. Eq a => a -> a -> Bool
/= Char
')') ByteString
stat of
        ByteString
_ : (ByteString -> Maybe (Int, ByteString)
B.readInt -> Just (Int
ppid, ByteString
""))  : [ByteString]
_ -> forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fi Int
ppid)
        [ByteString]
_ -> 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 forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure []) ProcessID -> IO [ProcessID]
getPPIDChain forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProcessID -> IO (Maybe ProcessID)
getPPIDOf ProcessID
pid)