module Cfg.Env
(
envSourceSep
, envSource
, getEnvConfigSep
, getEnvConfig
, printDotEnv'
, printDotEnv
)
where
import Cfg
import Cfg.Env.Keys
import Cfg.Parser
import Cfg.Source
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.List (intersperse)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO (writeFile)
import KeyTree
import System.Environment (lookupEnv)
import Prelude hiding (writeFile)
envSourceSep
:: forall m
. (MonadIO m)
=> Text
-> KeyTree Text Text
-> m (KeyTree Text Text)
envSourceSep :: forall (m :: * -> *).
MonadIO m =>
Text -> KeyTree Text Text -> m (KeyTree Text Text)
envSourceSep Text
sep = ([Text] -> Text -> m Text)
-> ([Text] -> m (Maybe Text))
-> (Text -> [Text] -> Map Text (KeyTree Text Text) -> [Text])
-> [Text]
-> KeyTree Text Text
-> m (KeyTree Text Text)
forall (f :: * -> *) k v a v'.
(Applicative f, Eq k, Eq v) =>
(a -> v -> f v')
-> (a -> f (Maybe v'))
-> (k -> a -> Map k (Free (Map k) v) -> a)
-> a
-> Free (Map k) v
-> f (KeyTree k v')
mayAppendTraverse [Text] -> Text -> m Text
valF [Text] -> m (Maybe Text)
accF Text -> [Text] -> Map Text (KeyTree Text Text) -> [Text]
stepF []
where
valF :: [Text] -> Text -> m Text
valF :: [Text] -> Text -> m Text
valF [Text]
keys Text
def = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
def (Maybe Text -> Text) -> m (Maybe Text) -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text] -> m (Maybe Text)
accF [Text]
keys
accF :: [Text] -> m (Maybe Text)
accF :: [Text] -> m (Maybe Text)
accF = (Maybe String -> Maybe Text) -> m (Maybe String) -> m (Maybe Text)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> Text) -> Maybe String -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack) (m (Maybe String) -> m (Maybe Text))
-> ([Text] -> m (Maybe String)) -> [Text] -> m (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe String) -> m (Maybe String)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> m (Maybe String))
-> ([Text] -> IO (Maybe String)) -> [Text] -> m (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe String)
lookupEnv (String -> IO (Maybe String))
-> ([Text] -> String) -> [Text] -> IO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> ([Text] -> Text) -> [Text] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
mkKey
stepF :: Text -> [Text] -> KeyForest Text Text -> [Text]
stepF :: Text -> [Text] -> Map Text (KeyTree Text Text) -> [Text]
stepF Text
key [Text]
acc Map Text (KeyTree Text Text)
_ = Text
key Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc
mkKey :: [Text] -> Text
mkKey :: [Text] -> Text
mkKey [Text]
keys = (Text -> Text -> Text) -> Text -> [Text] -> Text
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((Text -> Text -> Text) -> Text -> Text -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend) Text
"" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse Text
sep [Text]
keys
envSource :: (MonadFail m, MonadIO m) => KeyTree Text Text -> m (KeyTree Text Text)
envSource :: forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
KeyTree Text Text -> m (KeyTree Text Text)
envSource = Text -> KeyTree Text Text -> m (KeyTree Text Text)
forall (m :: * -> *).
MonadIO m =>
Text -> KeyTree Text Text -> m (KeyTree Text Text)
envSourceSep Text
"_"
printDotEnv'
:: FilePath
-> Text
-> KeyTree Text Text
-> IO ()
printDotEnv' :: String -> Text -> KeyTree Text Text -> IO ()
printDotEnv' String
path Text
sep = String -> Text -> IO ()
writeFile String
path (Text -> IO ())
-> (KeyTree Text Text -> Text) -> KeyTree Text Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
line -> Text
"export " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
line Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=\n") ([Text] -> Text)
-> (KeyTree Text Text -> [Text]) -> KeyTree Text Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> KeyTree Text Text -> [Text]
showEnvKeys' Text
sep
getEnvConfigSep
:: forall a m
. (MonadFail m, MonadIO m, ConfigSource a, ConfigParser a)
=> Text
-> m (Either ConfigParseError a)
getEnvConfigSep :: forall a (m :: * -> *).
(MonadFail m, MonadIO m, ConfigSource a, ConfigParser a) =>
Text -> m (Either ConfigParseError a)
getEnvConfigSep Text
sep = FetchSource m -> m (Either ConfigParseError a)
forall a (m :: * -> *).
(Monad m, ConfigSource a, ConfigParser a) =>
FetchSource m -> m (Either ConfigParseError a)
getConfig (FetchSource m -> m (Either ConfigParseError a))
-> FetchSource m -> m (Either ConfigParseError a)
forall a b. (a -> b) -> a -> b
$ Text -> FetchSource m
forall (m :: * -> *).
MonadIO m =>
Text -> KeyTree Text Text -> m (KeyTree Text Text)
envSourceSep Text
sep
getEnvConfig
:: forall a m. (MonadFail m, MonadIO m, ConfigSource a, ConfigParser a) => m (Either ConfigParseError a)
getEnvConfig :: forall a (m :: * -> *).
(MonadFail m, MonadIO m, ConfigSource a, ConfigParser a) =>
m (Either ConfigParseError a)
getEnvConfig = FetchSource m -> m (Either ConfigParseError a)
forall a (m :: * -> *).
(Monad m, ConfigSource a, ConfigParser a) =>
FetchSource m -> m (Either ConfigParseError a)
getConfig (FetchSource m -> m (Either ConfigParseError a))
-> FetchSource m -> m (Either ConfigParseError a)
forall a b. (a -> b) -> a -> b
$ FetchSource m
forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
KeyTree Text Text -> m (KeyTree Text Text)
envSource
printDotEnv :: forall a. (ConfigSource a) => FilePath -> IO ()
printDotEnv :: forall {k} (a :: k). ConfigSource a => String -> IO ()
printDotEnv String
path =
String -> Text -> IO ()
writeFile String
path
(Text -> IO ())
-> (KeyTree Text Text -> Text) -> KeyTree Text Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Text
line -> Text
"export " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
line Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=\n")
([Text] -> Text)
-> (KeyTree Text Text -> [Text]) -> KeyTree Text Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> KeyTree Text Text -> [Text]
showEnvKeys' Text
"_"
(KeyTree Text Text -> IO ()) -> KeyTree Text Text -> IO ()
forall a b. (a -> b) -> a -> b
$ forall (a :: k). ConfigSource a => KeyTree Text Text
forall {k} (a :: k). ConfigSource a => KeyTree Text Text
configSource @a