module SocketActivation.Env where

import Control.Monad (Monad (return, (>>=)))
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Either (Either, either)
import Data.Function (($), (.))
import Data.Maybe (Maybe (..), maybe)
import Data.Text (Text)
import Data.Traversable (Traversable (traverse))
import Prelude (Bounded (maxBound, minBound))
import System.IO (IO)
import Text.Show (show)

import qualified Data.Text as Text
import qualified System.Environment as Sys

import SocketActivation.Concepts
    (Error (Invalid, Missing), VarName (..), Names, Count, Recipient)
import SocketActivation.IO (IO' (IO', run), throwError)
import SocketActivation.Parsing (readRecipient, readCount, readNames)

getVarText :: VarName -> IO (Either Error Text)
getVarText :: VarName -> IO (Either Error Text)
getVarText VarName
name = forall a. IO' a -> IO (Either Error a)
run (IO' (Maybe String)
getMaybe forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a}. Maybe a -> IO' a
throwIfMissing forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO' Text
pack)
  where
    throwIfMissing :: Maybe a -> IO' a
throwIfMissing = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Error -> IO' a
throwError (VarName -> Error
Missing VarName
name)) forall (m :: * -> *) a. Monad m => a -> m a
return
    getMaybe :: IO' (Maybe String)
getMaybe = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
Sys.lookupEnv forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show @VarName VarName
name
    pack :: String -> IO' Text
pack = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

getEnvVars :: IO [(VarName, Maybe Text)]
getEnvVars :: IO [(VarName, Maybe Text)]
getEnvVars =
    forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
        (\VarName
x -> VarName -> IO (Either Error Text)
getVarText VarName
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either Error Text
y ->
            forall (m :: * -> *) a. Monad m => a -> m a
return (VarName
x, forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Error
_ -> forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just Either Error Text
y))
        [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]

data Env a = Env VarName (Text -> Maybe a)

getEnv :: Env a -> IO (Either Error a)
getEnv :: forall a. Env a -> IO (Either Error a)
getEnv (Env VarName
name Text -> Maybe a
read) = forall a. IO' a -> IO (Either Error a)
run (IO' Text
getText forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> IO' a
readOrThrow)
  where
    getText :: IO' Text
getText = forall a. IO (Either Error a) -> IO' a
IO' (VarName -> IO (Either Error Text)
getVarText VarName
name)
    readOrThrow :: Text -> IO' a
readOrThrow = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Error -> IO' a
throwError (VarName -> Error
Invalid VarName
name)) forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe a
read

getEnv' :: Env' a => IO (Either Error a)
getEnv' :: forall a. Env' a => IO (Either Error a)
getEnv' = forall a. Env a -> IO (Either Error a)
getEnv forall a. Env' a => Env a
env'

class Env' a where env' :: Env a
instance Env' Recipient where env' :: Env Recipient
env' = forall a. VarName -> (Text -> Maybe a) -> Env a
Env VarName
LISTEN_PID Text -> Maybe Recipient
readRecipient
instance Env' Count where env' :: Env Count
env' = forall a. VarName -> (Text -> Maybe a) -> Env a
Env VarName
LISTEN_FDS Text -> Maybe Count
readCount
instance Env' Names where env' :: Env Names
env' = forall a. VarName -> (Text -> Maybe a) -> Env a
Env VarName
LISTEN_FDNAMES (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Names
readNames)