{-# 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
  { envSourceModifier :: Key -> OsString
  , envSourceDescription :: Text
  }

mkEnvSource :: Text -> SomeSource
mkEnvSource prefix = SomeSource (source, [])
  where source = EnvSource
          { envSourceModifier = \(Key parts) ->
              prefix <> "_" <> T.intercalate "_" (NonEmpty.toList parts)
              & T.toUpper
              & T.unpack
              & encodeUtf
              & fromJust
          , envSourceDescription = "Environment variable "
          }

instance Show EnvSource where
  show EnvSource{..} =
    "EnvSource { envSourceDescription = " <> show envSourceDescription <> "}"

instance ConfigSource EnvSource where
  type SourceState EnvSource = [Key]

  fetchValue key EnvSource{..} =
    liftIO (lookupEnvOs envVarName) >>= \case
      Nothing -> pure $ Left (NotPresent key)
      Just osstr -> do
        modify (key :)
        str <- liftIO $ decodeUtf osstr
        let value = case readMaybe str of
              Just num -> ConfigMaybeInteger (BE.encodeUtf8 $ T.pack str) num
              Nothing -> ConfigString (BE.encodeUtf8 $ T.pack str)
        envNameText <- decodeUtf envVarName <&> T.pack
        pure $ Right (value, envSourceDescription <> envNameText)
      where envVarName = envSourceModifier key

  leftovers _ = pure Nothing