module RichEnv.Setters (mappingsToValues, prefixesToValues, valuesToEnv, valuesToEnvList, richEnvToValues) where
import Data.Bifunctor (first)
import Data.HashMap.Strict qualified as HM
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import RichEnv.Types (Environment, RichEnv (..), fromEnvironment)
import RichEnv.Types.Mappings (Mappings (Mappings, unMappings))
import RichEnv.Types.Prefixes (Prefixes (Prefixes, unPrefixes))
import RichEnv.Types.Values (Values (Values, unValues))
import System.Environment (setEnv)
valuesToEnv :: Values -> IO ()
valuesToEnv :: Values -> IO ()
valuesToEnv = ((String, String) -> IO ()) -> [(String, String)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((String -> String -> IO ()) -> (String, String) -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> IO ()
setEnv) ([(String, String)] -> IO ())
-> (Values -> [(String, String)]) -> Values -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> [(String, String)]
fromEnvironment (Environment -> [(String, String)])
-> (Values -> Environment) -> Values -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text Text -> Environment
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap Text Text -> Environment)
-> (Values -> HashMap Text Text) -> Values -> Environment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Values -> HashMap Text Text
unValues
valuesToEnvList :: Values -> Environment
valuesToEnvList :: Values -> Environment
valuesToEnvList = HashMap Text Text -> Environment
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap Text Text -> Environment)
-> (Values -> HashMap Text Text) -> Values -> Environment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Values -> HashMap Text Text
unValues
mappingsToValues :: Environment -> Mappings -> Values
mappingsToValues :: Environment -> Mappings -> Values
mappingsToValues Environment
_ (Mappings HashMap Text Text
m) | HashMap Text Text -> Bool
forall a. HashMap Text a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap Text Text
m = Values
forall a. Monoid a => a
mempty
mappingsToValues Environment
currentEnv Mappings
m =
let mappings' :: HashMap Text Text
mappings' = Mappings -> HashMap Text Text
unMappings Mappings
m
value :: Text -> Maybe Text
value Text
from = Text -> Environment -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
from Environment
currentEnv
setMappingValue :: k -> Maybe v -> HashMap k v -> HashMap k v
setMappingValue k
_ Maybe v
Nothing = HashMap k v -> HashMap k v
forall a. a -> a
id
setMappingValue k
k (Just v
v) = k -> v -> HashMap k v -> HashMap k v
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert k
k v
v
mappingsToValues' :: k -> Text -> HashMap k Text -> HashMap k Text
mappingsToValues' k
k Text
v = k -> Maybe Text -> HashMap k Text -> HashMap k Text
forall {k} {v}.
Hashable k =>
k -> Maybe v -> HashMap k v -> HashMap k v
setMappingValue k
k (Text -> Maybe Text
value Text
v)
in HashMap Text Text -> Values
Values (HashMap Text Text -> Values) -> HashMap Text Text -> Values
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> HashMap Text Text -> HashMap Text Text)
-> HashMap Text Text -> HashMap Text Text -> HashMap Text Text
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HM.foldrWithKey' Text -> Text -> HashMap Text Text -> HashMap Text Text
forall {k}.
Hashable k =>
k -> Text -> HashMap k Text -> HashMap k Text
mappingsToValues' HashMap Text Text
forall a. Monoid a => a
mempty HashMap Text Text
mappings'
prefixesToValues :: Environment -> Prefixes -> Values
prefixesToValues :: Environment -> Prefixes -> Values
prefixesToValues Environment
_ (Prefixes HashMap Text [Text]
p) | HashMap Text [Text] -> Bool
forall a. HashMap Text a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap Text [Text]
p = Values
forall a. Monoid a => a
mempty
prefixesToValues Environment
currentEnv Prefixes
p =
let prefixes' :: HashMap Text [Text]
prefixes' = Prefixes -> HashMap Text [Text]
unPrefixes Prefixes
p
prefixesToValues' :: Text -> [Text] -> Environment -> Environment
prefixesToValues' Text
k [Text]
v Environment
env = Environment
env Environment -> Environment -> Environment
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Environment -> Environment
setNewPrefix Text
k [Text]
v Environment
currentEnv
res :: Environment
res = if HashMap Text [Text] -> Bool
forall a. HashMap Text a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap Text [Text]
prefixes' then Environment
currentEnv else (Text -> [Text] -> Environment -> Environment)
-> Environment -> HashMap Text [Text] -> Environment
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HM.foldrWithKey' Text -> [Text] -> Environment -> Environment
prefixesToValues' Environment
forall a. Monoid a => a
mempty HashMap Text [Text]
prefixes'
in Environment -> Values
toValues Environment
res
setNewPrefix ::
Text ->
[Text] ->
Environment ->
Environment
setNewPrefix :: Text -> [Text] -> Environment -> Environment
setNewPrefix Text
newPrefix [] Environment
currentEnv = ((Text, Text) -> (Text, Text)) -> Environment -> Environment
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Text) -> (Text, Text) -> (Text, Text)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text
newPrefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)) Environment
currentEnv
setNewPrefix Text
newPrefix [Text
""] Environment
currentEnv = ((Text, Text) -> (Text, Text)) -> Environment -> Environment
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Text) -> (Text, Text) -> (Text, Text)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text
newPrefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)) Environment
currentEnv
setNewPrefix Text
newPrefix [Text]
oldPrefixes Environment
currentEnv =
let varsWithoutPrefixes :: [Environment]
varsWithoutPrefixes = Environment -> Text -> Environment
removePrefix Environment
currentEnv (Text -> Environment) -> [Text] -> [Environment]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
oldPrefixes
newPrefixedVars :: [Environment]
newPrefixedVars = ((Environment -> Environment) -> [Environment] -> [Environment]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Environment -> Environment) -> [Environment] -> [Environment])
-> (((Text, Text) -> (Text, Text)) -> Environment -> Environment)
-> ((Text, Text) -> (Text, Text))
-> [Environment]
-> [Environment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Text) -> (Text, Text)) -> Environment -> Environment
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) ((Text -> Text) -> (Text, Text) -> (Text, Text)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text
newPrefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)) [Environment]
varsWithoutPrefixes
in [Environment] -> Environment
forall a. Monoid a => [a] -> a
mconcat [Environment]
newPrefixedVars
removePrefix :: Environment -> Text -> Environment
removePrefix :: Environment -> Text -> Environment
removePrefix Environment
currentEnv Text
oldPrefix =
let getWithoutPrefix :: Text -> (Text, b) -> Maybe (Text, b)
getWithoutPrefix Text
old (Text
k, b
v) = Text -> Text -> Maybe Text
T.stripPrefix Text
old Text
k Maybe Text -> (Text -> Maybe (Text, b)) -> Maybe (Text, b)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
sk -> (Text, b) -> Maybe (Text, b)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
sk, b
v)
in ((Text, Text) -> Maybe (Text, Text)) -> Environment -> Environment
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> (Text, Text) -> Maybe (Text, Text)
forall {b}. Text -> (Text, b) -> Maybe (Text, b)
getWithoutPrefix Text
oldPrefix) Environment
currentEnv
toValues :: Environment -> Values
toValues :: Environment -> Values
toValues = HashMap Text Text -> Values
Values (HashMap Text Text -> Values)
-> (Environment -> HashMap Text Text) -> Environment -> Values
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> HashMap Text Text
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList
richEnvToValues :: RichEnv -> Environment -> Values
richEnvToValues :: RichEnv -> Environment -> Values
richEnvToValues RichEnv
re Environment
currentEnv =
let vvs :: Values
vvs = RichEnv -> Values
values RichEnv
re
vms :: Environment -> Values
vms = (Environment -> Mappings -> Values)
-> Mappings -> Environment -> Values
forall a b c. (a -> b -> c) -> b -> a -> c
flip Environment -> Mappings -> Values
mappingsToValues (RichEnv -> Mappings
mappings RichEnv
re)
vps :: Environment -> Values
vps = (Environment -> Prefixes -> Values)
-> Prefixes -> Environment -> Values
forall a b c. (a -> b -> c) -> b -> a -> c
flip Environment -> Prefixes -> Values
prefixesToValues (RichEnv -> Prefixes
prefixes RichEnv
re)
in Values
vvs Values -> Values -> Values
forall a. Semigroup a => a -> a -> a
<> Environment -> Values
vms Environment
currentEnv Values -> Values -> Values
forall a. Semigroup a => a -> a -> a
<> Environment -> Values
vps Environment
currentEnv