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 = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> IO ()
setEnv) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> [(String, String)]
fromEnvironment forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
HM.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Values -> HashMap Text Text
unValues
valuesToEnvList :: Values -> Environment
valuesToEnvList :: Values -> Environment
valuesToEnvList = forall k v. HashMap k v -> [(k, v)]
HM.toList 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) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap Text Text
m = 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 = 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 = forall a. a -> a
id
setMappingValue k
k (Just v
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 = 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 forall a b. (a -> b) -> a -> b
$ forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HM.foldrWithKey' forall {k}.
Hashable k =>
k -> Text -> HashMap k Text -> HashMap k Text
mappingsToValues' 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) | forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap Text [Text]
p = 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 forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Environment -> Environment
setNewPrefix Text
k [Text]
v Environment
currentEnv
res :: Environment
res = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap Text [Text]
prefixes' then Environment
currentEnv else forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HM.foldrWithKey' Text -> [Text] -> Environment -> Environment
prefixesToValues' 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text
newPrefix forall a. Semigroup a => a -> a -> a
<>)) Environment
currentEnv
setNewPrefix Text
newPrefix [Text
""] Environment
currentEnv = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text
newPrefix 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
oldPrefixes
newPrefixedVars :: [Environment]
newPrefixedVars = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text
newPrefix forall a. Semigroup a => a -> a -> a
<>)) [Environment]
varsWithoutPrefixes
in 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
sk -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
sk, b
v)
in forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip Environment -> Mappings -> Values
mappingsToValues (RichEnv -> Mappings
mappings RichEnv
re)
vps :: Environment -> Values
vps = forall a b c. (a -> b -> c) -> b -> a -> c
flip Environment -> Prefixes -> Values
prefixesToValues (RichEnv -> Prefixes
prefixes RichEnv
re)
in Values
vvs forall a. Semigroup a => a -> a -> a
<> Environment -> Values
vms Environment
currentEnv forall a. Semigroup a => a -> a -> a
<> Environment -> Values
vps Environment
currentEnv