module SocketActivation.Env where

import Essentials

import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Either (Either, either)
import Data.Text (Text)
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 forall a b. (a -> b) -> a -> b
$ 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 (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> Text
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 (f :: * -> *) a. Applicative f => a -> f a
pure
    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

getEnvVars :: IO [(VarName, Maybe Text)]
getEnvVars :: IO [(VarName, Maybe Text)]
getEnvVars = [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound] forall a b. a -> (a -> b) -> b
& 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 (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Either Error Text
y -> (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)

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 forall a b. (a -> b) -> a -> b
$
    forall a. IO (Either Error a) -> IO' a
IO' (VarName -> IO (Either Error Text)
getVarText VarName
name) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Error -> IO' a
throwError (VarName -> Error
Invalid VarName
name)) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Names
readNames)