{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE ImpredicativeTypes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE LambdaCase #-} module Conftrack.Source.Env (EnvSource(..), mkEnvSource) where import Conftrack.Value (Key (..), ConfigError(..), Value (..)) import Conftrack.Source (ConfigSource (..), SomeSource (SomeSource)) import Prelude hiding (readFile) import Data.Text (Text) import System.OsString (OsString, decodeUtf, encodeUtf) import System.Directory.Internal (lookupEnvOs) import Control.Monad.Trans (MonadIO (liftIO)) import Text.Read (readMaybe) import Control.Monad.State (modify) import qualified Data.Text as T import qualified Data.Text.Encoding as BE import Data.Functor ((<&>)) import qualified Data.List.NonEmpty as NonEmpty import Data.Maybe (fromJust) import Data.Function ((&)) data EnvSource = EnvSource { EnvSource -> Key -> OsString envSourceModifier :: Key -> OsString , EnvSource -> Text envSourceDescription :: Text } mkEnvSource :: Text -> SomeSource mkEnvSource :: Text -> SomeSource mkEnvSource Text prefix = (EnvSource, SourceState EnvSource) -> SomeSource forall source. ConfigSource source => (source, SourceState source) -> SomeSource SomeSource (EnvSource source, []) where source :: EnvSource source = EnvSource { envSourceModifier :: Key -> OsString envSourceModifier = \(Key NonEmpty Text parts) -> Text prefix Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "_" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text -> [Text] -> Text T.intercalate Text "_" (NonEmpty Text -> [Text] forall a. NonEmpty a -> [a] NonEmpty.toList NonEmpty Text parts) Text -> (Text -> Text) -> Text forall a b. a -> (a -> b) -> b & Text -> Text T.toUpper Text -> (Text -> String) -> String forall a b. a -> (a -> b) -> b & Text -> String T.unpack String -> (String -> Maybe OsString) -> Maybe OsString forall a b. a -> (a -> b) -> b & String -> Maybe OsString forall (m :: * -> *). MonadThrow m => String -> m OsString encodeUtf Maybe OsString -> (Maybe OsString -> OsString) -> OsString forall a b. a -> (a -> b) -> b & Maybe OsString -> OsString forall a. HasCallStack => Maybe a -> a fromJust , envSourceDescription :: Text envSourceDescription = Text "Environment variable " } instance Show EnvSource where show :: EnvSource -> String show EnvSource{Text Key -> OsString envSourceModifier :: EnvSource -> Key -> OsString envSourceDescription :: EnvSource -> Text envSourceModifier :: Key -> OsString envSourceDescription :: Text ..} = String "EnvSource { envSourceDescription = " String -> ShowS forall a. Semigroup a => a -> a -> a <> Text -> String forall a. Show a => a -> String show Text envSourceDescription String -> ShowS forall a. Semigroup a => a -> a -> a <> String "}" instance ConfigSource EnvSource where type SourceState EnvSource = [Key] fetchValue :: Key -> EnvSource -> StateT (SourceState EnvSource) IO (Either ConfigError (Value, Text)) fetchValue Key key EnvSource{Text Key -> OsString envSourceModifier :: EnvSource -> Key -> OsString envSourceDescription :: EnvSource -> Text envSourceModifier :: Key -> OsString envSourceDescription :: Text ..} = IO (Maybe OsString) -> StateT (SourceState EnvSource) IO (Maybe OsString) forall a. IO a -> StateT (SourceState EnvSource) IO a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (OsString -> IO (Maybe OsString) lookupEnvOs OsString envVarName) StateT (SourceState EnvSource) IO (Maybe OsString) -> (Maybe OsString -> StateT (SourceState EnvSource) IO (Either ConfigError (Value, Text))) -> StateT (SourceState EnvSource) IO (Either ConfigError (Value, Text)) forall a b. StateT (SourceState EnvSource) IO a -> (a -> StateT (SourceState EnvSource) IO b) -> StateT (SourceState EnvSource) IO b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Maybe OsString Nothing -> Either ConfigError (Value, Text) -> StateT (SourceState EnvSource) IO (Either ConfigError (Value, Text)) forall a. a -> StateT (SourceState EnvSource) IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (Either ConfigError (Value, Text) -> StateT (SourceState EnvSource) IO (Either ConfigError (Value, Text))) -> Either ConfigError (Value, Text) -> StateT (SourceState EnvSource) IO (Either ConfigError (Value, Text)) forall a b. (a -> b) -> a -> b $ ConfigError -> Either ConfigError (Value, Text) forall a b. a -> Either a b Left (Key -> ConfigError NotPresent Key key) Just OsString osstr -> do ([Key] -> [Key]) -> StateT [Key] IO () forall s (m :: * -> *). MonadState s m => (s -> s) -> m () modify (Key key :) String str <- IO String -> StateT [Key] IO String forall a. IO a -> StateT [Key] IO a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO String -> StateT [Key] IO String) -> IO String -> StateT [Key] IO String forall a b. (a -> b) -> a -> b $ OsString -> IO String forall (m :: * -> *). MonadThrow m => OsString -> m String decodeUtf OsString osstr let value :: Value value = case String -> Maybe Integer forall a. Read a => String -> Maybe a readMaybe String str of Just Integer num -> ByteString -> Integer -> Value ConfigMaybeInteger (Text -> ByteString BE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString forall a b. (a -> b) -> a -> b $ String -> Text T.pack String str) Integer num Maybe Integer Nothing -> ByteString -> Value ConfigString (Text -> ByteString BE.encodeUtf8 (Text -> ByteString) -> Text -> ByteString forall a b. (a -> b) -> a -> b $ String -> Text T.pack String str) Text envNameText <- OsString -> StateT [Key] IO String forall (m :: * -> *). MonadThrow m => OsString -> m String decodeUtf OsString envVarName StateT [Key] IO String -> (String -> Text) -> StateT [Key] IO Text forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> String -> Text T.pack Either ConfigError (Value, Text) -> StateT [Key] IO (Either ConfigError (Value, Text)) forall a. a -> StateT [Key] IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (Either ConfigError (Value, Text) -> StateT [Key] IO (Either ConfigError (Value, Text))) -> Either ConfigError (Value, Text) -> StateT [Key] IO (Either ConfigError (Value, Text)) forall a b. (a -> b) -> a -> b $ (Value, Text) -> Either ConfigError (Value, Text) forall a b. b -> Either a b Right (Value value, Text envSourceDescription Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text envNameText) where envVarName :: OsString envVarName = Key -> OsString envSourceModifier Key key leftovers :: EnvSource -> StateT (SourceState EnvSource) IO (Maybe [Key]) leftovers EnvSource _ = Maybe [Key] -> StateT (SourceState EnvSource) IO (Maybe [Key]) forall a. a -> StateT (SourceState EnvSource) IO a forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe [Key] forall a. Maybe a Nothing