module SocketActivation
    (
        {- * Actions -} getMySocketByName,
        {- * Types -} Name (..), VarName (..), Socket, Error (..),
    )
    where

import Control.Applicative (Applicative ((*>)))
import Control.Monad (Monad (return, (>>=)))
import Data.Either (Either, either)
import System.IO (IO, print)

import qualified Control.Exception as Ex

import qualified SocketActivation.CheckRecipient as SA
import qualified SocketActivation.Env as SA
import qualified SocketActivation.GetByName as SA

import SocketActivation.Concepts
    (Socket, Error (..), VarName (..), Name (..))

getMySocketByName :: Name -> IO Socket
getMySocketByName :: Name -> IO Socket
getMySocketByName Name
name = forall a. IO (Either Error a) -> IO a
f IO (Either Error ())
SA.checkRecipient forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a. IO (Either Error a) -> IO a
f (Name -> IO (Either Error Socket)
SA.getSocketByName Name
name)
  where
    f :: IO (Either Error a) -> IO a
    f :: forall a. IO (Either Error a) -> IO a
f = (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Error
e -> (IO [(VarName, Maybe Text)]
SA.getEnvVars forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Show a => a -> IO ()
print) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall a e. Exception e => e -> a
Ex.throw Error
e) forall (m :: * -> *) a. Monad m => a -> m a
return)