{-# 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