packages feed

richenv (empty) → 0.1.0.0

raw patch · 15 files changed

+904/−0 lines, 15 filesdep +QuickCheckdep +aesondep +base

Dependencies added: QuickCheck, aeson, base, bytestring, hspec, quickcheck-instances, richenv, text, unordered-containers, yaml

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for richenv++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2023 David Sánchez++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,100 @@+# RichEnv++[![Tests](https://github.com/DavSanchez/richenv/actions/workflows/tests.yml/badge.svg)](https://github.com/DavSanchez/richenv/actions/workflows/tests.yml)+![Hackage Version](https://img.shields.io/hackage/v/:richenv?style=round-square&logo=haskell)+<!-- [![richenv on Stackage LTS](https://stackage.org/package/richenv/badge/lts)](https://stackage.org/lts/package/richenv)+[![richenv on Stackage Nightly](https://stackage.org/package/richenv/badge/nightly)](https://stackage.org/nightly/package/richenv)+[![nixpkgs unstable](https://img.shields.io/badge/nixpkgs-unstable-blue.svg?style=round-square&logo=NixOS&logoColor=white)](https://search.nixos.org/packages?size=1&show=richenv) -->++Rich environment variable setup for Haskell++[![built with nix](https://builtwithnix.org/badge.svg)](https://builtwithnix.org)++This package exposes a type that captures a set of rules that modify an existing environment variable set, be it a provided list of key-value pairs (list of tuples) or the system's environment variable set.++Each rule can be either a prefix, a mapping or a value. Prefixes take environment variable names and prepend a prefix to them, replacing existing prefixes (i.e. fist removing old prefix, then adding the new one) if desired. Mappings replace the name of the environment variable with a different one, and values create the environment variable with the provided value.++## Getting started++The idea behind this library is that you can find a set of rules for setting environment variables that may or may not use the current environment as starting stage, to replace the ones in the current process or pass a custom env to [`System.Process.CreateProcess`](https://hackage.haskell.org/package/process/docs/System-Process.html#t:CreateProcess) to spawn some sub-process.++If your application uses a configuration file, for example in YAML format, you could add a new field to your config like this:++```yaml+# example.yaml+env:+  values:+    VERBOSE: "true"+  mappings:+    NEWNAME: OLDNAME+  prefixes:+    NEW_PREFIX_:+      - PREFIXED_+      - OTHER_PREFIXED_+    OTHER_NEW_PREFIX_: [OTHER_PREFIXED_]+# More configs ...+```++When parsing this new `env` field as the `RichEnv` type (it provides `FromJSON`/`ToJSON` instances), this defines a set of rules:++- `values`: these are simple environment variable definitions with a value (in textual format).+- `mappings`: these will create new environment variables from existing environment variables on an 1-1 basis. In the YAML config above, a `NEWNAME` var will be created with the contents of the `OLDNAME` var.+- `prefixes`: these will create new environment variables from existing environment variable by prefix substitution. In the example, environment variables with the prefixes `OLD_PREFIX_*` and `OTHER_OLD_PREFIX_*` will all be stripped of the prefix and created with the `NEW_PREFIX_*` instead.++Thus, after parsing, you will end up with a set of environment variables that you can:++- Apply to an externally provided list of environment variables and values and then apply the result them to the current process with functions like `setRichEnv`.+- Generate an environment variable list of type `[(Text, Text)]` with `toEnvList`.+- Generate a `[(String, String)]` (with something like `fromEnvironment . toEnvList`) to pass to `System.Process.CreateProcess`.+- etc++You can either provide a list of environment variables (normally of type `[(Text, Text)]`) to apply `RichEnv` rules or use the environment variables from the current process.++### Code example++Assuming you are using the previous YAML example (and a controlled set of environment variables for the current process, see steps 1 and 2 below), you could use `RichEnv` modify the environment variables like this:++```haskell+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}++module Main where++import Data.Aeson (FromJSON, ToJSON)+import Data.Yaml (decodeFileEither)+import Data.Yaml.Aeson (ParseException)+import GHC.Generics (Generic)+import RichEnv (RichEnv (..), clearEnvironment, setRichEnvFromCurrent)+import System.Environment (getEnvironment, setEnv)++newtype SomeConfig = SomeConfig {env :: RichEnv} deriving (Show, Eq, Generic, FromJSON, ToJSON)++main :: IO ()+main = do+  decodedYaml <- decodeFileEither "./example.yaml" :: IO (Either ParseException SomeConfig)+  case decodedYaml of+    Left err -> error $ show err+    Right rEnv -> do+      -- Successfully parsed. Now we can use the RichEnv+      -- 1. clear the environment of the current process+      getEnvironment >>= clearEnvironment+      -- 2. Set an example environment for the current process+      mapM_ (uncurry setEnv) [("FOO", "bar"), ("OLDNAME", "qux"), ("PREFIXED_VAR", "content"), ("OTHER_PREFIXED_VAR2", "content2")]+      -- 3. modify the current environment with the RichEnv+      setRichEnvFromCurrent (env rEnv)+      -- 4. check the environment again+      getEnvironment >>= print++-- printedOutput =+--   [ ("OTHER_NEW_PREFIX_VAR2", "content2"),+--     ("VERBOSE", "true"),+--     ("NEWNAME", "qux"),+--     ("NEW_PREFIX_VAR", "content"),+--     ("NEW_PREFIX_VAR2", "content2")+--   ]+  -- ...+```++As mentioned before, instead of modifying the current process, you use `RichEnv` to spawn processes with custom environments (for example with System.Process' [`proc`](https://hackage.haskell.org/package/process/docs/System-Process.html#v:proc) and [`CreateProcess`](https://hackage.haskell.org/package/process/docs/System-Process.html#t:CreateProcess)' `env` field) defined with your rules, effectively controlling how the environment is forwarded from the current process to the spawned ones.++See the Hackage documentation and [the tests](./test/RichEnvSpec.hs) for more details and examples.
+ richenv.cabal view
@@ -0,0 +1,169 @@+cabal-version:   3.0++-- The cabal-version field refers to the version of the .cabal specification,+-- and can be different from the cabal-install (the tool) version and the+-- Cabal (the library) version you are using. As such, the Cabal (the library)+-- version used must be equal or greater than the version stated in this field.+-- Starting from the specification version 2.2, the cabal-version field must be+-- the first thing in the cabal file.++-- Initial package description 'richenv' generated by+-- 'cabal init'. For further documentation, see:+--   http://haskell.org/cabal/users-guide/+--+-- The name of the package.+name:            richenv++-- The package version.+-- See the Haskell package versioning policy (PVP) for standards+-- guiding when and how versions should be incremented.+-- https://pvp.haskell.org+-- PVP summary:  +-+------- breaking API changes+--               | | +----- non-breaking API additions+--               | | | +--- code changes with no API change+version:         0.1.0.0++-- A short (one-line) description of the package.+synopsis:        Rich environment variable setup for Haskell++-- A longer description of the package.+description:+  This package exposes a type that captures a set of rules to modify an existing environment variable set, be it a provided list of key-value pairs (list of duples) or the system's environment variable set itself. Each rule can be either a prefix, a mapping or a value. See README.md for more details.++-- URL for the project homepage or repository.+homepage:        https://github.com/DavSanchez/richenv++-- The license under which the package is released.+license:         MIT++-- The file containing the license text.+license-file:    LICENSE++-- The package author(s).+author:          David Sánchez++-- An email address to which users can send suggestions, bug reports, and patches.+maintainer:      davidslt+git@pm.me++-- A copyright notice.+copyright:       2023 David Sánchez+category:        Configuration+build-type:      Simple++-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.+extra-doc-files:+  CHANGELOG.md+  README.md++-- Extra source files to be distributed with the package, such as examples, or a tutorial module.+-- extra-source-files:++tested-with:     GHC ==9.2.8 || ==9.4.6++source-repository head+  type:     git+  location: https://github.com/DavSanchez/richenv.git++common common-options+  build-depends:+    , aeson                 >=2.1.0  && <2.3+    , base                  >=4.14   && <5+    , text                  >=2.0    && <3+    , unordered-containers  >=0.2.19 && <0.3++  ghc-options:+    -Wall -Wcompat -Widentities -Wincomplete-uni-patterns+    -Wincomplete-record-updates -Wredundant-constraints+    -Wnoncanonical-monad-instances++  if impl(ghc >=8.2)+    ghc-options: -fhide-source-paths++  if impl(ghc >=8.4)+    ghc-options: -Wmissing-export-lists -Wpartial-fields++  if impl(ghc >=8.8)+    ghc-options: -Wmissing-deriving-strategies -fwrite-ide-info -hiedir=.hie++  if impl(ghc >=8.10)+    ghc-options: -Wunused-packages++  if impl(ghc >=9.0)+    ghc-options: -Winvalid-haddock++  if impl(ghc >=9.2)+    ghc-options: -Wredundant-bang-patterns -Woperator-whitespace++  if impl(ghc >=9.4)+    ghc-options: -Wredundant-strictness-flags++  -- Base language which the package is written in.+  default-language:   Haskell2010+  default-extensions:+    DeriveAnyClass+    DeriveGeneric+    DerivingStrategies+    ImportQualifiedPost+    InstanceSigs+    OverloadedStrings++library+  -- Import common options.+  import:          common-options++  -- Modules exported by the library.+  exposed-modules:+    RichEnv+    RichEnv.Setters+    RichEnv.Types++  -- Modules included in this library but not exported.+  other-modules:+    RichEnv.Types.Mappings+    RichEnv.Types.Prefixes+    RichEnv.Types.Values++  -- LANGUAGE extensions used by modules in this package.+  -- other-extensions:++  -- Other library packages from which modules are imported.+  -- build-depends:++  -- Directories containing source files.+  hs-source-dirs:  src++test-suite richenv-test+  -- Import common options.+  import:             common-options++  -- Modules included in this executable, other than Main.+  other-modules:+    ArbitraryInstances+    RichEnv.SettersSpec+    RichEnvSpec+    SpecHook++  -- LANGUAGE extensions used by modules in this package.+  -- other-extensions:++  -- The interface type and version of the test suite.+  type:               exitcode-stdio-1.0++  -- Directories containing source files.+  hs-source-dirs:     test++  -- The entrypoint to the test suite.+  main-is:            Spec.hs++  -- Test dependencies.+  build-depends:+    , aeson+    , bytestring            >=0.11   && <0.13+    , hspec                 >=2.10   && <2.12+    , QuickCheck            >=2.14   && <2.15+    , quickcheck-instances  >=0.3.29 && <0.4+    , richenv+    , yaml                  >=0.11   && <0.12++  -- , process               >=1.6    && <1.7+  build-tool-depends: hspec-discover:hspec-discover
+ src/RichEnv.hs view
@@ -0,0 +1,81 @@+-- | This module provides functions to set environment variables or retrieve an environment variable list according to a 'RichEnv' object input, which defines:+--+-- * A list of environment variables to be set with their values.+-- * Mapping the name from one existing environment variable name to another (If there's an environment variable @__FOO=bar__@, a mapping @__(\"SOME\", \"FOO\")__@ will generate an environment variable definition @__SOME__@ with the contents of the variable @__FOO__@).+-- * Mapping the prefixes of existing environment variables to a new prefix (If there's an environment variable @__FOO_VAR=bar__@, a prefix mapping @__(\"SOME\", [\"FOO\"])__@ will generate an environment variable definition @__SOME_VAR__@ with the contents of the variable @__FOO_VAR__@).+module RichEnv+  ( -- * Types+    RichEnv (..),+    Environment,++    -- * Environment transformations+    toEnvList,+    toEnvMap,++    -- * Functions using 'IO' to get the environment from the current process+    setRichEnv,+    setRichEnvFromCurrent,+    toEnvListFromCurrent,+    toEnvMapFromCurrent,+    clearEnvironment,+  )+where++import Data.HashMap.Strict qualified as HM+import Data.Text (Text)+import RichEnv.Setters (richEnvToValues, valuesToEnv, valuesToEnvList)+import RichEnv.Types (Environment, RichEnv (..), fromEnvironment, toEnvironment)+import RichEnv.Types.Values (Values (unValues))+import System.Environment (getEnvironment, unsetEnv)++-- | Get a key-value list of environment variables processing the passed environment with the 'RichEnv' input.+--+-- > toEnvList re env = valuesToEnvList (toEnvValues re env)+toEnvList :: RichEnv -> Environment -> Environment+toEnvList re = valuesToEnvList . toEnvValues re++-- | Get a hashmap of environment variables processing the passed environment with the 'RichEnv' input. The idea is that the output could be passed to functions like [Yaml](https://hackage.haskell.org/package/yaml)'s [applyEnvValue](https://hackage.haskell.org/package/yaml/docs/Data-Yaml-Config.html#v:applyEnvValue).+--+-- > toEnvMap re env = unValues (toEnvValues re env)+toEnvMap :: RichEnv -> Environment -> HM.HashMap Text Text+toEnvMap re = unValues . toEnvValues re++-- | Builds a 'Values' object from the 'RichEnv' input and a list of environment variables.+toEnvValues :: RichEnv -> Environment -> Values+toEnvValues = richEnvToValues++-- | Sets the environment variables available for the current process abiding to the 'RichEnv' rules.+setRichEnv :: RichEnv -> Environment -> IO ()+setRichEnv re env = do+  clearEnvironment $ fromEnvironment env+  valuesToEnv (richEnvToValues re env)++-- | Sets the environment variables available for the current process by checking the current environment variables and applying the 'RichEnv' rules.+--+-- > setRichEnvFromCurrent re = getEnvironment >>= setRichEnv re . toEnvironment+setRichEnvFromCurrent :: RichEnv -> IO ()+setRichEnvFromCurrent re = getEnvironment >>= setRichEnv re . toEnvironment++-- | Get a key-value list of environment variables processing the current environment with the 'RichEnv' input.+--+-- > toEnvListFromCurrent re = toEnvList re . toEnvironment <$> getEnvironment+toEnvListFromCurrent :: RichEnv -> IO Environment+toEnvListFromCurrent re = toEnvList re . toEnvironment <$> getEnvironment++-- | Get a hashmap of environment variables processing the current environment with the 'RichEnv' input. The idea is that the output could be passed to functions like [Yaml](https://hackage.haskell.org/package/yaml)'s [applyEnvValue](https://hackage.haskell.org/package/yaml/docs/Data-Yaml-Config.html#v:applyEnvValue).+--+-- > toEnvMapFromCurrent re = toEnvMap re . toEnvironment <$> getEnvironment+toEnvMapFromCurrent :: RichEnv -> IO (HM.HashMap Text Text)+toEnvMapFromCurrent re = toEnvMap re . toEnvironment <$> getEnvironment++-- | Builds a 'Values' object from the 'RichEnv' input and the current environment variables.+--+-- > toEnvValuesFromCurrent re = toEnvValues re . toEnvironment <$> getEnvironment+_toEnvValuesFromCurrent :: RichEnv -> IO Values+_toEnvValuesFromCurrent re = toEnvValues re . toEnvironment <$> getEnvironment++-- | Clears all environment variables of the current process.+clearEnvironment ::+  [(String, String)] ->+  IO ()+clearEnvironment = mapM_ (unsetEnv . fst)
+ src/RichEnv/Setters.hs view
@@ -0,0 +1,105 @@+-- | This module contains functions for setting environment variables from the 'RichEnv' types as well as functions for transforming between the different types used by this library ('Values', 'Mappings' and 'Prefixes').+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)++-- | Takes a 'Values' object and sets its contents as environment variables.+valuesToEnv :: Values -> IO ()+valuesToEnv = mapM_ (uncurry setEnv) . fromEnvironment . HM.toList . unValues++-- | Takes a 'Values' object and transforms it into a list of key-value pairs representing environment variables.+--+-- > valuesToEnvList = Data.HashMap.Strict.toList . unValues+valuesToEnvList :: Values -> Environment+valuesToEnvList = HM.toList . unValues++-- | Takes an environment variable list and all the name mappings and prepares a set of environment variables according to the RichEnv rules.+--+-- >>> mappingsToValues [("FOO", "bar"), ("SOME", "thing")] (Mappings $ HM.fromList [("OTHER", "FOO")])+-- Values {unValues = fromList [("OTHER","bar")]}+mappingsToValues :: Environment -> Mappings -> Values+mappingsToValues _ (Mappings m) | null m = mempty+mappingsToValues currentEnv m =+  let mappings' = unMappings m+      value from = lookup from currentEnv+      setMappingValue _ Nothing = id+      setMappingValue k (Just v) = HM.insert k v+      mappingsToValues' k v = setMappingValue k (value v)+   in Values $ HM.foldrWithKey' mappingsToValues' mempty mappings'++-- | Takes an environment variable list and all the prefix mappings and prepares a set of environment variables according to the 'RichEnv' rules.+--+-- >>> prefixesToValues [("FOO", "bar"), ("SOME", "thing")] (Prefixes $ HM.fromList [("OTHER", ["FOO"])])+-- Values {unValues = fromList [("OTHER","bar")]}+prefixesToValues :: Environment -> Prefixes -> Values+prefixesToValues _ (Prefixes p) | null p = mempty+prefixesToValues currentEnv p =+  let prefixes' = unPrefixes p+      prefixesToValues' k v env = env <> setNewPrefix k v currentEnv+      res = if null prefixes' then currentEnv else HM.foldrWithKey' prefixesToValues' mempty prefixes'+   in toValues res++-- | Replace the prefixes of the environment variables with a new prefix.+setNewPrefix ::+  -- | New prefix+  Text ->+  -- | Old prefixes+  [Text] ->+  -- | Current environment list+  Environment ->+  -- | Updated environment list+  Environment+setNewPrefix newPrefix [] currentEnv = fmap (first (newPrefix <>)) currentEnv+setNewPrefix newPrefix [""] currentEnv = fmap (first (newPrefix <>)) currentEnv+setNewPrefix newPrefix oldPrefixes currentEnv =+  let varsWithoutPrefixes = removePrefix currentEnv <$> oldPrefixes+      newPrefixedVars = (fmap . fmap) (first (newPrefix <>)) varsWithoutPrefixes+   in mconcat newPrefixedVars++-- | Remove a prefix from the environment variables.+removePrefix :: Environment -> Text -> Environment+removePrefix currentEnv oldPrefix =+  let getWithoutPrefix old (k, v) = T.stripPrefix old k >>= \sk -> pure (sk, v)+   in mapMaybe (getWithoutPrefix oldPrefix) currentEnv++-- | Create a 'Values' object from an 'Environment'.+toValues :: Environment -> Values+toValues = Values . HM.fromList++-- | Takes an environment variable list and a 'RichEnv' object and generates a 'Values' object.+--+-- >>> richEnvToValues RichEnv.Types.defaultRichEnv [("FOO", "bar"), ("SOME", "thing")]+-- Values {unValues = fromList []}+--+-- >>> import RichEnv.Types.Values as V+-- >>> let richEnvValue = RichEnv.Types.defaultRichEnv { values = V.fromList [("OTHER", "var")]}+-- >>> let envList = [("FOO", "bar"), ("SOME", "thing")]+-- >>> richEnvToValues richEnvValue envList+-- Values {unValues = fromList [("OTHER","var")]}+--+-- >>> import RichEnv.Types.Mappings as M+-- >>> let richEnvValue = RichEnv.Types.defaultRichEnv { mappings = M.fromList [("SOME", "FOO")]}+-- >>> let envList = [("FOO", "bar"), ("SOME", "thing"), ("SOME", "other")]+-- >>> richEnvToValues richEnvValue envList+-- Values {unValues = fromList [("SOME","bar")]}+--+-- >>> import RichEnv.Types.Prefixes as P+-- >>> let richEnvValue = RichEnv.Types.defaultRichEnv { prefixes = P.fromList [("NEW_", ["PREFIXED_"])]}+-- >>> let envList = [("PREFIXED_VAR", "content"), ("PREFIXED_VAR2", "content2")]+-- >>> richEnvToValues richEnvValue envList+-- Values {unValues = fromList [("NEW_VAR","content"),("NEW_VAR2","content2")]}+richEnvToValues :: RichEnv -> Environment -> Values+richEnvToValues re currentEnv =+  let vvs = values re+      vms = flip mappingsToValues (mappings re)+      vps = flip prefixesToValues (prefixes re)+   in vvs <> vms currentEnv <> vps currentEnv
+ src/RichEnv/Types.hs view
@@ -0,0 +1,59 @@+-- | This module contains the basic types used by the library and their typeclass instances.+module RichEnv.Types+  ( -- * Types+    RichEnv (..),+    defaultRichEnv,+    Environment,+    Mappings (..),+    Values (..),+    Prefixes (..),++    -- * Environment transformations+    toEnvironment,+    fromEnvironment,+  )+where++import Data.Aeson (FromJSON, ToJSON)+import Data.Bifunctor (bimap)+import Data.Text (Text)+import Data.Text qualified as T+import GHC.Generics (Generic)+import RichEnv.Types.Mappings (Mappings (..))+import RichEnv.Types.Prefixes (Prefixes (..))+import RichEnv.Types.Values (Values (..))++-- | A list of key-value pairs representing environment variables.+type Environment = [(Text, Text)]++-- | Get back a @[(String, String)]@ from an 'Environment'.+fromEnvironment :: Environment -> [(String, String)]+fromEnvironment = fmap (bimap T.unpack T.unpack)++-- | Transform the type returned from 'System.Environment.getEnvironment' (@[(String, String)]@) to use 'Text' instead.+toEnvironment :: [(String, String)] -> Environment+toEnvironment = fmap (bimap T.pack T.pack)++-- | Type that represents a set of rules that generate environment variables. A value of this type can be retrieved from a configuration file (e.g. YAML) due to its 'FromJSON' instance, or persisted into one with 'ToJSON'.+data RichEnv = RichEnv+  { -- | A list of environment variables to be set with their values.+    values :: Values,+    -- | Mappings from one existing environment variable name to another.+    mappings :: Mappings,+    -- | Mappings from different prefixes of existing environment variables to new prefixes.+    prefixes :: Prefixes+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (FromJSON, ToJSON)++instance Semigroup RichEnv where+  (<>) :: RichEnv -> RichEnv -> RichEnv+  (<>) (RichEnv a b c) (RichEnv d e f) = RichEnv (a <> d) (b <> e) (c <> f)++instance Monoid RichEnv where+  mempty :: RichEnv+  mempty = RichEnv mempty mempty mempty++-- | Default 'RichEnv' value. With everything empty.+defaultRichEnv :: RichEnv+defaultRichEnv = mempty
+ src/RichEnv/Types/Mappings.hs view
@@ -0,0 +1,32 @@+-- | This module contains the 'Mappings' type, which is used to store environment variable name mappings, and its typeclass instances.+module RichEnv.Types.Mappings (Mappings (Mappings, unMappings), fromList) where++import Data.Aeson (FromJSON (parseJSON), Options (unwrapUnaryRecords), ToJSON (toJSON), Value, defaultOptions, genericParseJSON)+import Data.Aeson.Types (Parser)+import Data.HashMap.Strict qualified as HM+import Data.Text (Text)+import GHC.Generics (Generic)++-- | A list of key-value pairs representing environment variable name mappings. The internal representation is a 'HashMap Text Text', where the key is the final variable name and the value is the current one which will be replaced.+newtype Mappings = Mappings {unMappings :: HM.HashMap Text Text}+  deriving stock (Eq, Show, Generic)++instance FromJSON Mappings where+  parseJSON :: Value -> Parser Mappings+  parseJSON = genericParseJSON $ defaultOptions {unwrapUnaryRecords = True}++instance ToJSON Mappings where+  toJSON :: Mappings -> Value+  toJSON = toJSON . unMappings++instance Semigroup Mappings where+  (<>) :: Mappings -> Mappings -> Mappings+  (<>) (Mappings a) (Mappings b) = Mappings (a <> b)++instance Monoid Mappings where+  mempty :: Mappings+  mempty = Mappings mempty++-- | Build a 'Mappings' object from a list of key-value pairs.+fromList :: [(Text, Text)] -> Mappings+fromList = Mappings . HM.fromList
+ src/RichEnv/Types/Prefixes.hs view
@@ -0,0 +1,32 @@+-- | This module contains the 'Prefixes' type, which is used to store environment variable name prefix mappings, and its typeclass instances.+module RichEnv.Types.Prefixes (Prefixes (Prefixes, unPrefixes), fromList) where++import Data.Aeson (FromJSON (parseJSON), Options (unwrapUnaryRecords), ToJSON (toJSON), Value, defaultOptions, genericParseJSON)+import Data.Aeson.Types (Parser)+import Data.HashMap.Strict qualified as HM+import Data.Text (Text)+import GHC.Generics (Generic)++-- | A list of key-value pairs representing environment variable name prefix mappings. The internal representation is a 'HashMap Text [Text]', where the key is the final prefix and the value is the list of prefixes that will be replaced.+newtype Prefixes = Prefixes {unPrefixes :: HM.HashMap Text [Text]}+  deriving stock (Eq, Show, Generic)++instance FromJSON Prefixes where+  parseJSON :: Value -> Parser Prefixes+  parseJSON = genericParseJSON $ defaultOptions {unwrapUnaryRecords = True}++instance ToJSON Prefixes where+  toJSON :: Prefixes -> Value+  toJSON = toJSON . unPrefixes++instance Semigroup Prefixes where+  (<>) :: Prefixes -> Prefixes -> Prefixes+  (<>) (Prefixes a) (Prefixes b) = Prefixes (a <> b)++instance Monoid Prefixes where+  mempty :: Prefixes+  mempty = Prefixes mempty++-- | Build a 'Prefixes' object from a list of key-value pairs.+fromList :: [(Text, [Text])] -> Prefixes+fromList = Prefixes . HM.fromList
+ src/RichEnv/Types/Values.hs view
@@ -0,0 +1,32 @@+-- | This module contains the 'Values' type, which stores environment variable names and values, and its typeclass instances.+module RichEnv.Types.Values (Values (Values, unValues), fromList) where++import Data.Aeson (FromJSON (parseJSON), Options (unwrapUnaryRecords), ToJSON (toJSON), Value, defaultOptions, genericParseJSON)+import Data.Aeson.Types (Parser)+import Data.HashMap.Strict qualified as HM+import Data.Text (Text)+import GHC.Generics (Generic)++-- | A list of key-value pairs representing environment variables. The internal representation is a 'HashMap Text Text', where the key is the variable name and the value is the variable value.+newtype Values = Values {unValues :: HM.HashMap Text Text}+  deriving stock (Eq, Show, Generic)++instance FromJSON Values where+  parseJSON :: Value -> Parser Values+  parseJSON = genericParseJSON $ defaultOptions {unwrapUnaryRecords = True}++instance ToJSON Values where+  toJSON :: Values -> Value+  toJSON = toJSON . unValues++instance Semigroup Values where+  (<>) :: Values -> Values -> Values+  (<>) (Values a) (Values b) = Values (a <> b)++instance Monoid Values where+  mempty :: Values+  mempty = Values mempty++-- | Build a 'Values' object from a list of key-value pairs.+fromList :: [(Text, Text)] -> Values+fromList = Values . HM.fromList
+ test/ArbitraryInstances.hs view
@@ -0,0 +1,24 @@+{-# OPTIONS_GHC -Wno-orphans #-}++module ArbitraryInstances () where++import Data.HashMap.Strict qualified as HM+import RichEnv.Types (Mappings (..), Prefixes (..), RichEnv (..), Values (..))+import Test.QuickCheck (Arbitrary (arbitrary), Gen)+import Test.QuickCheck.Instances.Text ()++instance Arbitrary RichEnv where+  arbitrary :: Gen RichEnv+  arbitrary = RichEnv <$> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary Values where+  arbitrary :: Gen Values+  arbitrary = Values . HM.fromList <$> arbitrary++instance Arbitrary Mappings where+  arbitrary :: Gen Mappings+  arbitrary = Mappings . HM.fromList <$> arbitrary++instance Arbitrary Prefixes where+  arbitrary :: Gen Prefixes+  arbitrary = Prefixes . HM.fromList <$> arbitrary
+ test/RichEnv/SettersSpec.hs view
@@ -0,0 +1,44 @@+module RichEnv.SettersSpec (spec) where++import Data.HashMap.Strict qualified as HM+import RichEnv.Setters (mappingsToValues, prefixesToValues)+import RichEnv.Types (Environment, Mappings (..), Prefixes (..), Values (..))+import Test.Hspec (Spec, describe, it, shouldBe)++spec :: Spec+spec = do+  describe "mappings" $ do+    it "returns an empty environment when given an empty set" $+      mappingsToValues mempty mempty+        `shouldBe` mempty+    it "remaps a single environment variable" $+      mappingsToValues exampleEnv (Mappings $ HM.singleton "SOME" "FOO")+        `shouldBe` Values (HM.singleton "SOME" "bar")+  describe "prefixes" $ do+    it "returns an empty environment when given an empty set" $+      prefixesToValues mempty mempty+        `shouldBe` mempty+    it "remaps a single environment variable" $+      prefixesToValues exampleEnv (Prefixes $ HM.singleton "NEW_" ["PREFIXED_"])+        `shouldBe` Values (HM.fromList [("NEW_VAR", "content"), ("NEW_VAR2", "content2")])+    it "passes all environment variables adding a prefix" $+      prefixesToValues exampleEnv (Prefixes $ HM.singleton "NEWPREFIX_" [""])+        `shouldBe` Values (HM.fromList [("NEWPREFIX_FOO", "bar"), ("NEWPREFIX_BAZ", "qux"), ("NEWPREFIX_PREFIXED_VAR", "content"), ("NEWPREFIX_PREFIXED_VAR2", "content2")])+    it "remaps prefixed environment variables removing the prefix" $+      prefixesToValues exampleEnv (Prefixes $ HM.singleton "" ["PREFIXED_"])+        `shouldBe` Values (HM.fromList [("VAR", "content"), ("VAR2", "content2")])+    it "passes only prefixed environment variables preserving the prefix" $+      prefixesToValues exampleEnv (Prefixes $ HM.singleton "PREFIXED_" ["PREFIXED_"])+        `shouldBe` Values (HM.fromList [("PREFIXED_VAR", "content"), ("PREFIXED_VAR2", "content2")])+    it "passes all environment variables" $+      prefixesToValues exampleEnv mempty+        `shouldBe` Values mempty+    it "passes multiple prefixes to multiple new prefixes" $+      prefixesToValues exampleEnv (Prefixes $ HM.fromList [("NEWPREFIX_", [""]), ("", ["PREFIXED_"])])+        `shouldBe` Values (HM.fromList [("NEWPREFIX_FOO", "bar"), ("NEWPREFIX_BAZ", "qux"), ("NEWPREFIX_PREFIXED_VAR", "content"), ("NEWPREFIX_PREFIXED_VAR2", "content2"), ("VAR", "content"), ("VAR2", "content2")])+    it "passes multiple prefixes to a single new prefix" $+      prefixesToValues exampleEnv (Prefixes $ HM.fromList [("NEWPREFIX_", ["BA", "PREFIXED_"])])+        `shouldBe` Values (HM.fromList [("NEWPREFIX_Z", "qux"), ("NEWPREFIX_VAR", "content"), ("NEWPREFIX_VAR2", "content2")])+  where+    exampleEnv :: Environment+    exampleEnv = [("FOO", "bar"), ("BAZ", "qux"), ("PREFIXED_VAR", "content"), ("PREFIXED_VAR2", "content2")]
+ test/RichEnvSpec.hs view
@@ -0,0 +1,194 @@+module RichEnvSpec (spec) where++import ArbitraryInstances ()+import Control.Exception (displayException)+import Data.Aeson qualified as JSON+import Data.ByteString qualified as B+import Data.ByteString.Char8 qualified as C8+import Data.HashMap.Strict qualified as HM+import Data.List (sort)+import Data.Text qualified as T+import Data.Yaml qualified as Yaml+import GHC.Generics (Generic)+import RichEnv (clearEnvironment, setRichEnvFromCurrent, toEnvListFromCurrent)+import RichEnv.Types (Environment, Mappings (Mappings), Prefixes (Prefixes), RichEnv (..), Values (Values), defaultRichEnv, fromEnvironment, toEnvironment)+import System.Environment (getEnvironment, setEnv)+-- import System.Process (CreateProcess (env, std_out), StdStream (CreatePipe), proc, readCreateProcess)+import Test.Hspec (Expectation, Spec, context, describe, it, shouldBe)+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck (Arbitrary (arbitrary), Gen)++spec :: Spec+spec = describe "RichEnv ops" $ do+  context "setting environment" $ do+    it "set a single environment variable through RichEnv" $ do+      clearEnv+      setRichEnvFromCurrent+        RichEnv+          { values = Values $ HM.fromList [("SOME", "var")],+            mappings = mempty,+            prefixes = mempty+          }+      testEnv [("SOME", "var")]+    it "set multiple environment variables through RichEnv" $ do+      clearEnv+      setRichEnvFromCurrent+        defaultRichEnv+          { values = Values $ HM.fromList [("SOME", "var"), ("OTHER", "othervar")]+          }+      testEnv [("SOME", "var"), ("OTHER", "othervar")]+    it "remaps existing environment variables" $ do+      clearEnv+      setTestEnv exampleEnv+      setRichEnvFromCurrent+        defaultRichEnv+          { mappings = Mappings $ HM.fromList [("SOME", "FOO")]+          }+      testEnv [("SOME", "bar")]+    it "remaps prefixed variables" $ do+      clearEnv+      setTestEnv exampleEnv+      setRichEnvFromCurrent+        defaultRichEnv+          { prefixes = Prefixes $ HM.fromList [("NEW_", ["PREFIXED_"])]+          }+      testEnv [("NEW_VAR", "content"), ("NEW_VAR2", "content2")]+  context "getting the environment variable list" $ do+    it "gets the environment variable list" $ do+      clearEnv+      setTestEnv exampleEnv+      testEnvList+        [("SOME", "bar")]+        defaultRichEnv+          { mappings = Mappings $ HM.fromList [("SOME", "FOO")]+          }+    it "gets the environment variable list with prefixes" $ do+      clearEnv+      setTestEnv exampleEnv+      testEnvList+        [("NEW_VAR", "content"), ("NEW_VAR2", "content2")]+        ( defaultRichEnv+            { prefixes = Prefixes $ HM.fromList [("NEW_", ["PREFIXED_"])]+            }+        )++  context "working with YAML" $ it "parses a YAML file into expected results" $ do+    clearEnv+    setTestEnv fileTestsBaseEnv+    let res = Yaml.decodeEither' yamlTestCase :: Either Yaml.ParseException TestType+    case res of+      Left err -> fail $ show err+      Right actual -> testEnvList fileTestsCaseExpected (environ actual)++  context "working with JSON" $ it "parses a JSON file into expected results" $ do+    clearEnv+    setTestEnv fileTestsBaseEnv+    let res = JSON.eitherDecodeStrict jsonTestCase :: Either String TestType+    case res of+      Left err -> fail err+      Right actual -> testEnvList fileTestsCaseExpected (environ actual)++  context "invariants" $ do+    prop "parsing YAML from and to a RichEnv should end in the original value" $ \re -> do+      let yaml = Yaml.encode re+          res = Yaml.decodeEither' yaml :: Either Yaml.ParseException RichEnv+       in case res of+            Left err -> fail $ displayException err+            Right actual -> do+              actual `shouldBe` re+    prop "parsing JSON from and to a RichEnv should end in the original value" $ \re -> do+      let json = JSON.encode re+          res = JSON.eitherDecode' json :: Either String RichEnv+       in case res of+            Left err -> fail err+            Right actual -> do+              actual `shouldBe` re++--   context "Working with System.Process" $ do+--     it "should work with System.Process" $ do+--       clearEnv+--       setTestEnv exampleEnv+--       envList <-+--         toEnvListFromCurrent+--           ( RichEnv+--               { prefixes = Prefixes $ HM.singleton "NEW_" ["PREFIXED_"],+--                 mappings = Mappings $ HM.singleton "SOME" "FOO",+--                 values = Values $ HM.singleton "OTHER" "othervar"+--               }+--           )+--       let envProcess = (proc "env" []) {env = Just (fromEnvironment envList), std_out = CreatePipe}+--       out <- lines <$> readCreateProcess envProcess mempty+--       sort out `shouldBe` sort ["NEW_VAR=content", "NEW_VAR2=content2", "OTHER=othervar", "SOME=bar"]++exampleEnv :: [(T.Text, T.Text)]+exampleEnv = [("FOO", "bar"), ("BAZ", "qux"), ("PREFIXED_VAR", "content"), ("PREFIXED_VAR2", "content2")]++clearEnv :: IO ()+clearEnv = getEnvironment >>= clearEnvironment++setTestEnv :: Environment -> IO ()+setTestEnv = mapM_ (uncurry setEnv) . fromEnvironment++testEnv :: Environment -> Expectation+testEnv expected = getEnvironment >>= (`shouldBe` sort expected) . sort . toEnvironment++testEnvList :: Environment -> RichEnv -> Expectation+testEnvList expected re = toEnvListFromCurrent re >>= (`shouldBe` sort expected) . sort++newtype TestType = TestType+  { environ :: RichEnv+  }+  deriving stock (Eq, Show, Generic)+  deriving anyclass (JSON.FromJSON, JSON.ToJSON)++instance Arbitrary TestType where+  arbitrary :: Gen TestType+  arbitrary = TestType <$> arbitrary++-- Test cases that use Aeson's FromJSON/ToJSON instances++yamlTestCase :: B.ByteString+yamlTestCase =+  C8.pack $+    unlines+      [ "environ:",+        "  values:",+        "    SOME: somevar",+        "    OTHER: othervar",+        "  mappings:",+        "    FOO: SOME",+        "  prefixes:",+        "    NEW_: [PREFIXED_]"+      ]++jsonTestCase :: B.ByteString+jsonTestCase =+  C8.pack $+    unlines+      [ "{",+        "  \"environ\": {",+        "    \"values\": {",+        "      \"SOME\": \"somevar\",",+        "      \"OTHER\": \"othervar\"",+        "    },",+        "    \"mappings\": {",+        "      \"FOO\": \"SOME\"",+        "    },",+        "    \"prefixes\": {",+        "      \"NEW_\": [\"PREFIXED_\"]",+        "    }",+        "  }",+        "}"+      ]++fileTestsBaseEnv :: Environment+fileTestsBaseEnv = [("SOME", "bar"), ("OTHER", "othervar"), ("PREFIXED_VAR", "content"), ("PREFIXED_VAR2", "content2")]++fileTestsCaseExpected :: Environment+fileTestsCaseExpected =+  [ ("FOO", "bar"),+    ("OTHER", "othervar"),+    ("SOME", "somevar"),+    ("NEW_VAR", "content"),+    ("NEW_VAR2", "content2")+  ]
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/SpecHook.hs view
@@ -0,0 +1,6 @@+module SpecHook (hook) where++import Test.Hspec (Spec, parallel)++hook :: Spec -> Spec+hook = parallel