{-# 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)