module SocketActivation.GetFileDescriptors where

import Essentials

import Data.Either (Either)
import Data.List (take)
import Prelude (fromIntegral)
import System.IO (IO)

import SocketActivation.Concepts (Fd (..), Error, Count (countNat))
import SocketActivation.Env (getEnv')
import SocketActivation.IO (IO' (IO', run))

{-| Get a list of file descriptors for the sockets -}
getFileDescriptorList :: IO (Either Error [Fd])
getFileDescriptorList :: IO (Either Error [Fd])
getFileDescriptorList = IO' [Fd] -> IO (Either Error [Fd])
forall a. IO' a -> IO (Either Error a)
run (IO' [Fd] -> IO (Either Error [Fd]))
-> IO' [Fd] -> IO (Either Error [Fd])
forall a b. (a -> b) -> a -> b
$ IO (Either Error Count) -> IO' Count
forall a. IO (Either Error a) -> IO' a
IO' (forall a. Env' a => IO (Either Error a)
getEnv' @Count) IO' Count -> (Count -> [Fd]) -> IO' [Fd]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Count -> [Fd]
fds

fds :: Count -> [Fd]
fds :: Count -> [Fd]
fds Count
n = Int -> [Fd] -> [Fd]
forall a. Int -> [a] -> [a]
take (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Count -> Natural
countNat Count
n)) [CInt -> Fd
Fd CInt
3 ..]