-- |
-- Copyright: (c) 2019 Lucas David Traverso
-- License: MPL-2.0
-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>
-- Stability: stable
-- Portability: portable
--
-- Environment based source
{-# LANGUAGE RecordWildCards #-}
module Conferer.Source.Env where

import Data.Text (Text)
import qualified Data.Text as Text
import qualified System.Environment as System
import Data.Maybe (mapMaybe)

import Conferer.Source
import qualified Conferer.Source.InMemory as InMemory

-- | Source that interfaces with the environment transforming keys
-- by uppercasing and interspersing underscores, and using a prefix
-- to avoid clashing with system env vars
--
-- so with "app" prefix, @"some.key"@ turns into @APP_SOME_KEY@
data EnvSource =
  EnvSource
  { EnvSource -> RawEnvironment
environment :: RawEnvironment
  , EnvSource -> Prefix
keyPrefix :: Prefix
  , EnvSource -> Source
innerSource :: Source
  } deriving (Int -> EnvSource -> ShowS
[EnvSource] -> ShowS
EnvSource -> String
(Int -> EnvSource -> ShowS)
-> (EnvSource -> String)
-> ([EnvSource] -> ShowS)
-> Show EnvSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnvSource] -> ShowS
$cshowList :: [EnvSource] -> ShowS
show :: EnvSource -> String
$cshow :: EnvSource -> String
showsPrec :: Int -> EnvSource -> ShowS
$cshowsPrec :: Int -> EnvSource -> ShowS
Show)

-- | Type alias for the environment
type RawEnvironment = [(String, String)]

-- | Type alias for the env vars prefix
type Prefix = Text

instance IsSource EnvSource where
  getKeyInSource :: EnvSource -> Key -> IO (Maybe Prefix)
getKeyInSource EnvSource{RawEnvironment
Prefix
Source
innerSource :: Source
keyPrefix :: Prefix
environment :: RawEnvironment
innerSource :: EnvSource -> Source
keyPrefix :: EnvSource -> Prefix
environment :: EnvSource -> RawEnvironment
..} Key
key = do
    Source -> Key -> IO (Maybe Prefix)
forall s. IsSource s => s -> Key -> IO (Maybe Prefix)
getKeyInSource Source
innerSource Key
key
  getSubkeysInSource :: EnvSource -> Key -> IO [Key]
getSubkeysInSource EnvSource{RawEnvironment
Prefix
Source
innerSource :: Source
keyPrefix :: Prefix
environment :: RawEnvironment
innerSource :: EnvSource -> Source
keyPrefix :: EnvSource -> Prefix
environment :: EnvSource -> RawEnvironment
..} Key
key = do
    Source -> Key -> IO [Key]
forall s. IsSource s => s -> Key -> IO [Key]
getSubkeysInSource Source
innerSource Key
key

-- | Create a 'SourceCreator' using 'fromEnv'
fromConfig :: Prefix -> SourceCreator
fromConfig :: Prefix -> SourceCreator
fromConfig Prefix
prefix Config
_config = do
  Prefix -> IO Source
fromEnv Prefix
prefix

-- | Create a 'Source' using the real environment
fromEnv :: Prefix -> IO Source
fromEnv :: Prefix -> IO Source
fromEnv Prefix
prefix = do
  RawEnvironment
rawEnvironment <- IO RawEnvironment
System.getEnvironment
  Source -> IO Source
forall (m :: * -> *) a. Monad m => a -> m a
return (Source -> IO Source) -> Source -> IO Source
forall a b. (a -> b) -> a -> b
$ RawEnvironment -> Prefix -> Source
fromEnvList RawEnvironment
rawEnvironment Prefix
prefix

-- | Create a 'Source' using a hardcoded list of env vars
fromEnvList :: RawEnvironment -> Prefix -> Source
fromEnvList :: RawEnvironment -> Prefix -> Source
fromEnvList RawEnvironment
environment Prefix
keyPrefix =
  let
    mappings :: [(Key, Prefix)]
mappings =
      ((String, String) -> Maybe (Key, Prefix))
-> RawEnvironment -> [(Key, Prefix)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(String
key, String
v) -> do
        Key
k <- Prefix -> Prefix -> Maybe Key
envVarToKey Prefix
keyPrefix (Prefix -> Maybe Key) -> Prefix -> Maybe Key
forall a b. (a -> b) -> a -> b
$ String -> Prefix
Text.pack String
key
        (Key, Prefix) -> Maybe (Key, Prefix)
forall (m :: * -> *) a. Monad m => a -> m a
return (Key
k, String -> Prefix
Text.pack String
v)
      )
      RawEnvironment
environment
    innerSource :: Source
innerSource = [(Key, Prefix)] -> Source
InMemory.fromAssociations [(Key, Prefix)]
mappings
  in EnvSource -> Source
forall s. (IsSource s, Show s) => s -> Source
Source EnvSource :: RawEnvironment -> Prefix -> Source -> EnvSource
EnvSource {RawEnvironment
Prefix
Source
innerSource :: Source
keyPrefix :: Prefix
environment :: RawEnvironment
innerSource :: Source
keyPrefix :: Prefix
environment :: RawEnvironment
..}

-- | Get the env name from a prefix and a key by uppercasing and
-- intercalating underscores
keyToEnvVar :: Prefix -> Key -> Text
keyToEnvVar :: Prefix -> Key -> Prefix
keyToEnvVar Prefix
prefix Key
keys =
  Prefix -> Prefix
Text.toUpper
  (Prefix -> Prefix) -> Prefix -> Prefix
forall a b. (a -> b) -> a -> b
$ Prefix -> [Prefix] -> Prefix
Text.intercalate Prefix
"_"
  ([Prefix] -> Prefix) -> [Prefix] -> Prefix
forall a b. (a -> b) -> a -> b
$ (Prefix -> Bool) -> [Prefix] -> [Prefix]
forall a. (a -> Bool) -> [a] -> [a]
filter (Prefix -> Prefix -> Bool
forall a. Eq a => a -> a -> Bool
/= Prefix
forall a. Monoid a => a
mempty)
  ([Prefix] -> [Prefix]) -> [Prefix] -> [Prefix]
forall a b. (a -> b) -> a -> b
$ Prefix
prefix Prefix -> [Prefix] -> [Prefix]
forall a. a -> [a] -> [a]
: Key -> [Prefix]
rawKeyComponents Key
keys

-- | The opossite of 'keyToEnvVar'
envVarToKey :: Prefix -> Text -> Maybe Key
envVarToKey :: Prefix -> Prefix -> Maybe Key
envVarToKey Prefix
prefix Prefix
envVar =
  let
    splitEnvVar :: Key
splitEnvVar = Prefix -> Key
fromText (Prefix -> Key) -> Prefix -> Key
forall a b. (a -> b) -> a -> b
$ Prefix -> Prefix -> Prefix -> Prefix
Text.replace Prefix
"_"  Prefix
"." Prefix
envVar
  in
    Key -> Key -> Maybe Key
stripKeyPrefix (Prefix -> Key
fromText Prefix
prefix) Key
splitEnvVar