feat: use autodocodec

default.nix

@@ -1,13 +1,16 @@
-{ mkDerivation, base, hashable, hspec, hspec-discover, lib
-, QuickCheck, unordered-containers
+{ mkDerivation, aeson, autodocodec, base, bytestring, hashable
+, hspec, hspec-discover, lib, QuickCheck, unordered-containers
+, yaml
 }:
 mkDerivation {
   pname = "richenv";
   version = "0.1.0.0";
   src = ./.;
-  libraryHaskellDepends = [ base hashable unordered-containers ];
+  libraryHaskellDepends = [
+    aeson autodocodec base hashable unordered-containers
+  ];
   testHaskellDepends = [
-    base hspec QuickCheck unordered-containers
+    base bytestring hspec QuickCheck unordered-containers yaml
   ];
   testToolDepends = [ hspec-discover ];
   doHaddock = false;

internal/RichEnv/Filters.hs

@@ -8,8 +8,9 @@ import RichEnv.Types (RichEnv, RichEnvItem (..), VarMap (..), VarPrefix (..), Va
 --
 -- >>> varValues S.empty == S.empty
 -- True
--- >>> let richEnv = S.fromList [EnvVarValue (VarValue "foo" "bar"), EnvVarNameMap (VarMap "bar" "baz"), EnvVarPrefix (VarPrefix "qux" "quux")]
--- >>> varValues richEnv == S.fromList [VarValue "foo" "bar"]
+-- >>> import Data.List.NonEmpty (fromList)
+-- >>> let richEnv = S.fromList [EnvVarValue (VarValue (fromList "foo") "bar"), EnvVarNameMap (VarMap (fromList "bar") (fromList "baz")), EnvVarPrefix (VarPrefix "qux" "quux")]
+-- >>> varValues richEnv == S.fromList [VarValue (fromList "foo") "bar"]
 -- True
 varMaps :: RichEnv -> HashSet VarMap
 varMaps = S.foldr f S.empty
@@ -21,8 +22,9 @@ varMaps = S.foldr f S.empty
 --
 -- >>> varValues S.empty == S.empty
 -- True
--- >>> let richEnv = S.fromList [EnvVarValue (VarValue "foo" "bar"), EnvVarNameMap (VarMap "bar" "baz"), EnvVarPrefix (VarPrefix "qux" "quux")]
--- >>> varValues richEnv == S.fromList [VarValue "foo" "bar"]
+-- >>> import Data.List.NonEmpty (fromList)
+-- >>> let richEnv = S.fromList [EnvVarValue (VarValue (fromList "foo") "bar"), EnvVarNameMap (VarMap (fromList "bar") (fromList "baz")), EnvVarPrefix (VarPrefix "qux" "quux")]
+-- >>> varValues richEnv == S.fromList [VarValue (fromList "foo") "bar"]
 -- True
 varValues :: RichEnv -> HashSet VarValue
 varValues = S.foldr f S.empty
@@ -34,7 +36,8 @@ varValues = S.foldr f S.empty
 --
 -- >>> varPrefixes S.empty == S.empty
 -- True
--- >>> let richEnv = S.fromList [EnvVarValue (VarValue "foo" "bar"), EnvVarNameMap (VarMap "bar" "baz"), EnvVarPrefix (VarPrefix "qux" "quux")]
+-- >>> import Data.List.NonEmpty (fromList)
+-- >>> let richEnv = S.fromList [EnvVarValue (VarValue (fromList "foo") "bar"), EnvVarNameMap (VarMap (fromList "bar") (fromList "baz")), EnvVarPrefix (VarPrefix "qux" "quux")]
 -- >>> varPrefixes richEnv == S.fromList [VarPrefix "qux" "quux"]
 -- True
 varPrefixes :: RichEnv -> HashSet VarPrefix

internal/RichEnv/Setters.hs

@@ -13,20 +13,16 @@ import System.Environment (setEnv)
 -- | Takes 'VarValue's and sets them as environment variables. It is a no-op if the variable name is empty.
 --
 -- >>> import System.Environment
--- >>> value <- setVarValueEnv (VarValue "foo" "bar") >> getEnv "foo"
+-- >>> import Data.List.NonEmpty (fromList)
+-- >>> value <- setVarValueEnv (VarValue (fromList "foo") "bar") >> getEnv "foo"
 -- >>> value == "bar"
 -- True
 -- >>> import System.Environment
+-- >>> import Data.List.NonEmpty (fromList)
 -- >>> getEnvironment >>= mapM_ (unsetEnv . fst)
--- >>> value <- setVarValueEnv (VarValue "foo" "bar") >> getEnv "foo"
+-- >>> value <- setVarValueEnv (VarValue (fromList "foo") "bar") >> getEnv "foo"
 -- >>> value == "bar"
 -- True
--- >>> import System.Environment
--- >>> env <- getEnvironment
--- >>> setVarValueEnv (VarValue "" "bar")
--- >>> newEnv <- getEnvironment
--- >>> env == newEnv
--- True
 setVarValueEnv :: VarValue -> IO ()
 setVarValueEnv vv = do
   let name = toList $ vvName vv

internal/RichEnv/Types.hs

@@ -1,10 +1,14 @@
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE InstanceSigs #-}
 
-module RichEnv.Types (RichEnvItem (..), VarMap (..), VarPrefix (..), VarValue (..), RichEnv, Environment) where
+module RichEnv.Types (RichEnvItem (..), VarMap (..), VarPrefix (..), VarValue (..), RichEnv, Environment, NonEmptyString) where
 
+import Data.Aeson (Encoding, FromJSON, ToJSON (..), Value, withObject, (.:), (.:?))
+import Data.Aeson.Types (FromJSON (..), Parser)
 import Data.HashSet (HashSet)
 import Data.Hashable (Hashable)
-import Data.List.NonEmpty (NonEmpty)
+import Data.List.NonEmpty (NonEmpty, fromList)
 import GHC.Generics (Generic)
 
 type RichEnv = HashSet RichEnvItem
@@ -21,6 +25,39 @@ data RichEnvItem
   | -- | Maps all environment variables with a certain prefix to a new set of environment variables with a different prefix.
     EnvVarPrefix VarPrefix
   deriving stock (Eq, Show, Generic)
+  deriving anyclass (Hashable)
+
+instance FromJSON RichEnvItem where
+  parseJSON :: Value -> Parser RichEnvItem
+  parseJSON = withObject "RichEnvItem" $ \o -> do
+    name <- o .: "name"
+    from <- o .:? "from"
+    value <- o .:? "value"
+    case (name, from, value) of
+      (Just n, Nothing, Just v) -> pure $ EnvVarValue $ VarValue (fromList n) v
+      (Just n, Just f, Nothing) -> do
+        if '*' `notElem` n && '*' `notElem` f
+          then pure $ EnvVarNameMap $ VarMap (fromList n) (fromList f)
+          else do
+            let n' = init n
+                f' = init f
+            if '*' `notElem` n' && '*' `notElem` f'
+              then pure $ EnvVarPrefix $ VarPrefix n' f'
+              else fail "VarMap `name` and `from` must end with a `*` and not contain `*` anywhere else."
+      (Nothing, _, _) -> fail "RichEnvItem must have field `name`"
+      (_, Nothing, Nothing) -> fail "RichEnvItem must have field `name` and at least one of `from` or `value`"
+      _ -> fail "RichEnvItem must have only one of `from` or `value`"
+
+instance ToJSON RichEnvItem where
+  toJSON :: RichEnvItem -> Value
+  toJSON (EnvVarValue vv) = toJSON vv
+  toJSON (EnvVarNameMap vm) = toJSON vm
+  toJSON (EnvVarPrefix vp) = toJSON vp
+
+  toEncoding :: RichEnvItem -> Encoding
+  toEncoding (EnvVarValue vv) = toEncoding vv
+  toEncoding (EnvVarNameMap vm) = toEncoding vm
+  toEncoding (EnvVarPrefix vp) = toEncoding vp
 
 -- | A mapping from one environment variable name to another.
 data VarMap = VarMap
@@ -30,6 +67,7 @@ data VarMap = VarMap
     vmFrom :: NonEmptyString
   }
   deriving stock (Eq, Show, Generic)
+  deriving anyclass (Hashable, ToJSON)
 
 data VarValue = VarValue
   { -- | The name of the environment variable.
@@ -38,6 +76,7 @@ data VarValue = VarValue
     vvValue :: String
   }
   deriving stock (Eq, Show, Generic)
+  deriving anyclass (Hashable, ToJSON)
 
 -- | A prefix to add to all environment variables.
 data VarPrefix = VarPrefix
@@ -47,13 +86,4 @@ data VarPrefix = VarPrefix
     vpFrom :: String
   }
   deriving stock (Eq, Show, Generic)
-
--- Hashable instances for using HashSet. Requires instances of Generic.
-
-instance Hashable RichEnvItem
-
-instance Hashable VarMap
-
-instance Hashable VarValue
-
-instance Hashable VarPrefix
+  deriving anyclass (Hashable, ToJSON)

richenv.cabal

@@ -126,10 +126,16 @@ library richenv-internal
     RichEnv.Setters
     RichEnv.Types
 
+  -- RichEnv.Types.TOML
+
   build-depends:
+    , aeson
+    , autodocodec
     , hashable
     , unordered-containers
 
+  -- , toml-parser
+
   hs-source-dirs:   internal
   default-language: Haskell2010
 
@@ -158,11 +164,13 @@ test-suite richenv-test
 
   -- Test dependencies.
   build-depends:
+    , bytestring
     , hspec
     , QuickCheck
     , richenv
     , richenv-internal
     , unordered-containers
+    , yaml
 
   -- , base        ^>=4.16.4.0
   build-tool-depends: hspec-discover:hspec-discover

src/RichEnv.hs

@@ -29,10 +29,17 @@ setRichEnv re = do
 -- | Clears all environment variables of the current process.
 --
 -- >>> import System.Environment
--- >>> (getEnvironment >>= clearEnvironment) >> getEnvironment >>= pure . null
+-- >>> env <- getEnvironment
+-- >>> clearEnvironment env
+-- >>> env' <- getEnvironment
+-- >>> null env'
 -- True
 -- >>> import System.Environment
--- >>> (getEnvironment >>= clearEnvironment) >> setEnv "FOO" "bar" >> getEnvironment >>= \s -> pure (s == [("FOO", "bar")])
+-- >>> env <- getEnvironment
+-- >>> clearEnvironment env
+-- >>> setEnv "FOO" "bar"
+-- >>> env' <- getEnvironment
+-- >>> env' == [("FOO", "bar")]
 -- True
 clearEnvironment :: Environment -> IO ()
 clearEnvironment = mapM_ (unsetEnv . fst)

test/RichEnvSpec.hs

@@ -1,79 +1,103 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+
 module RichEnvSpec (spec) where
 
+import Data.ByteString qualified as B
+import Data.ByteString.Char8 qualified as C8
 import Data.HashSet qualified as S
 import Data.List (sort)
+import Data.Yaml (FromJSON, ParseException, decodeEither')
+import GHC.Generics (Generic)
 import RichEnv (clearEnvironment, setRichEnv, toEnvList)
 import RichEnv.Types (RichEnv, RichEnvItem (..), VarPrefix (..))
 import System.Environment (getEnvironment, setEnv)
 import Test.Hspec (Expectation, Spec, describe, it, shouldBe)
-import Test.QuickCheck ()
 import Utils (nonEmptyVarMap, nonEmptyVarValue)
 
 spec :: Spec
 spec = do
-  describe "RichEnv ops" $ do
+  describe "RichEnv ops: set environment" $ do
     it "set a single environment variable through RichEnv" $ do
       getEnvironment >>= clearEnvironment
-      setRichEnv richEnv1
-      testEnv expectedEnv1
+      setRichEnv $ S.singleton (EnvVarValue (nonEmptyVarValue "SOME" "var"))
+      testEnv [("SOME", "var")]
     it "set multiple environment variables through RichEnv" $ do
       getEnvironment >>= clearEnvironment
-      setRichEnv richEnv2
-      testEnv expectedEnv2
+      setRichEnv $ S.fromList [EnvVarValue (nonEmptyVarValue "SOME" "var"), EnvVarValue (nonEmptyVarValue "OTHER" "othervar")]
+      testEnv [("SOME", "var"), ("OTHER", "othervar")]
     it "remaps existing environment variables" $ do
       getEnvironment >>= clearEnvironment
       setTestEnv exampleEnv
-      setRichEnv richEnvMapping
-      testEnv expectedMapped
+      setRichEnv $ S.singleton $ EnvVarNameMap (nonEmptyVarMap "SOME" "FOO")
+      testEnv [("SOME", "bar")]
     it "remaps prefixed variables" $ do
       getEnvironment >>= clearEnvironment
       setTestEnv exampleEnv
-      setRichEnv richEnvPrefix
-      testEnv expectedNewPrefix
-  describe "getting the environment variable list" $ do
+      setRichEnv $ S.singleton $ EnvVarPrefix (VarPrefix "NEW_" "PREFIXED_")
+      testEnv [("NEW_VAR", "content"), ("NEW_VAR2", "content2")]
+  describe "RichEnv ops: getting the environment variable list" $ do
     it "gets the environment variable list" $ do
       getEnvironment >>= clearEnvironment
       setTestEnv exampleEnv
-      testEnvList richEnvMapping expectedMapped
+      testEnvList
+        [("SOME", "bar")]
+        (S.singleton $ EnvVarNameMap (nonEmptyVarMap "SOME" "FOO"))
     it "gets the environment variable list with prefixes" $ do
       getEnvironment >>= clearEnvironment
       setTestEnv exampleEnv
-      testEnvList richEnvPrefix expectedNewPrefix
+      testEnvList
+        [("NEW_VAR", "content"), ("NEW_VAR2", "content2")]
+        (S.singleton $ EnvVarPrefix (VarPrefix "NEW_" "PREFIXED_"))
+  describe "RichEnv ops: From YAML" $ do
+    it "parses a YAML file into expected results" $ do
+      getEnvironment >>= clearEnvironment
+      setTestEnv yamlBaseEnv
+      let res = decodeEither' yamlTestCase :: Either ParseException YamlTest
+      case res of
+        Left err -> fail $ show err
+        Right actual -> testEnvList yamlTestCaseExpected (env actual)
+  where
+    exampleEnv = [("FOO", "bar"), ("BAZ", "qux"), ("PREFIXED_VAR", "content"), ("PREFIXED_VAR2", "content2")]
 
 setTestEnv :: [(String, String)] -> IO ()
 setTestEnv = mapM_ (uncurry setEnv)
 
 testEnv :: [(String, String)] -> Expectation
 testEnv expected = getEnvironment >>= (`shouldBe` sort expected) . sort
 
-testEnvList :: RichEnv -> [(String, String)] -> Expectation
-testEnvList re expected = toEnvList re >>= (`shouldBe` sort expected) . sort
-
--- Test cases
-
-richEnv1 :: RichEnv
-richEnv1 = S.singleton (EnvVarValue (nonEmptyVarValue "SOME" "var"))
-
-expectedEnv1 :: [(String, String)]
-expectedEnv1 = [("SOME", "var")]
-
-richEnv2 :: RichEnv
-richEnv2 = S.fromList [EnvVarValue (nonEmptyVarValue "SOME" "var"), EnvVarValue (nonEmptyVarValue "OTHER" "othervar")]
-
-expectedEnv2 :: [(String, String)]
-expectedEnv2 = [("SOME", "var"), ("OTHER", "othervar")]
+testEnvList :: [(String, String)] -> RichEnv -> Expectation
+testEnvList expected re = toEnvList re >>= (`shouldBe` sort expected) . sort
 
-exampleEnv :: [(String, String)]
-exampleEnv = [("FOO", "bar"), ("BAZ", "qux"), ("PREFIXED_VAR", "content"), ("PREFIXED_VAR2", "content2")]
+-- YAML test cases that use the JSON conversion instances from Aeson
 
-richEnvMapping :: RichEnv
-richEnvMapping = S.singleton $ EnvVarNameMap (nonEmptyVarMap "SOME" "FOO")
+newtype YamlTest = YamlTest {env :: RichEnv}
+  deriving stock (Eq, Show, Generic)
+  deriving anyclass (FromJSON)
 
-expectedMapped :: [(String, String)]
-expectedMapped = [("SOME", "bar")]
+yamlTestCase :: B.ByteString
+yamlTestCase =
+  C8.pack $
+    unlines
+      [ "env:",
+        "  - name: SOME", -- This is the same as `EnvVarValue (VarValue "SOME" "var")`
+        "    value: somevar",
+        "  - name: OTHER", -- This is the same as `EnvVarValue (VarValue "OTHER" "othervar")`
+        "    value: othervar",
+        "  - name: FOO", -- This is the same as `EnvVarNameMap (VarMap "SOME" "FOO")`
+        "    from: SOME",
+        "  - name: NEW_*", -- This is the same as `EnvVarPrefix (VarPrefix "NEW_" "PREFIXED_")`
+        "    from: PREFIXED_*"
+      ]
 
-richEnvPrefix :: RichEnv
-richEnvPrefix = S.singleton $ EnvVarPrefix (VarPrefix "NEW_" "PREFIXED_")
+yamlBaseEnv :: [(String, String)]
+yamlBaseEnv = [("SOME", "bar"), ("OTHER", "othervar"), ("PREFIXED_VAR", "content"), ("PREFIXED_VAR2", "content2")]
 
-expectedNewPrefix :: [(String, String)]
-expectedNewPrefix = [("NEW_VAR", "content"), ("NEW_VAR2", "content2")]
+yamlTestCaseExpected :: [(String, String)]
+yamlTestCaseExpected =
+  [ ("FOO", "bar"),
+    ("OTHER", "othervar"),
+    ("SOME", "somevar"),
+    ("NEW_VAR", "content"),
+    ("NEW_VAR2", "content2")
+  ]