mmzk-env 0.5.0.0 → 0.6.0.0

raw patch · 15 files changed

+524/−122 lines, 15 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +29/−0
• app/NewtypeExample.hs +7/−2
• mmzk-env.cabal +10/−7
• src/Data/Env.hs +35/−0
• src/Data/Env/EnumParser.hs +19/−8
• src/Data/Env/ExtractFields.hs +24/−1
• src/Data/Env/Internal/Validation.hs +34/−0
• src/Data/Env/ParseError.hs +2/−8
• src/Data/Env/RecordParser.hs +7/−26
• src/Data/Env/RecordParserW.hs +7/−28
• src/Data/Env/TypeParser.hs +5/−16
• src/Data/Env/TypeParserW.hs +17/−24
• test/RecordParserSpec.hs +1/−1
• test/RecordParserWSpec.hs +1/−1
• test/ValidateEnvSpec.hs +326/−0

@@ -1,6 +1,35 @@ # Revision history for mmzk-env  +## 0.6.0.0 -- 2026-09-06++**Breaking changes:**++* `TypeParserW` no longer re-exports `Solo`; import it from `Data.Tuple` instead.++* `EnumParser` no longer derives `Eq`.++**New exports:**++* `Data.Env` gains pure variants of the top-level validators: `validateEnvFromMap`, `validateEnvFromMapWith`, `validateEnvWFromMap`, `validateEnvWFromMapWith`, and `validateEnvWDefaultFromMap`. These validate against a simulated `Map String String` environment instead of the real process environment — no `MonadIO`, no `setEnv`/`unsetEnv`, safe for parallel tests.++* `Data.Env.ExtractFields` gains `extractFieldsFromMap` and `extractFieldsFromMapCamelCaseToUpperSnake`, pure variants of `getEnvRaw` and `getEnvRawCamelCaseToUpperSnake` that read from a supplied `Map` instead of the real process environment. `camelToUpperSnake` is now exported.++**Other changes:**++* The `TypeParserW` pair instance is generalised from `(TypeParserW p1 String, TypeParserW p2 String) => TypeParserW (p1, p2) String` to `(TypeParserW p1 String, TypeParserW p2 a) => TypeParserW (p1, p2) a`: the first witness preprocesses the raw string (e.g. trims or validates it), and its output is fed to the second witness, which resolves the final value of any type. Composite witnesses that previously resolved to `String` are unaffected.++* `EnumParser`'s `parseMissing` message now lists the valid constructor names, and invalid-value messages use plain quotes instead of `show`, which escaped internal quotes and backslashes confusingly.++* The `Validation` applicative for error accumulation, previously duplicated in `RecordParser` and `RecordParserW`, is extracted into a shared internal module `Data.Env.Internal.Validation`. It is not exported from the library API.++* Removed the unused generic `default parseType` from `TypeParser` (`GTypeParser` had no instances and was never exported).++* `ParseError` and `FieldError` now derive `Ord`.++* New `ValidateEnvSpec` test suite covering the top-level interface and the pure `*FromMap` variants.++ ## 0.5.0.0 -- 2026-07-01  ### Value-level schema redesign (breaking)

@@ -18,7 +18,12 @@ -- | Custom parser: default to 5432 when the variable is absent. instance TypeParser PsqlPort where   parseMissing = Right (PsqlPort 5432)-  parseType str = case parseType str of+  -- Explicit @Word16 pins the inner 'parseType' to the 'TypeParser Word16'+  -- instance. Without it, this relies on GHC inferring the type solely from+  -- how 'port' is used below (wrapped in 'PsqlPort') — correct, but a subtle+  -- form of return-type polymorphism dispatch that's easy to break (e.g. by+  -- refactoring the 'Right' branch) into genuine self-recursion.+  parseType str = case parseType @Word16 str of     Right port -> Right (PsqlPort port)     Left err   -> Left err @@ -47,4 +52,4 @@   errOrConfig <- validateEnv @Config   case errOrConfig of     Left err  -> putStrLn $ "Parse failed:\n" ++ renderParseError err-    Right cfg -> putStrLn $ "Port: " ++ show (unpackPort $ psqlPort cfg)+    Right cfg -> putStrLn $ "Port: " ++ show (unpackPort cfg.psqlPort)

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               mmzk-env-version:            0.5.0.0+version:            0.6.0.0  synopsis:           Read environment variables into a user-defined data type description:@@ -21,7 +21,7 @@   common settings-    ghc-options: -Wall+    ghc-options: -Wall -Wcompat -Wredundant-constraints     default-extensions:         BlockArguments         DataKinds@@ -61,6 +61,8 @@         Data.Env.Witness.DefaultBool         Data.Env.Witness.DefaultNum         Data.Env.Witness.DefaultString+    other-modules:+        Data.Env.Internal.Validation     build-depends:         base >=4.16 && <5,         containers >= 0.6.7 && < 0.7,@@ -80,6 +82,7 @@         EnumParserSpec         RecordParserSpec         RecordParserWSpec+        ValidateEnvSpec     build-depends:         base >=4.16 && <5,         containers,@@ -92,47 +95,47 @@   executable quickstart-example+    import:           settings     main-is:          QuickstartExample.hs     build-depends:         base >=4.16 && <5,         containers,         mmzk-env,     hs-source-dirs:   app-    default-language: Haskell2010   executable custom-mapping-example+    import:           settings     main-is:          CustomMappingExample.hs     build-depends:         base >=4.16 && <5,         mmzk-env,     hs-source-dirs:   app-    default-language: Haskell2010   executable enum-example+    import:           settings     main-is:          EnumExample.hs     build-depends:         base >=4.16 && <5,         mmzk-env,     hs-source-dirs:   app-    default-language: Haskell2010  executable newtype-example+    import:           settings     main-is:          NewtypeExample.hs     build-depends:         base >=4.16 && <5,         containers,         mmzk-env,     hs-source-dirs:   app-    default-language: Haskell2010   executable witness-example+    import:           settings     main-is:          WitnessExample.hs     build-depends:         base >=4.16 && <5,         containers,         mmzk-env,     hs-source-dirs:   app-    default-language: Haskell2010

@@ -12,6 +12,7 @@   , EnvSchemaW (..)   , HasDefaultSchema (..)   , validateEnvWDefault+  , validateEnvWDefaultFromMap   , ParseError (..)   , FieldError (..)   , renderParseError@@ -23,6 +24,7 @@ import Data.Env.ParseError import Data.Env.RecordParser import Data.Env.RecordParserW+import Data.Map ( Map )  -- | Type class for validating plain (non-witness) environment schemas. class (ExtractFields a, RecordParser a) => EnvSchema a where@@ -39,6 +41,16 @@     envRaw <- getEnvRaw @a transform     pure $ parseRecord envRaw +  -- | Pure variant of 'validateEnv' for testing: validates against a+  -- simulated environment map (keyed the same way real env vars would be)+  -- instead of the real process environment.+  validateEnvFromMap :: Map String String -> Either ParseError a+  validateEnvFromMap = parseRecord . extractFieldsFromMapCamelCaseToUpperSnake @a++  -- | Pure variant of 'validateEnvWith'.+  validateEnvFromMapWith :: (String -> String) -> Map String String -> Either ParseError a+  validateEnvFromMapWith transform = parseRecord . extractFieldsFromMap @a transform+ {- | Type class for validating 'Col'-based environment schemas.  The schema value (@a 'Dec@) is passed explicitly to 'validateEnvW', so@@ -77,6 +89,18 @@     envRaw <- getEnvRaw @a transform     pure $ parseRecordW schema envRaw +  -- | Pure variant of 'validateEnvW' for testing: validates against a+  -- simulated environment map instead of the real process environment.+  validateEnvWFromMap :: a -> Map String String -> Either ParseError (RecordParsedType a)+  validateEnvWFromMap schema =+    parseRecordW schema . extractFieldsFromMapCamelCaseToUpperSnake @a++  -- | Pure variant of 'validateEnvWWith'.+  validateEnvWFromMapWith+    :: (String -> String) -> a -> Map String String -> Either ParseError (RecordParsedType a)+  validateEnvWFromMapWith transform schema =+    parseRecordW schema . extractFieldsFromMap @a transform+ {- | Validate using the auto-derived default schema.  Shorthand for @'validateEnvW' ('defaultSchema' \@a)@; requires every field@@ -87,3 +111,14 @@    . (EnvSchemaW (a 'Dec), HasDefaultSchema a, MonadIO m)   => m (Either ParseError (RecordParsedType (a 'Dec))) validateEnvWDefault = validateEnvW (defaultSchema @a)++{- | Pure variant of 'validateEnvWDefault' for testing: validates the+auto-derived default schema against a simulated environment map instead of+the real process environment.+-}+validateEnvWDefaultFromMap+  :: forall a+   . (EnvSchemaW (a 'Dec), HasDefaultSchema a)+  => Map String String+  -> Either ParseError (RecordParsedType (a 'Dec))+validateEnvWDefaultFromMap = validateEnvWFromMap (defaultSchema @a)

@@ -16,20 +16,31 @@ -- > parseType @Gender "Male" `shouldBe` Right Male -- > parseType @Gender "Female" `shouldBe` Right Female -- > parseType @Gender "Other" `shouldSatisfy` isLeft-module Data.Env.EnumParser where+module Data.Env.EnumParser ( EnumParser (..) ) where  import Data.Env.TypeParser ( TypeParser(..) ) import Data.List ( intercalate )+import Data.Map ( Map )+import Data.Map qualified as M  -- | A helper type for parsing Bounded Enums. newtype EnumParser a = EnumParser a-  deriving (Show, Eq)+  deriving (Show) +-- | Map from each constructor's 'Show' representation to itself.+enumMap :: forall a. (Show a, Bounded a, Enum a) => Map String a+enumMap = M.fromList [(show e, e) | e <- [minBound .. maxBound]]+ instance (Enum a, Show a, Bounded a) => TypeParser (EnumParser a) where-  parseType :: (Enum a, Show a, Bounded a) => String -> Either String (EnumParser a)-  parseType s = case lookup s enumMap of+  parseMissing :: Either String (EnumParser a)+  parseMissing = Left $ "missing required environment variable"+                     ++ "; expected one of: " ++ intercalate ", " (M.keys (enumMap @a))++  parseType :: String -> Either String (EnumParser a)+  parseType s = case M.lookup s (enumMap @a) of     Just v  -> Right (EnumParser v)-    Nothing -> Left $ "invalid value " ++ show s-                   ++ "; expected one of: " ++ intercalate ", " (map fst enumMap)-    where-      enumMap = [(show e, e) | e <- [minBound..maxBound]]+    -- Wrapped in plain quotes rather than 'show' — 'show' escapes internal+    -- quotes/backslashes (e.g. @"has\"quote"@), which reads confusingly to a+    -- human even though the raw env var value contains no backslash at all.+    Nothing -> Left $ "invalid value \"" ++ s ++ "\""+                   ++ "; expected one of: " ++ intercalate ", " (M.keys (enumMap @a))

@@ -14,6 +14,9 @@   extractFields,   getEnvRaw,   getEnvRawCamelCaseToUpperSnake,+  extractFieldsFromMap,+  extractFieldsFromMapCamelCaseToUpperSnake,+  camelToUpperSnake, ) where  import Control.Monad@@ -56,7 +59,27 @@ getEnvRawCamelCaseToUpperSnake = getEnvRaw @a camelToUpperSnake {-# INLINE getEnvRawCamelCaseToUpperSnake #-} +-- | Pure variant of 'getEnvRaw' for testing: builds the same field-name →+-- raw-value map, but reads from a supplied simulated environment (keyed the+-- same way real env vars would be, e.g. via 'camelToUpperSnake') instead of+-- the real process environment.+extractFieldsFromMap :: forall a. ExtractFields a+                      => (String -> String)+                      -> Map String String+                      -> Map String String+extractFieldsFromMap mapper simulatedEnv =+  M.fromList [ (field, fromMaybe "" (M.lookup (mapper field) simulatedEnv))+             | field <- extractFields @a ]+{-# INLINE extractFieldsFromMap #-} +-- | Pure variant of 'getEnvRawCamelCaseToUpperSnake'.+extractFieldsFromMapCamelCaseToUpperSnake :: forall a. ExtractFields a+                                           => Map String String+                                           -> Map String String+extractFieldsFromMapCamelCaseToUpperSnake = extractFieldsFromMap @a camelToUpperSnake+{-# INLINE extractFieldsFromMapCamelCaseToUpperSnake #-}++ -------------------------------------------------------------------------------- -- Generic instances --------------------------------------------------------------------------------@@ -87,7 +110,7 @@   gExtractFields _ = [selName (undefined :: M1 S s (K1 i a) p)]   {-# INLINE gExtractFields #-} -instance (Generic a, GExtractFields (Rep a)) => ExtractFields a where+instance (GExtractFields (Rep a)) => ExtractFields a where   extractFields' :: Proxy a -> [String]   extractFields' _ = gExtractFields (Proxy :: Proxy (Rep a))   {-# INLINE extractFields' #-}

@@ -0,0 +1,34 @@+{- |+Module      : Data.Env.Internal.Validation+Description : Internal applicative for error accumulation++Like 'Either', but the 'Applicative' instance accumulates failures using+the 'Semigroup' on @e@ instead of short-circuiting. Used by the generic+record parsers to report every invalid field in one pass.++INTERNAL — not exported from the library API.+-}+module Data.Env.Internal.Validation (+  Validation (..),+  validationToEither,+) where++-- | Like 'Either', but the 'Applicative' instance accumulates failures using+-- the 'Semigroup' on @e@ instead of short-circuiting.+data Validation e a = VFailure e | VSuccess a+  deriving (Show, Eq)++instance Functor (Validation e) where+  fmap _ (VFailure e) = VFailure e+  fmap f (VSuccess a) = VSuccess (f a)++instance Semigroup e => Applicative (Validation e) where+  pure = VSuccess+  VSuccess f  <*> VSuccess x  = VSuccess (f x)+  VFailure e1 <*> VFailure e2 = VFailure (e1 <> e2)+  VFailure e  <*> _           = VFailure e+  _           <*> VFailure e  = VFailure e++validationToEither :: Validation e a -> Either e a+validationToEither (VSuccess a) = Right a+validationToEither (VFailure e) = Left e

@@ -1,9 +1,3 @@--- |--- Module: Data.Env.ParseError--- Description: Structured parse error types for environment variable validation.------ Provides 'FieldError' (a single field's failure) and 'ParseError' (all--- field failures from a record), plus rendering functions. module Data.Env.ParseError (   FieldError (..),   ParseError (..),@@ -17,14 +11,14 @@ data FieldError = FieldError   { errField   :: String  -- ^ The Haskell record field name.   , errMessage :: String  -- ^ What went wrong parsing the value.-  } deriving (Show, Eq)+  } deriving (Show, Eq, Ord)  -- | All field parse failures collected from a record. -- -- Using a list (rather than short-circuiting on the first failure) means -- every invalid field is reported in one pass. newtype ParseError = ParseError { parseErrors :: [FieldError] }-  deriving (Show, Eq)+  deriving (Show, Eq, Ord)  -- | 'ParseError' is a 'Semigroup' so failures from different fields can be -- accumulated by the generic record parser.

@@ -16,6 +16,7 @@   RecordParser (..), ) where +import Data.Env.Internal.Validation import Data.Env.ParseError import Data.Env.TypeParser import Data.Map ( Map )@@ -37,33 +38,7 @@  instance (Generic a, GRecordParser (Rep a)) => RecordParser a where   parseRecord env = validationToEither (to <$> gParseRecord env)-- ----------------------------------------------------------------------------------- Internal Validation applicative for error accumulation------------------------------------------------------------------------------------- | Like 'Either', but the 'Applicative' instance accumulates failures using--- the 'Semigroup' on @e@ instead of short-circuiting.-data Validation e a = VFailure e | VSuccess a--instance Functor (Validation e) where-  fmap _ (VFailure e) = VFailure e-  fmap f (VSuccess a) = VSuccess (f a)--instance Semigroup e => Applicative (Validation e) where-  pure = VSuccess-  VSuccess f  <*> VSuccess x  = VSuccess (f x)-  VFailure e1 <*> VFailure e2 = VFailure (e1 <> e2)-  VFailure e  <*> _           = VFailure e-  _           <*> VFailure e  = VFailure e--validationToEither :: Validation e a -> Either e a-validationToEither (VSuccess a) = Right a-validationToEither (VFailure e) = Left e----------------------------------------------------------------------------------- -- Generic instances -------------------------------------------------------------------------------- @@ -86,6 +61,12 @@  -- | Handle an individual field — wraps any 'TypeParser' failure in a -- 'FieldError' keyed by the Haskell field name.+--+-- An absent key and a key present with an empty string are both treated as+-- \"missing\" (both dispatch to 'parseMissing') — an empty environment+-- variable is equivalent to an undefined one. This matches+-- 'Data.Env.RecordParserW.RecordParserW', which collapses both cases the+-- same way via its field functions. instance (TypeParser a, Selector s) => GRecordParser (M1 S s (K1 i a)) where   gParseRecord env =     let key    = selName (undefined :: M1 S s (K1 i a) p)

@@ -53,6 +53,7 @@   , fromTypeParserW   ) where +import Data.Env.Internal.Validation import Data.Env.ParseError import Data.Env.TypeParser (TypeParser) import Data.Env.TypeParser qualified as TP@@ -61,7 +62,6 @@ import Data.Kind (Type) import Data.Map (Map) import Data.Map qualified as M-import Data.Maybe (fromMaybe) import Data.Proxy (Proxy (..)) import GHC.Generics @@ -173,30 +173,7 @@   defaultSchema :: a 'Dec   defaultSchema = to gDefaultSchema - ----------------------------------------------------------------------------------- Internal Validation applicative-----------------------------------------------------------------------------------data Validation e a = VFailure e | VSuccess a--instance Functor (Validation e) where-  fmap _ (VFailure e) = VFailure e-  fmap f (VSuccess a) = VSuccess (f a)--instance Semigroup e => Applicative (Validation e) where-  pure = VSuccess-  VSuccess f <*> VSuccess x = VSuccess (f x)-  VFailure e1 <*> VFailure e2 = VFailure (e1 <> e2)-  VFailure e <*> _ = VFailure e-  _ <*> VFailure e = VFailure e--validationToEither :: Validation e a -> Either e a-validationToEither (VSuccess a) = Right a-validationToEither (VFailure e) = Left e----------------------------------------------------------------------------------- -- Generic parsing -------------------------------------------------------------------------------- @@ -220,10 +197,12 @@   type GRecordParsedType (M1 S s (K1 i (String -> Either String a))) = M1 S s (K1 i a)   gParseRecord (M1 (K1 fn)) env =     let key = selName (undefined :: M1 S s (K1 i a) p)-        result = fn (fromMaybe "" (M.lookup key env))-     in M1 . K1 <$> case result of-          Left msg -> VFailure $ ParseError [FieldError{errField = key, errMessage = msg}]-          Right val -> VSuccess val+        result = case M.lookup key env of+          Nothing -> fn ""+          Just v  -> fn v+      in M1 . K1 <$> case result of+            Left msg  -> VFailure $ ParseError [FieldError{errField = key, errMessage = msg}]+            Right val -> VSuccess val   --------------------------------------------------------------------------------

@@ -1,4 +1,3 @@-{-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE CPP #-} @@ -19,7 +18,6 @@ import Data.Text.Lazy qualified as TL import Data.Tuple ( Solo(..) ) import Data.Word (Word8, Word16, Word32, Word64)-import GHC.Generics import Text.Gigaparsec qualified as P import Text.Gigaparsec.Char qualified as P import Text.Gigaparsec.Combinator qualified as P@@ -33,11 +31,6 @@   -- | Parse a value by its string representation.   parseType :: String -> Either String a -  default parseType-    :: (Generic a, GTypeParser (Rep a)) => String -> Either String a-  parseType s = to <$> gTypeParser s-  {-# INLINE parseType #-}-   -- | Result to use when the environment variable is absent (empty string).   --   -- The default signals that the variable is required. Override this for@@ -198,15 +191,6 @@   ----------------------------------------------------------------------------------- Generic instances------------------------------------------------------------------------------------- | Generic validation class.-class GTypeParser f where-  gTypeParser :: String -> Either String (f p)----------------------------------------------------------------------------------- -- Helpers -------------------------------------------------------------------------------- @@ -231,6 +215,11 @@ parse parser = parseResultToEither . P.parse (parser >>= (P.eof P.$>)) {-# INLINE parse #-} +-- | 'P.vanillaGen' always constructs a 'P.VanillaGen' (never a+-- 'P.SpecializedGen') — the second pattern below is unreachable in practice,+-- but 'P.ErrorGen' has two constructors, so GHC can't see that statically.+-- Falling back to the value unchanged is a harmless no-op safety net rather+-- than a partial-pattern crash, should that assumption ever stop holding. simpleErrorGen :: String -> P.ErrorGen a simpleErrorGen msg = case P.vanillaGen of   P.VanillaGen {..} -> P.VanillaGen { reason = const (Just msg), .. }

@@ -1,4 +1,5 @@ {-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE UndecidableInstances #-}  -- | -- Module: Data.Env.TypeParserW@@ -10,7 +11,6 @@ -- different witness types. module Data.Env.TypeParserW (   TypeParserW (..),-  Solo, ) where  import Data.Env.TypeParser@@ -19,14 +19,11 @@  -- | Type class for parsers parameterized by a witness type. ----- This is similar to 'Data.Env.TypeParser.TypeParser''s 'Data.Env.TypeParser.parseType',--- but allows a witness object to define how to parse. The witness type @p@ determines--- the parsing strategy, giving you explicit control over the parsing behavior.------ The witness pattern is useful when:+-- This is similar to 'TypeParser'', but parameterised by a witness type @p@ that+-- determines the parsing strategy, giving you explicit control over behaviour. ----- * You need multiple different parsing strategies for the same type--- * [TODO] You want to compose parsers in different ways+-- The witness pattern is useful when you need multiple parsing strategies+-- for the same type or want to compose parsers in different ways. -- -- The functional dependency @p -> a@ ensures that each witness type uniquely -- determines the result type. For example, 'Data.Env.Witness.DefaultNum.DefaultNum' 5432 Int@@ -35,26 +32,17 @@ -- See 'Data.Env.Witness.DefaultNum.DefaultNum' for an example of how to use witness types with -- this class. class TypeParserW p a | p -> a where-  -- | Parse a value by its string representation using the witness type @p@.-  ---  -- The 'Data.Proxy.Proxy' parameter carries the witness type information that determines-  -- how the parsing should be performed.+  -- | Parse a value from its string representation.   parseTypeW :: Proxy p -> String -> Either String a -  -- | Result to use when the environment variable is absent (empty string).-  ---  -- The default calls @'parseTypeW' proxy ""@, which is correct for witnesses-  -- that supply their own default (e.g. 'Data.Env.Witness.DefaultNum.DefaultNum', 'Data.Env.Witness.DefaultString.DefaultString',-  -- 'Data.Env.Witness.DefaultBool.DefaultBool'). Override this for witnesses that delegate to a-  -- 'TypeParser' instance — see the 'Solo' instance below.+  -- | Result to use when the environment variable is absent.+  -- Default delegates to @'parseTypeW' proxy ""@. Override for witnesses that+  -- delegate to 'TypeParser' — see the 'Solo' instance below.   parseMissingW :: Proxy p -> Either String a   parseMissingW proxy = parseTypeW proxy ""   {-# INLINE parseMissingW #-} -  -- | Parse a value, converting 'Either' to 'Maybe' and dropping any error messages.-  ---  -- This is a convenience function that calls 'parseTypeW' and converts the result-  -- from 'Either String a' to 'Maybe a', discarding the error message on failure.+  -- | Convenience wrapper that returns 'Maybe' instead of 'Either'.   parseTypeW' :: Proxy p -> String -> Maybe a   parseTypeW' proxy str = case parseTypeW proxy str of     Right val -> Just val@@ -69,6 +57,11 @@   parseMissingW :: Proxy (Solo a) -> Either String a   parseMissingW _ = parseMissing @a -instance (TypeParserW p1 String, TypeParserW p2 String) => TypeParserW (p1, p2) String where-  parseTypeW :: Proxy (p1, p2) -> String -> Either String String+-- | Compose two witnesses into a pipeline: @p1@ preprocesses the raw string+-- (e.g. trims or validates it), and its output is fed as the input string to+-- @p2@, which resolves the final value of type @a@. Only @p1@ is constrained+-- to produce 'String' — @p2@ (and hence the composed witness) may resolve to+-- any type.+instance (TypeParserW p1 String, TypeParserW p2 a) => TypeParserW (p1, p2) a where+  parseTypeW :: Proxy (p1, p2) -> String -> Either String a   parseTypeW _ str = parseTypeW @p1 Proxy str >>= parseTypeW @p2 Proxy

@@ -80,5 +80,5 @@         length errs `shouldBe` 2         -- Errors are in field-declaration order.         map (.errField) errs `shouldBe` ["age", "gender"]-        (errs !! 0).errMessage `shouldBe` "Age is not within range!"+        (head errs).errMessage `shouldBe` "Age is not within range!"         (errs !! 1).errMessage `shouldContain` "\"Other\""

@@ -86,7 +86,7 @@       Left (ParseError errs) -> do         length errs `shouldBe` 2         map (.errField) errs `shouldBe` ["port", "name"]-        (errs !! 0).errMessage `shouldSatisfy` (not . null)+        (head errs).errMessage `shouldSatisfy` (not . null)         (errs !! 1).errMessage `shouldBe` "Name Too Long!!"    it "orElse overrides the fallback at runtime" do

@@ -0,0 +1,326 @@+module ValidateEnvSpec (spec) where++import Data.Char (toUpper)+import Data.Env+import Data.Env.ExtractFields+import Data.Env.RecordParserW+import Data.Map qualified as M+import GHC.Generics+import System.Environment+import Test.Hspec++--------------------------------------------------------------------------------+-- Test records+--------------------------------------------------------------------------------++-- ^ Plain record for 'validateEnv' tests.+data PlainConfig = PlainConfig+  { plainHost  :: String+  , plainPort  :: Int+  , plainDebug :: Maybe Bool+  }+  deriving (Show, Eq, Generic, EnvSchema)++-- ^ Schema record for 'validateEnvW' tests.+data SchemaConfig c = SchemaConfig+  { schemaHost :: Col c String+  , schemaPort :: Col c Int+  , schemaDebug :: Col c Bool+  }+  deriving (Generic)++deriving stock instance Show (SchemaConfig 'Res)+deriving stock instance Eq (SchemaConfig 'Res)++instance EnvSchemaW (SchemaConfig 'Dec)++--------------------------------------------------------------------------------+-- camelToUpperSnake unit tests+--------------------------------------------------------------------------------++specCamelToUpperSnake :: Spec+specCamelToUpperSnake = describe "camelToUpperSnake" do+  it "converts simple camelCase" do+    camelToUpperSnake "plainHost" `shouldBe` "PLAIN_HOST"+  it "converts single-word lowercase" do+    camelToUpperSnake "host" `shouldBe` "HOST"+  it "leaves consecutive uppercase together" do+    camelToUpperSnake "myHTTPClient" `shouldBe` "MY_HTTPCLIENT"+  it "handles digit before uppercase" do+    camelToUpperSnake "http2Client" `shouldBe` "HTTP2_CLIENT"+  it "passes through literal underscores" do+    camelToUpperSnake "my_host" `shouldBe` "MY_HOST"+  it "handles leading underscore" do+    camelToUpperSnake "_host" `shouldBe` "_HOST"+  it "handles single character" do+    camelToUpperSnake "x" `shouldBe` "X"++--------------------------------------------------------------------------------+-- validateEnv tests+--------------------------------------------------------------------------------++specValidateEnv :: Spec+specValidateEnv = describe "validateEnv" do+  it "reads valid env vars" do+    setEnv "PLAIN_HOST" "localhost"+    setEnv "PLAIN_PORT" "8080"+    setEnv "PLAIN_DEBUG" "True"+    result <- validateEnv @PlainConfig+    unsetEnv "PLAIN_HOST"+    unsetEnv "PLAIN_PORT"+    unsetEnv "PLAIN_DEBUG"+    result `shouldBe` Right (PlainConfig "localhost" 8080 (Just True))++  it "succeeds with missing optional field" do+    setEnv "PLAIN_HOST" "localhost"+    setEnv "PLAIN_PORT" "3000"+    unsetEnv "PLAIN_DEBUG"+    result <- validateEnv @PlainConfig+    unsetEnv "PLAIN_HOST"+    unsetEnv "PLAIN_PORT"+    result `shouldBe` Right (PlainConfig "localhost" 3000 Nothing)++  it "fails when required var is missing" do+    setEnv "PLAIN_HOST" "localhost"+    unsetEnv "PLAIN_PORT"+    unsetEnv "PLAIN_DEBUG"+    result <- validateEnv @PlainConfig+    unsetEnv "PLAIN_HOST"+    case result of+      Left (ParseError errs) -> length errs `shouldBe` 1+      Right _ -> expectationFailure "expected Left"++  it "fails on invalid port value" do+    setEnv "PLAIN_HOST" "localhost"+    setEnv "PLAIN_PORT" "not-a-number"+    unsetEnv "PLAIN_DEBUG"+    result <- validateEnv @PlainConfig+    unsetEnv "PLAIN_HOST"+    unsetEnv "PLAIN_PORT"+    case result of+      Left (ParseError errs) -> length errs `shouldBe` 1+      Right _ -> expectationFailure "expected Left"++  it "collects errors from multiple fields" do+    setEnv "PLAIN_HOST" ""+    setEnv "PLAIN_PORT" "bad"+    setEnv "PLAIN_DEBUG" "bad"+    result <- validateEnv @PlainConfig+    unsetEnv "PLAIN_HOST"+    unsetEnv "PLAIN_PORT"+    unsetEnv "PLAIN_DEBUG"+    case result of+      Left (ParseError errs) -> length errs `shouldBe` 3+      Right _ -> expectationFailure "expected Left"++--------------------------------------------------------------------------------+-- validateEnvWith tests+--------------------------------------------------------------------------------++specValidateEnvWith :: Spec+specValidateEnvWith = describe "validateEnvWith" do+  it "uses custom mapping toUpper" do+    setEnv "PLAINHOST" "example.com"+    setEnv "PLAINPORT" "443"+    unsetEnv "PLAINDDEBUG"+    result <- validateEnvWith @PlainConfig (map toUpper)+    unsetEnv "PLAINHOST"+    unsetEnv "PLAINPORT"+    result `shouldBe` Right (PlainConfig "example.com" 443 Nothing)++--------------------------------------------------------------------------------+-- validateEnvFromMap / validateEnvFromMapWith tests+--------------------------------------------------------------------------------++specValidateEnvFromMap :: Spec+specValidateEnvFromMap = describe "validateEnvFromMap" do+  it "reads valid values from a simulated environment, no real env vars touched" do+    let simulatedEnv = M.fromList+          [ ("PLAIN_HOST", "localhost")+          , ("PLAIN_PORT", "8080")+          , ("PLAIN_DEBUG", "True")+          ]+    validateEnvFromMap @PlainConfig simulatedEnv+      `shouldBe` Right (PlainConfig "localhost" 8080 (Just True))++  it "succeeds with missing optional field" do+    let simulatedEnv = M.fromList [("PLAIN_HOST", "localhost"), ("PLAIN_PORT", "3000")]+    validateEnvFromMap @PlainConfig simulatedEnv+      `shouldBe` Right (PlainConfig "localhost" 3000 Nothing)++  it "fails when required var is missing" do+    let simulatedEnv = M.fromList [("PLAIN_HOST", "localhost")]+    case validateEnvFromMap @PlainConfig simulatedEnv of+      Left (ParseError errs) -> length errs `shouldBe` 1+      Right _ -> expectationFailure "expected Left"++  it "collects errors from multiple fields" do+    let simulatedEnv = M.fromList+          [ ("PLAIN_HOST", "")+          , ("PLAIN_PORT", "bad")+          , ("PLAIN_DEBUG", "bad")+          ]+    case validateEnvFromMap @PlainConfig simulatedEnv of+      Left (ParseError errs) -> length errs `shouldBe` 3+      Right _ -> expectationFailure "expected Left"++  it "does not read from the real process environment" do+    setEnv "PLAIN_HOST" "real-host"+    let simulatedEnv = M.fromList [("PLAIN_HOST", "fake-host"), ("PLAIN_PORT", "1")]+    result <- pure $ validateEnvFromMap @PlainConfig simulatedEnv+    unsetEnv "PLAIN_HOST"+    result `shouldBe` Right (PlainConfig "fake-host" 1 Nothing)++specValidateEnvFromMapWith :: Spec+specValidateEnvFromMapWith = describe "validateEnvFromMapWith" do+  it "uses custom mapping toUpper" do+    let simulatedEnv = M.fromList [("PLAINHOST", "example.com"), ("PLAINPORT", "443")]+    validateEnvFromMapWith @PlainConfig (map toUpper) simulatedEnv+      `shouldBe` Right (PlainConfig "example.com" 443 Nothing)++--------------------------------------------------------------------------------+-- validateEnvW tests+--------------------------------------------------------------------------------++specValidateEnvW :: Spec+specValidateEnvW = describe "validateEnvW" do+  let schema :: SchemaConfig 'Dec+      schema = SchemaConfig+        { schemaHost = typeParser @String+        , schemaPort = typeParser @Int `orElse` 5432+        , schemaDebug = typeParser @Bool `orElse` False+        }++  it "reads valid env vars" do+    setEnv "SCHEMA_HOST" "localhost"+    setEnv "SCHEMA_PORT" "9090"+    setEnv "SCHEMA_DEBUG" "True"+    result <- validateEnvW schema+    unsetEnv "SCHEMA_HOST"+    unsetEnv "SCHEMA_PORT"+    unsetEnv "SCHEMA_DEBUG"+    result `shouldBe` Right (SchemaConfig "localhost" 9090 True)++  it "applies runtime defaults for missing vars" do+    setEnv "SCHEMA_HOST" "localhost"+    unsetEnv "SCHEMA_PORT"+    unsetEnv "SCHEMA_DEBUG"+    result <- validateEnvW schema+    unsetEnv "SCHEMA_HOST"+    result `shouldBe` Right (SchemaConfig "localhost" 5432 False)++  it "fails on invalid required field" do+    unsetEnv "SCHEMA_HOST"+    setEnv "SCHEMA_PORT" "8080"+    setEnv "SCHEMA_DEBUG" "True"+    result <- validateEnvW schema+    unsetEnv "SCHEMA_PORT"+    unsetEnv "SCHEMA_DEBUG"+    case result of+      Left (ParseError errs) -> length errs `shouldBe` 1+      Right _ -> expectationFailure "expected Left"++  it "orElse does not swallow parse errors" do+    setEnv "SCHEMA_HOST" "localhost"+    setEnv "SCHEMA_PORT" "bad"+    setEnv "SCHEMA_DEBUG" "True"+    result <- validateEnvW schema+    unsetEnv "SCHEMA_HOST"+    unsetEnv "SCHEMA_PORT"+    unsetEnv "SCHEMA_DEBUG"+    case result of+      Left (ParseError errs) -> length errs `shouldBe` 1+      Right _ -> expectationFailure "expected Left"++--------------------------------------------------------------------------------+-- validateEnvWFromMap / validateEnvWFromMapWith tests+--------------------------------------------------------------------------------++specValidateEnvWFromMap :: Spec+specValidateEnvWFromMap = describe "validateEnvWFromMap" do+  let schema :: SchemaConfig 'Dec+      schema = SchemaConfig+        { schemaHost = typeParser @String+        , schemaPort = typeParser @Int `orElse` 5432+        , schemaDebug = typeParser @Bool `orElse` False+        }++  it "reads valid values from a simulated environment" do+    let simulatedEnv = M.fromList+          [ ("SCHEMA_HOST", "localhost")+          , ("SCHEMA_PORT", "9090")+          , ("SCHEMA_DEBUG", "True")+          ]+    validateEnvWFromMap schema simulatedEnv `shouldBe` Right (SchemaConfig "localhost" 9090 True)++  it "applies runtime defaults for missing vars" do+    let simulatedEnv = M.fromList [("SCHEMA_HOST", "localhost")]+    validateEnvWFromMap schema simulatedEnv+      `shouldBe` Right (SchemaConfig "localhost" 5432 False)++  it "fails on invalid required field" do+    let simulatedEnv = M.fromList [("SCHEMA_PORT", "8080"), ("SCHEMA_DEBUG", "True")]+    case validateEnvWFromMap schema simulatedEnv of+      Left (ParseError errs) -> length errs `shouldBe` 1+      Right _ -> expectationFailure "expected Left"++specValidateEnvWFromMapWith :: Spec+specValidateEnvWFromMapWith = describe "validateEnvWFromMapWith" do+  it "uses custom mapping toUpper" do+    let schema :: SchemaConfig 'Dec+        schema = SchemaConfig+          { schemaHost = typeParser @String+          , schemaPort = typeParser @Int `orElse` 5432+          , schemaDebug = typeParser @Bool `orElse` False+          }+        simulatedEnv = M.fromList [("SCHEMAHOST", "example.com"), ("SCHEMAPORT", "443")]+    validateEnvWFromMapWith (map toUpper) schema simulatedEnv+      `shouldBe` Right (SchemaConfig "example.com" 443 False)++--------------------------------------------------------------------------------+-- validateEnvWDefault tests+--------------------------------------------------------------------------------++specValidateEnvWDefault :: Spec+specValidateEnvWDefault = describe "validateEnvWDefault" do+  it "auto-derives schema from TypeParser instances" do+    setEnv "SCHEMA_HOST" "auto"+    setEnv "SCHEMA_PORT" "7000"+    setEnv "SCHEMA_DEBUG" "True"+    result <- validateEnvWDefault @SchemaConfig+    unsetEnv "SCHEMA_HOST"+    unsetEnv "SCHEMA_PORT"+    unsetEnv "SCHEMA_DEBUG"+    result `shouldBe` Right (SchemaConfig "auto" 7000 True)++--------------------------------------------------------------------------------+-- validateEnvWDefaultFromMap tests+--------------------------------------------------------------------------------++specValidateEnvWDefaultFromMap :: Spec+specValidateEnvWDefaultFromMap = describe "validateEnvWDefaultFromMap" do+  it "auto-derives schema from TypeParser instances" do+    let simulatedEnv = M.fromList+          [ ("SCHEMA_HOST", "auto")+          , ("SCHEMA_PORT", "7000")+          , ("SCHEMA_DEBUG", "True")+          ]+    validateEnvWDefaultFromMap @SchemaConfig simulatedEnv+      `shouldBe` Right (SchemaConfig "auto" 7000 True)++--------------------------------------------------------------------------------+-- Top-level spec+--------------------------------------------------------------------------------++spec :: Spec+spec = do+  specCamelToUpperSnake+  specValidateEnv+  specValidateEnvWith+  specValidateEnvFromMap+  specValidateEnvFromMapWith+  specValidateEnvW+  specValidateEnvWFromMap+  specValidateEnvWFromMapWith+  specValidateEnvWDefault+  specValidateEnvWDefaultFromMap