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 = IO' Text -> IO (Either Error Text)
forall a. IO' a -> IO (Either Error a)
run (IO' Text -> IO (Either Error Text))
-> IO' Text -> IO (Either Error Text)
forall a b. (a -> b) -> a -> b
$ IO' (Maybe String)
getMaybe IO' (Maybe String) -> (Maybe String -> IO' String) -> IO' String
forall a b. IO' a -> (a -> IO' b) -> IO' b
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 -> Text) -> IO' Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> String -> Text
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 a. a -> IO' a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    getMaybe :: IO' (Maybe String)
getMaybe = IO (Maybe String) -> IO' (Maybe String)
forall a. IO a -> IO' a
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
$ forall a. Show a => a -> String
show @VarName VarName
name

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

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) = IO' a -> IO (Either Error a)
forall a. IO' a -> IO (Either Error a)
run (IO' a -> IO (Either Error a)) -> IO' a -> IO (Either Error a)
forall a b. (a -> b) -> a -> b
$
    IO (Either Error Text) -> IO' Text
forall a. IO (Either Error a) -> IO' a
IO' (VarName -> IO (Either Error Text)
getVarText VarName
name) IO' Text -> (Text -> IO' a) -> IO' a
forall a b. IO' a -> (a -> IO' b) -> IO' b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    (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 a. a -> IO' a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> IO' a) -> (Text -> Maybe a) -> Text -> IO' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
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' = 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
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)