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
import           SocketActivation.IO
import           SocketActivation.Parsing

getVarText :: VarName -> IO (Either Error Text)
getVarText :: VarName -> IO (Either Error Text)
getVarText VarName
name = IO' Text -> IO (Either Error Text)
forall a. IO' a -> IO (Either Error a)
run (IO' (Maybe String)
getMaybe IO' (Maybe String) -> (Maybe String -> IO' String) -> IO' String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe String -> IO' String
forall a. Maybe a -> IO' a
throwIfMissing IO' String -> (String -> IO' Text) -> IO' Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO' Text
pack)
  where
    throwIfMissing :: Maybe a -> IO' a
throwIfMissing = IO' a -> (a -> IO' a) -> Maybe a -> IO' a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Error -> IO' a
forall a. Error -> IO' a
throwError (VarName -> Error
Missing VarName
name)) a -> IO' a
forall (m :: * -> *) a. Monad m => a -> m a
return
    getMaybe :: IO' (Maybe String)
getMaybe = IO (Maybe String) -> IO' (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> IO' (Maybe String))
-> IO (Maybe String) -> IO' (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
Sys.lookupEnv (String -> IO (Maybe String)) -> String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ VarName -> String
forall a. Show a => a -> String
show @VarName VarName
name
    pack :: String -> IO' Text
pack = Text -> IO' Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO' Text) -> (String -> Text) -> String -> IO' Text
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 = (VarName -> IO (VarName, Maybe Text))
-> [VarName] -> IO [(VarName, Maybe Text)]
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 IO (Either Error Text)
-> (Either Error Text -> IO (VarName, Maybe Text))
-> IO (VarName, Maybe Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Either Error Text
y -> (VarName, Maybe Text) -> IO (VarName, Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (VarName
x, (Error -> Maybe Text)
-> (Text -> Maybe Text) -> Either Error Text -> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\Error
_ -> Maybe Text
forall a. Maybe a
Nothing) Text -> Maybe Text
forall a. a -> Maybe a
Just Either Error Text
y)) [VarName
forall a. Bounded a => a
minBound .. VarName
forall a. Bounded a => a
maxBound]

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

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

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

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