{-# LANGUAGE OverloadedStrings #-}

{- |
Hierarchical configuration resolution (Viper-style).
Unifies defaults, configuration files, and environment variables into a single
resolution tree with strict precedence: Defaults < File < Env.
-}
module Ecluse.Config.Resolve (
    deepMerge,
    buildEnvAst,
) where

import Data.Aeson (Value (..), eitherDecodeStrict)
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap

import Data.Text qualified as T

{- | Right-biased deep merge of two Aeson Values.
Objects are merged recursively. Other types (Arrays, Strings, etc.) are
overwritten by the right side (the higher precedence value).
-}
deepMerge :: Value -> Value -> Value
deepMerge :: Value -> Value -> Value
deepMerge (Object Object
l) (Object Object
r) = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ (Value -> Value -> Value) -> Object -> Object -> Object
forall v. (v -> v -> v) -> KeyMap v -> KeyMap v -> KeyMap v
KeyMap.unionWith Value -> Value -> Value
deepMerge Object
l Object
r
deepMerge Value
_ Value
r = Value
r

{- | Convert a list of environment variables into a nested JSON Object.
Filters for keys starting with @ECLUSE_@ and strips the prefix.
Double underscores (@__@) represent nested object paths.
Single underscores (@_@) are converted to camelCase for Aeson key matching.
For example, @ECLUSE_MOUNTS__NPM__PRIVATE_UPSTREAM@ becomes
@{"mounts": {"npm": {"privateUpstream": ...}}}@.
Values that parse as valid JSON (like numbers or booleans) are decoded;
otherwise they remain as Strings.
-}
buildEnvAst :: [(String, String)] -> Value
buildEnvAst :: [(String, String)] -> Value
buildEnvAst [(String, String)]
env =
    (Value -> Value -> Value) -> Value -> [Value] -> Value
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Value -> Value -> Value
deepMerge (Object -> Value
Object Object
forall v. KeyMap v
KeyMap.empty) (((Text, String) -> Value) -> [(Text, String)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (Text, String) -> Value
envVarValue [(Text, String)]
configVars)
  where
    configVars :: [(Text, String)]
configVars = [(Text
key, String
v) | (String
name, String
v) <- [(String, String)]
env, Just Text
key <- [Text -> Maybe Text
configEnvKey (String -> Text
T.pack String
name)]]

configEnvKey :: Text -> Maybe Text
configEnvKey :: Text -> Maybe Text
configEnvKey Text
name = case Text -> Text -> Maybe Text
T.stripPrefix Text
"ECLUSE_" Text
name of
    Just Text
stripped -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
stripped
    Maybe Text
Nothing
        | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`T.isPrefixOf` Text
name) [Text]
exemptedPrefixes -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name
        | Bool
otherwise -> Maybe Text
forall a. Maybe a
Nothing

exemptedPrefixes :: [Text]
exemptedPrefixes :: [Text]
exemptedPrefixes = [Text
"AWS_"]

envVarValue :: (Text, String) -> Value
envVarValue :: (Text, String) -> Value
envVarValue (Text
key, String
value) =
    [Key] -> Value -> Value
nest ((Text -> Key) -> [Text] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Key
toCamelCase (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"__" Text
key)) (Text -> Value
parseEnvValue (String -> Text
T.pack String
value))

toCamelCase :: Text -> Key.Key
toCamelCase :: Text -> Key
toCamelCase Text
t =
    let words' :: [Text]
words' = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"_" Text
t)
     in Text -> Key
Key.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ case [Text]
words' of
            [] -> Text
""
            (Text
w : [Text]
ws) -> Text -> Text
T.toLower Text
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.concat ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.toTitle [Text]
ws)

nest :: [Key.Key] -> Value -> Value
nest :: [Key] -> Value -> Value
nest [] Value
v = Value
v
nest (Key
p : [Key]
ps) Value
v = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Object
forall v. Key -> v -> KeyMap v
KeyMap.singleton Key
p ([Key] -> Value -> Value
nest [Key]
ps Value
v)

parseEnvValue :: Text -> Value
parseEnvValue :: Text -> Value
parseEnvValue Text
txt = case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
txt) of
    Right Value
v -> Value
v
    Left String
_ -> Text -> Value
String Text
txt