{-# LANGUAGE OverloadedStrings #-}

module System.Linux.Proc.Process
  ( ProcessId (..)
  , getProcProcessIds
  ) where

import           Control.Error (runExceptT)

import           Data.Maybe (mapMaybe)

import           System.Linux.Proc.IO
import           System.Linux.Proc.Errors

import           Text.Read (readMaybe)

newtype ProcessId
  = ProcessId { ProcessId -> Int
unProcessId :: Int }
  deriving (ProcessId -> ProcessId -> Bool
(ProcessId -> ProcessId -> Bool)
-> (ProcessId -> ProcessId -> Bool) -> Eq ProcessId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProcessId -> ProcessId -> Bool
$c/= :: ProcessId -> ProcessId -> Bool
== :: ProcessId -> ProcessId -> Bool
$c== :: ProcessId -> ProcessId -> Bool
Eq, Int -> ProcessId -> ShowS
[ProcessId] -> ShowS
ProcessId -> String
(Int -> ProcessId -> ShowS)
-> (ProcessId -> String)
-> ([ProcessId] -> ShowS)
-> Show ProcessId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProcessId] -> ShowS
$cshowList :: [ProcessId] -> ShowS
show :: ProcessId -> String
$cshow :: ProcessId -> String
showsPrec :: Int -> ProcessId -> ShowS
$cshowsPrec :: Int -> ProcessId -> ShowS
Show)

-- | Get the current list of `ProcessId`s.
getProcProcessIds :: IO (Either ProcError [ProcessId])
getProcProcessIds :: IO (Either ProcError [ProcessId])
getProcProcessIds =
  ExceptT ProcError IO [ProcessId]
-> IO (Either ProcError [ProcessId])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ProcError IO [ProcessId]
 -> IO (Either ProcError [ProcessId]))
-> ExceptT ProcError IO [ProcessId]
-> IO (Either ProcError [ProcessId])
forall a b. (a -> b) -> a -> b
$
    (String -> Maybe ProcessId) -> [String] -> [ProcessId]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Int -> ProcessId) -> Maybe Int -> Maybe ProcessId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> ProcessId
ProcessId (Maybe Int -> Maybe ProcessId)
-> (String -> Maybe Int) -> String -> Maybe ProcessId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe) ([String] -> [ProcessId])
-> ExceptT ProcError IO [String]
-> ExceptT ProcError IO [ProcessId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ExceptT ProcError IO [String]
listProcDirectory String
"/proc"