module SocketActivation.GetByName where

import Essentials

import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Either (Either)
import Data.List (zip)
import Data.Map (Map)
import System.IO (IO)

import qualified Data.Map as Map

import SocketActivation.Concepts
    (Socket, Fd, Error (NoSuchName), Names (namesList), Name)
import SocketActivation.Env (getEnv')
import SocketActivation.GetFileDescriptors (getFileDescriptorList)
import SocketActivation.GetSockets (getSocketList, fdSocket)
import SocketActivation.IO (IO' (IO', run), throwError)

getNameList :: IO (Either Error [Name])
getNameList :: IO (Either Error [Name])
getNameList = IO' [Name] -> IO (Either Error [Name])
forall a. IO' a -> IO (Either Error a)
run (IO' [Name] -> IO (Either Error [Name]))
-> IO' [Name] -> IO (Either Error [Name])
forall a b. (a -> b) -> a -> b
$ IO (Either Error Names) -> IO' Names
forall a. IO (Either Error a) -> IO' a
IO' (forall a. Env' a => IO (Either Error a)
getEnv' @Names) IO' Names -> (Names -> [Name]) -> IO' [Name]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Names -> [Name]
namesList

getFileDescriptorMap :: IO (Either Error (Map Name Fd))
getFileDescriptorMap :: IO (Either Error (Map Name Fd))
getFileDescriptorMap = IO' (Map Name Fd) -> IO (Either Error (Map Name Fd))
forall a. IO' a -> IO (Either Error a)
run (IO' (Map Name Fd) -> IO (Either Error (Map Name Fd)))
-> IO' (Map Name Fd) -> IO (Either Error (Map Name Fd))
forall a b. (a -> b) -> a -> b
$ IO' [(Name, Fd)]
entries IO' [(Name, Fd)]
-> ([(Name, Fd)] -> Map Name Fd) -> IO' (Map Name Fd)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [(Name, Fd)] -> Map Name Fd
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
  where
    entries :: IO' [(Name, Fd)]
entries = [Name] -> [Fd] -> [(Name, Fd)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Name] -> [Fd] -> [(Name, Fd)])
-> IO' [Name] -> IO' ([Fd] -> [(Name, Fd)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either Error [Name]) -> IO' [Name]
forall a. IO (Either Error a) -> IO' a
IO' IO (Either Error [Name])
getNameList IO' ([Fd] -> [(Name, Fd)]) -> IO' [Fd] -> IO' [(Name, Fd)]
forall a b. IO' (a -> b) -> IO' a -> IO' b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (Either Error [Fd]) -> IO' [Fd]
forall a. IO (Either Error a) -> IO' a
IO' IO (Either Error [Fd])
getFileDescriptorList

getSocketMap :: IO (Either Error (Map Name Socket))
getSocketMap :: IO (Either Error (Map Name Socket))
getSocketMap = IO' (Map Name Socket) -> IO (Either Error (Map Name Socket))
forall a. IO' a -> IO (Either Error a)
run (IO' [(Name, Socket)]
entries IO' [(Name, Socket)]
-> ([(Name, Socket)] -> Map Name Socket) -> IO' (Map Name Socket)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [(Name, Socket)] -> Map Name Socket
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList)
  where
    entries :: IO' [(Name, Socket)]
entries = [Name] -> [Socket] -> [(Name, Socket)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Name] -> [Socket] -> [(Name, Socket)])
-> IO' [Name] -> IO' ([Socket] -> [(Name, Socket)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either Error [Name]) -> IO' [Name]
forall a. IO (Either Error a) -> IO' a
IO' IO (Either Error [Name])
getNameList IO' ([Socket] -> [(Name, Socket)])
-> IO' [Socket] -> IO' [(Name, Socket)]
forall a b. IO' (a -> b) -> IO' a -> IO' b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (Either Error [Socket]) -> IO' [Socket]
forall a. IO (Either Error a) -> IO' a
IO' IO (Either Error [Socket])
getSocketList

getSocketByName :: Name -> IO (Either Error Socket)
getSocketByName :: Name -> IO (Either Error Socket)
getSocketByName Name
name = IO' Socket -> IO (Either Error Socket)
forall a. IO' a -> IO (Either Error a)
run do
    Map Name Fd
m <- IO (Either Error (Map Name Fd)) -> IO' (Map Name Fd)
forall a. IO (Either Error a) -> IO' a
IO' IO (Either Error (Map Name Fd))
getFileDescriptorMap
    Fd
fd <- case Name -> Map Name Fd -> Maybe Fd
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name Map Name Fd
m of
        Maybe Fd
Nothing -> Error -> IO' Fd
forall a. Error -> IO' a
throwError (Name -> [Name] -> Error
NoSuchName Name
name (Map Name Fd -> [Name]
forall k a. Map k a -> [k]
Map.keys Map Name Fd
m))
        Just Fd
x -> Fd -> IO' Fd
forall a. a -> IO' a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Fd
x
    IO Socket -> IO' Socket
forall a. IO a -> IO' a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Socket -> IO' Socket) -> IO Socket -> IO' Socket
forall a b. (a -> b) -> a -> b
$ Fd -> IO Socket
fdSocket Fd
fd