mmzk-env 0.3.0.0 → 0.4.0.0
raw patch · 17 files changed
+495/−122 lines, 17 filesdep ~containersPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: containers
API changes (from Hackage documentation)
+ Data.Env: FieldError :: String -> String -> FieldError
+ Data.Env: ParseError :: [FieldError] -> ParseError
+ Data.Env: [$sel:errField:FieldError] :: FieldError -> String
+ Data.Env: [$sel:errMessage:FieldError] :: FieldError -> String
+ Data.Env: [$sel:parseErrors:ParseError] :: ParseError -> [FieldError]
+ Data.Env: data FieldError
+ Data.Env: newtype ParseError
+ Data.Env: renderFieldError :: FieldError -> String
+ Data.Env: renderParseError :: ParseError -> String
+ Data.Env.ParseError: FieldError :: String -> String -> FieldError
+ Data.Env.ParseError: ParseError :: [FieldError] -> ParseError
+ Data.Env.ParseError: [$sel:errField:FieldError] :: FieldError -> String
+ Data.Env.ParseError: [$sel:errMessage:FieldError] :: FieldError -> String
+ Data.Env.ParseError: [$sel:parseErrors:ParseError] :: ParseError -> [FieldError]
+ Data.Env.ParseError: data FieldError
+ Data.Env.ParseError: instance GHC.Base.Monoid Data.Env.ParseError.ParseError
+ Data.Env.ParseError: instance GHC.Base.Semigroup Data.Env.ParseError.ParseError
+ Data.Env.ParseError: instance GHC.Classes.Eq Data.Env.ParseError.FieldError
+ Data.Env.ParseError: instance GHC.Classes.Eq Data.Env.ParseError.ParseError
+ Data.Env.ParseError: instance GHC.Show.Show Data.Env.ParseError.FieldError
+ Data.Env.ParseError: instance GHC.Show.Show Data.Env.ParseError.ParseError
+ Data.Env.ParseError: newtype ParseError
+ Data.Env.ParseError: renderFieldError :: FieldError -> String
+ Data.Env.ParseError: renderParseError :: ParseError -> String
+ Data.Env.RecordParser: instance GHC.Base.Functor (Data.Env.RecordParser.Validation e)
+ Data.Env.RecordParser: instance GHC.Base.Semigroup e => GHC.Base.Applicative (Data.Env.RecordParser.Validation e)
+ Data.Env.RecordParserW: instance GHC.Base.Functor (Data.Env.RecordParserW.Validation e)
+ Data.Env.RecordParserW: instance GHC.Base.Semigroup e => GHC.Base.Applicative (Data.Env.RecordParserW.Validation e)
+ Data.Env.TypeParser: parseMissing :: TypeParser a => Either String a
+ Data.Env.TypeParserW: parseMissingW :: TypeParserW p a => Proxy p -> Either String a
- Data.Env: validateEnv :: (EnvSchema a, MonadIO m) => m (Either String a)
+ Data.Env: validateEnv :: (EnvSchema a, MonadIO m) => m (Either ParseError a)
- Data.Env: validateEnvW :: (EnvSchemaW a, MonadIO m) => m (Either String (RecordParsedType a))
+ Data.Env: validateEnvW :: (EnvSchemaW a, MonadIO m) => m (Either ParseError (RecordParsedType a))
- Data.Env: validateEnvWWith :: (EnvSchemaW a, MonadIO m) => (String -> String) -> m (Either String (RecordParsedType a))
+ Data.Env: validateEnvWWith :: (EnvSchemaW a, MonadIO m) => (String -> String) -> m (Either ParseError (RecordParsedType a))
- Data.Env: validateEnvWith :: (EnvSchema a, MonadIO m) => (String -> String) -> m (Either String a)
+ Data.Env: validateEnvWith :: (EnvSchema a, MonadIO m) => (String -> String) -> m (Either ParseError a)
- Data.Env.RecordParser: parseRecord :: RecordParser a => Map String String -> Either String a
+ Data.Env.RecordParser: parseRecord :: RecordParser a => Map String String -> Either ParseError a
- Data.Env.RecordParserW: parseRecordW :: RecordParserW a => Map String String -> Either String (RecordParsedType a)
+ Data.Env.RecordParserW: parseRecordW :: RecordParserW a => Map String String -> Either ParseError (RecordParsedType a)
Files
- CHANGELOG.md +27/−0
- README.md +76/−18
- app/CustomMappingExample.hs +4/−4
- app/EnumExample.hs +7/−0
- app/NewtypeExample.hs +19/−6
- app/QuickstartExample.hs +19/−2
- app/WitnessExample.hs +19/−5
- mmzk-env.cabal +6/−3
- src/Data/Env.hs +15/−7
- src/Data/Env/EnumParser.hs +3/−1
- src/Data/Env/ParseError.hs +68/−0
- src/Data/Env/RecordParser.hs +47/−20
- src/Data/Env/RecordParserW.hs +48/−19
- src/Data/Env/TypeParser.hs +47/−27
- src/Data/Env/TypeParserW.hs +15/−0
- test/RecordParserSpec.hs +40/−6
- test/RecordParserWSpec.hs +35/−4
CHANGELOG.md view
@@ -1,6 +1,33 @@ # Revision history for mmzk-env +## 0.4.0.0 -- 2026-04-16++**Breaking changes:**++* `validateEnv`, `validateEnvWith`, `validateEnvW`, `validateEnvWWith`, `parseRecord`, and `parseRecordW` now return `Either ParseError a` instead of `Either String a`. Code that matches on `Left err` where `err :: String` must be updated to use `renderParseError err` (or pattern-match on `ParseError`/`FieldError`).++* `TypeParser` gains a new method `parseMissing :: Either String a` (default: `Left "missing required environment variable"`). Custom `TypeParser` instances that handled the empty-string case inside `parseType` to supply a default **must** move that logic to `parseMissing` — `parseType ""` is no longer called for absent environment variables.++* `TypeParserW` gains a new method `parseMissingW :: Proxy p -> Either String a` (default: `parseTypeW proxy ""`). Custom `TypeParserW` instances that relied on `parseTypeW proxy ""` being called for absent variables are unaffected by the default; however, the same caveat as `parseMissing` applies if an instance overrides `parseTypeW` for the empty-string case.++**New exports:**++* `Data.Env.ParseError` is now an exposed module exporting `ParseError(..)`, `FieldError(..)`, `renderParseError`, and `renderFieldError`. All are also re-exported from `Data.Env`.++**Improved error messages:**++* All field failures are now collected in a single pass (no short-circuiting on the first error). `ParseError` is a list of `FieldError` values, one per failing field, in field-declaration order.++* Missing required environment variables now produce `"missing required environment variable"` instead of a gigaparsec parse error on an empty string.++* Base type parsers (`String`, `Int`, `Word`, `Bool`, numeric fixed-width types) now use `P.label` to produce readable expected-descriptions (e.g. `expected an integer`) instead of raw token expectations.++* `renderParseError` formats errors with the field name on its own header line followed by the detail indented below; multiple failures are numbered.++* `EnumParser` error messages now read `invalid value "x"; expected one of: A, B, C` instead of the previous format.++ ## 0.3.0.0 -- 2026-03-22 * Fixed `DefaultBool` to follow the proper witness pattern:
README.md view
@@ -10,6 +10,7 @@ - [Contents](#contents) - [Quick Start](#quick-start) - [Custom Environment Variable Mapping](#custom-environment-variable-mapping)+ - [Error Handling](#error-handling) - [Enum Support](#enum-support) - [Witness Types: Avoiding Newtype Boilerplate](#witness-types-avoiding-newtype-boilerplate) - [The Problem: Newtype Boilerplate](#the-problem-newtype-boilerplate)@@ -42,7 +43,7 @@ main = do errOrEnv <- validateEnv @Config case errOrEnv of- Left err -> putStrLn $ "Validation failed: " ++ err+ Left err -> putStrLn $ "Validation failed:\n" ++ renderParseError err Right cfg -> putStrLn $ "Config loaded successfully: " ++ show cfg ``` @@ -70,7 +71,7 @@ main = do errOrEnv <- validateEnvWith @Config (map toUpper) case errOrEnv of- Left err -> putStrLn $ "Validation failed: " ++ err+ Left err -> putStrLn $ "Validation failed:\n" ++ renderParseError err Right cfg -> putStrLn $ "Config loaded successfully: " ++ show cfg ``` @@ -78,6 +79,61 @@ You can provide any custom mapping function to `validateEnvWith` to transform field names to environment variable names according to your needs. +## Error Handling++`validateEnv` (and its variants) returns `Either ParseError a`. Unlike a simple `Either String` approach, `ParseError` collects **all** field failures in a single pass — so every invalid field is reported at once, not just the first one.++Use `renderParseError` to format the error for display:++```Haskell+case errOrEnv of+ Left err -> putStrLn $ "Validation failed:\n" ++ renderParseError err+ Right cfg -> ...+```++A single-field failure shows the field name, then the detail indented below:++```+port: invalid field+ (line 1, column 1):+ unexpected "n"+ expected an integer+ >not-a-number+ ^+```++A missing required field gives a clear message instead of a parser error:++```+name: invalid field+ missing required environment variable+```++Multiple failures are numbered in field-declaration order:++```+2 fields failed to parse:+ 1. port: invalid field+ (line 1, column 1):+ unexpected "n"+ expected an integer+ >not-a-number+ ^+ 2. name: invalid field+ missing required environment variable+```++`ParseError` and `FieldError` are both exported from `Data.Env`, so you can also inspect them programmatically:++```Haskell+import Data.Env (ParseError(..), FieldError(..))++case errOrEnv of+ Right cfg -> ...+ Left (ParseError errs) ->+ mapM_ (\fe -> putStrLn $ fe.errField ++ " is invalid") errs+```+ ## Enum Support **[Full example →][enum-example]**@@ -94,10 +150,13 @@ deriving (Show, Eq, Enum, Bounded) deriving TypeParser via (EnumParser Gender) -print $ parseEnum @Gender "Male" -- Right Male-print $ parseEnum @Gender "Female" -- Right Female+parseType @Gender "Male" -- Right Male+parseType @Gender "Female" -- Right Female+parseType @Gender "male" -- Left "invalid value \"male\"; expected one of: Male, Female" ``` +Enum parsing is case-sensitive and the error message lists all valid constructors.+ ## Witness Types: Avoiding Newtype Boilerplate The library provides a "witness" pattern that allows you to enhance parsing behaviour without wrapping values in newtypes. This is useful when you need features like default values, validation, or transformation but want to keep your final data types simple.@@ -124,7 +183,7 @@ -- Implement custom parsing with default value instance TypeParser PsqlPort where- parseType "" = Right (PsqlPort 5432) -- Default to 5432+ parseMissing = Right (PsqlPort 5432) -- Default to 5432 when absent parseType str = case parseType str of Right port -> Right (PsqlPort port) Left err -> Left err@@ -145,8 +204,6 @@ connectToDatabase cfg = connect $ defaultConnectInfo { connectPort = unpackPort (psqlPort cfg) -- Annoying unpacking! , connectDatabase = dbName cfg }- where- unpackPort (PsqlPort port) = port ``` ### The Solution: Witnesses@@ -158,23 +215,23 @@ ```Haskell {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} import Data.Env+import Data.Env.RecordParserW+import Data.Env.TypeParserW import Data.Env.Witness.DefaultNum import Data.Word import GHC.Generics-import Data.Env.TypeParserW data Config c = Config { psqlPort :: Column c (DefaultNum 5432 Word16) Word16 -- Defaults to 5432 , dbName :: Column c (Solo String) String }- deriving (Generic, EnvSchemaW)+ deriving (Generic) -instance EnvSchemaW (Config \'Dec)+instance EnvSchemaW (Config 'Dec) deriving stock instance Show (Config 'Res) -- For printing the result -- Validate environment variables with defaults@@ -182,7 +239,7 @@ main = do errOrConfig <- validateEnvW @(Config 'Dec) case errOrConfig of- Left err -> putStrLn $ "Validation failed: " ++ err+ Left err -> putStrLn $ "Validation failed:\n" ++ renderParseError err Right cfg -> connectToDatabase cfg -- cfg :: Config 'Res ``` @@ -212,15 +269,16 @@ - **`Solo a`**: Standard parsing without special behaviour (equivalent to `TypeParser`) - **`DefaultNum n a`**: Numeric types with a type-level default value `n`-- - **`DefaultString s a`**: String types with a type-level default value `s`+- **`DefaultString s a`**: String types with a type-level default value `s`+- **`DefaultBool b a`**: `Bool` with a type-level default; also accepts `true`/`false`, `t`/`f`, `1`/`0` - **Custom witnesses**: You can define your own by implementing the `TypeParserW` class More built-in witnesses will be provided. For more complex parsing needs, witnesses provide a way to augment behaviour without polluting your domain types with wrapper noise. -[quickstart-example]: https://github.com/MMZK1526/mmzk-env/blob/v0.2.1.0/app/QuickstartExample.hs-[custom-mapping-example]: https://github.com/MMZK1526/mmzk-env/blob/v0.2.1.0/app/CustomMappingExample.hs-[enum-example]: https://github.com/MMZK1526/mmzk-env/blob/v0.2.1.0/app/EnumExample.hs-[newtype-example]: https://github.com/MMZK1526/mmzk-env/blob/v0.2.1.0/app/NewtypeExample.hs-[witness-example]: https://github.com/MMZK1526/mmzk-env/blob/v0.2.1.0/app/WitnessExample.hs+[quickstart-example]: https://github.com/MMZK1526/mmzk-env/blob/main/app/QuickstartExample.hs+[custom-mapping-example]: https://github.com/MMZK1526/mmzk-env/blob/main/app/CustomMappingExample.hs+[enum-example]: https://github.com/MMZK1526/mmzk-env/blob/main/app/EnumExample.hs+[newtype-example]: https://github.com/MMZK1526/mmzk-env/blob/main/app/NewtypeExample.hs+[witness-example]: https://github.com/MMZK1526/mmzk-env/blob/main/app/WitnessExample.hs
app/CustomMappingExample.hs view
@@ -16,12 +16,12 @@ , debug :: Maybe Bool } deriving (Show, Generic, EnvSchema) --- | Run the validation with custom mapping--- This will look for environment variables: PORT, NAME, MAINHOST, DEBUG--- Note: main_host maps to MAINHOST (not MAIN_HOST) with map toUpper+-- | Run the validation with custom mapping.+-- This looks for environment variables: PORT, NAME, MAINHOST, DEBUG+-- Note: main_host maps to MAINHOST (not MAIN_HOST) with map toUpper. main :: IO () main = do errOrEnv <- validateEnvWith @Config (map toUpper) case errOrEnv of- Left err -> putStrLn $ "Validation failed: " ++ err+ Left err -> putStrLn $ "Validation failed:\n" ++ renderParseError err Right cfg -> putStrLn $ "Config loaded successfully: " ++ show cfg
app/EnumExample.hs view
@@ -12,5 +12,12 @@ main :: IO () main = do+ putStrLn "=== Valid values ===" print $ parseType @Gender "Male" -- Right Male print $ parseType @Gender "Female" -- Right Female++ putStrLn ""+ putStrLn "=== Invalid values ==="+ print $ parseType @Gender "male" -- Left: wrong case+ print $ parseType @Gender "Other" -- Left: not a constructor+ print $ parseType @Gender "" -- Left: empty
app/NewtypeExample.hs view
@@ -4,18 +4,20 @@ module Main where +import qualified Data.Map.Strict as M import Data.Env+import Data.Env.RecordParser import Data.Env.TypeParser import Data.Word import GHC.Generics --- Define a newtype wrapper for the port+-- | A newtype wrapper for a PostgreSQL port. newtype PsqlPort = PsqlPort Word16 deriving (Show, Eq) --- Implement custom parsing with default value+-- | Custom parser: default to 5432 when the variable is absent. instance TypeParser PsqlPort where- parseType "" = Right (PsqlPort 5432) -- Default to 5432+ parseMissing = Right (PsqlPort 5432) parseType str = case parseType str of Right port -> Right (PsqlPort port) Left err -> Left err@@ -25,13 +27,24 @@ , dbName :: String } deriving (Show, Generic, EnvSchema) --- Now when you use your config, you have to constantly unwrap the value: unpackPort :: PsqlPort -> Word16-unpackPort (PsqlPort port) = port+unpackPort (PsqlPort p) = p main :: IO () main = do+ -- Demonstrate a validation failure: an out-of-range port and a missing name.+ putStrLn "=== Simulated validation failure ==="+ let badEnv = M.fromList [("psqlPort", "99999"), ("dbName", "")]+ case parseRecord @Config badEnv of+ Left err -> putStrLn $ renderParseError err+ Right _ -> pure ()++ putStrLn ""++ -- Validate from the actual environment.+ -- Set PSQL_PORT=5432 DB_NAME=mydb to see the success case.+ putStrLn "=== Validating from environment ===" errOrConfig <- validateEnv @Config case errOrConfig of- Left err -> putStrLn $ "Parse failed: " ++ err+ Left err -> putStrLn $ "Parse failed:\n" ++ renderParseError err Right cfg -> putStrLn $ "Port: " ++ show (unpackPort $ psqlPort cfg)
app/QuickstartExample.hs view
@@ -4,7 +4,9 @@ module Main where +import qualified Data.Map.Strict as M import Data.Env+import Data.Env.RecordParser import GHC.Generics -- | Example: Define an environment schema@@ -15,10 +17,25 @@ , debug :: Maybe Bool } deriving (Show, Generic, EnvSchema) --- | Run the validation main :: IO () main = do+ -- Demonstrate what a multi-field validation failure looks like.+ -- Two fields are bad: port is not a number, name is empty (missing).+ putStrLn "=== Simulated validation failure ==="+ let badEnv = M.fromList+ [ ("port", "not-a-number")+ , ("name", "") -- empty = missing required field+ , ("mainHost", "localhost") ]+ case parseRecord @Config badEnv of+ Left err -> putStrLn $ renderParseError err+ Right _ -> pure ()++ putStrLn ""++ -- Validate from the actual environment.+ -- Set PORT=8080 NAME=myapp MAIN_HOST=localhost to see the success case.+ putStrLn "=== Validating from environment ===" errOrEnv <- validateEnv @Config case errOrEnv of- Left err -> putStrLn $ "Validation failed: " ++ err+ Left err -> putStrLn $ "Validation failed:\n" ++ renderParseError err Right cfg -> putStrLn $ "Config loaded successfully: " ++ show cfg
app/WitnessExample.hs view
@@ -7,12 +7,13 @@ module Main where +import qualified Data.Map.Strict as M import Data.Env+import Data.Env.RecordParserW+import Data.Env.TypeParserW import Data.Env.Witness.DefaultNum import Data.Word import GHC.Generics-import Data.Env.RecordParserW-import Data.Env.TypeParserW data Config c = Config { psqlPort :: Column c (DefaultNum 5432 Word16) Word16 -- Defaults to 5432@@ -20,12 +21,25 @@ deriving (Generic) instance EnvSchemaW (Config 'Dec)-deriving stock instance Show (Config 'Res) -- For printing the result+deriving stock instance Show (Config 'Res) --- Validate environment variables with defaults main :: IO () main = do+ -- Demonstrate a validation failure: an invalid port and a missing db name.+ -- Note: psqlPort has a default, so it only fails when a non-empty bad value+ -- is given; dbName has no default so an empty value fails.+ putStrLn "=== Simulated validation failure ==="+ let badEnv = M.fromList [("psqlPort", "not-a-number"), ("dbName", "")]+ case parseRecordW @(Config 'Dec) badEnv of+ Left err -> putStrLn $ renderParseError err+ Right _ -> pure ()++ putStrLn ""++ -- Validate from the actual environment.+ -- Set DB_NAME=mydb (PSQL_PORT is optional, defaults to 5432).+ putStrLn "=== Validating from environment ===" errOrConfig <- validateEnvW @(Config 'Dec) case errOrConfig of- Left err -> putStrLn $ "Validation failed: " ++ err+ Left err -> putStrLn $ "Validation failed:\n" ++ renderParseError err Right cfg -> putStrLn $ "Config with defaults: " ++ show cfg
mmzk-env.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: mmzk-env-version: 0.3.0.0+version: 0.4.0.0 synopsis: Read environment variables into a user-defined data type description:@@ -11,8 +11,8 @@ homepage: https://github.com/MMZK1526/mmzk-env bug-reports: https://github.com/MMZK1526/mmzk-env/issues license: MIT-author: Yitang Chen <mmzk1526@outlook.com>-maintainer: Yitang Chen <mmzk1526@outlook.com>+author: MMZK1526+maintainer: MMZK1526 category: Data, Environment extra-source-files: CHANGELOG.md@@ -53,6 +53,7 @@ Data.Env Data.Env.EnumParser Data.Env.ExtractFields+ Data.Env.ParseError Data.Env.RecordParser Data.Env.RecordParserW Data.Env.TypeParser@@ -94,6 +95,7 @@ main-is: QuickstartExample.hs build-depends: base >=4.16 && <5,+ containers, mmzk-env, hs-source-dirs: app default-language: Haskell2010@@ -120,6 +122,7 @@ main-is: NewtypeExample.hs build-depends: base >=4.16 && <5,+ containers, mmzk-env, hs-source-dirs: app default-language: Haskell2010
src/Data/Env.hs view
@@ -6,10 +6,18 @@ -- -- This module provides functionality to validate environment variables against -- a schema (a type that implements the `EnvSchema` class).-module Data.Env ( EnvSchema(..), EnvSchemaW(..) ) where+module Data.Env (+ EnvSchema (..),+ EnvSchemaW (..),+ ParseError (..),+ FieldError (..),+ renderParseError,+ renderFieldError,+) where import Control.Monad.IO.Class import Data.Env.ExtractFields+import Data.Env.ParseError import Data.Env.RecordParser import Data.Env.RecordParserW @@ -17,15 +25,15 @@ class (ExtractFields a, RecordParser a) => EnvSchema a where -- | Validate the environment variables against the schema, transforming field -- names from camelCase to UPPER_SNAKE_CASE.- validateEnv :: MonadIO m => m (Either String a)+ validateEnv :: MonadIO m => m (Either ParseError a) validateEnv = do envRaw <- getEnvRawCamelCaseToUpperSnake @a return $ parseRecord envRaw -- | Validate the environment variables against the schema, allowing for a- -- cusutom transformation function to be applied to the field names to match+ -- custom transformation function to be applied to the field names to match -- with the environment variable names.- validateEnvWith :: MonadIO m => (String -> String) -> m (Either String a)+ validateEnvWith :: MonadIO m => (String -> String) -> m (Either ParseError a) validateEnvWith transform = do envRaw <- getEnvRaw @a transform return $ parseRecord envRaw@@ -44,20 +52,20 @@ -- -- instance EnvSchemaW (Config \'Dec) ----- loadConfig :: IO (Either String (Config \'Res))+-- loadConfig :: IO (Either ParseError (Config \'Res)) -- loadConfig = validateEnvW \@(Config \'Dec) -- @ class (ExtractFields a, RecordParserW a) => EnvSchemaW a where -- | Validate environment variables, transforming field names from camelCase -- to UPPER_SNAKE_CASE. Returns the parsed configuration with unwrapped values.- validateEnvW :: MonadIO m => m (Either String (RecordParsedType a))+ validateEnvW :: MonadIO m => m (Either ParseError (RecordParsedType a)) validateEnvW = do envRaw <- getEnvRawCamelCaseToUpperSnake @a return $ parseRecordW @a envRaw -- | Validate environment variables with a custom field name transformation -- function. Returns the parsed configuration with unwrapped values.- validateEnvWWith :: MonadIO m => (String -> String) -> m (Either String (RecordParsedType a))+ validateEnvWWith :: MonadIO m => (String -> String) -> m (Either ParseError (RecordParsedType a)) validateEnvWWith transform = do envRaw <- getEnvRaw @a transform return $ parseRecordW @a envRaw
src/Data/Env/EnumParser.hs view
@@ -19,6 +19,7 @@ module Data.Env.EnumParser where import Data.Env.TypeParser ( TypeParser(..) )+import Data.List ( intercalate ) -- | A helper type for parsing Bounded Enums. newtype EnumParser a = EnumParser a@@ -28,6 +29,7 @@ parseType :: (Enum a, Show a, Bounded a) => String -> Either String (EnumParser a) parseType s = case lookup s enumMap of Just v -> Right (EnumParser v)- Nothing -> Left $ "Cannot parse value: " ++ s ++ ". Valid values are: " ++ show (map fst enumMap)+ Nothing -> Left $ "invalid value " ++ show s+ ++ "; expected one of: " ++ intercalate ", " (map fst enumMap) where enumMap = [(show e, e) | e <- [minBound..maxBound]]
+ src/Data/Env/ParseError.hs view
@@ -0,0 +1,68 @@+-- |+-- 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 (..),+ renderFieldError,+ renderParseError,+) where++import Data.List ( intercalate )++-- | A parse failure for a single record field.+data FieldError = FieldError+ { errField :: String -- ^ The Haskell record field name.+ , errMessage :: String -- ^ What went wrong parsing the value.+ } deriving (Show, Eq)++-- | 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)++-- | 'ParseError' is a 'Semigroup' so failures from different fields can be+-- accumulated by the generic record parser.+instance Semigroup ParseError where+ ParseError a <> ParseError b = ParseError (a <> b)++instance Monoid ParseError where+ mempty = ParseError []++-- | Render a single field error: the field name on the first line, then the+-- detail message indented below.+--+-- @+-- port: invalid field+-- (line 1, column 1):+-- unexpected "n"+-- expected an integer+-- >not-a-number+-- ^+-- @+renderFieldError :: FieldError -> String+renderFieldError fe =+ fe.errField ++ ": invalid field\n" ++ indentMsg " " fe.errMessage++-- | Render all parse errors as a human-readable string.+--+-- A single failure uses 'renderFieldError'; multiple failures are numbered.+renderParseError :: ParseError -> String+renderParseError (ParseError []) = "no parse errors"+renderParseError (ParseError [e]) = renderFieldError e+renderParseError (ParseError es) =+ show (length es) ++ " fields failed to parse:\n"+ ++ intercalate "\n" (zipWith renderNumbered [1 :: Int ..] es)+ where+ renderNumbered i e =+ " " ++ show i ++ ". " ++ e.errField ++ ": invalid field\n"+ ++ indentMsg " " e.errMessage++-- Indent every line of a (possibly multi-line) message by a fixed prefix.+indentMsg :: String -> String -> String+indentMsg prefix = intercalate "\n" . map (prefix ++) . lines
src/Data/Env/RecordParser.hs view
@@ -8,64 +8,91 @@ -- This module provides a type class 'RecordParser' that provides parsers for -- records. The parsers are used to parse environment variables into records -- based on their string representation.+--+-- Unlike a plain 'Either'-based approach, the generic implementation uses an+-- internal 'Validation' applicative so that every field is attempted and all+-- failures are collected into a single 'ParseError'. module Data.Env.RecordParser ( RecordParser (..), ) where +import Data.Env.ParseError import Data.Env.TypeParser import Data.Map ( Map ) import Data.Map qualified as M-import Data.Maybe import GHC.Generics -- | Type class for validating environment schemas. class RecordParser a where- parseRecord :: Map String String -> Either String a+ -- | Parse a record from a map of field-name → raw-string values.+ -- Returns a 'ParseError' listing *all* fields that failed, not just the+ -- first one.+ parseRecord :: Map String String -> Either ParseError a - -- | Parse a record, converting 'Either' to 'Maybe' and dropping any error messages.- --- -- This is a convenience function that calls 'parseRecord' and converts the result- -- from 'Either String a' to 'Maybe a', discarding the error message on failure.+ -- | Parse a record, discarding any error message on failure. parseRecord' :: Map String String -> Maybe a parseRecord' env = case parseRecord env of Right val -> Just val Left _ -> Nothing instance (Generic a, GRecordParser (Rep a)) => RecordParser a where+ parseRecord env = validationToEither (to <$> gParseRecord env) - parseRecord :: (Generic a, GRecordParser (Rep a))- => Map String String -> Either String a- parseRecord env = 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 -------------------------------------------------------------------------------- -- | Generic validation class. class GRecordParser f where- gParseRecord :: Map String String -> Either String (f p)+ gParseRecord :: Map String String -> Validation ParseError (f p) -- | Handle metadata (wrapping fields in 'GHC.Generics.M1') instance GRecordParser f => GRecordParser (M1 D c f) where- gParseRecord :: Map String String -> Either String (M1 D c f p) gParseRecord env = M1 <$> gParseRecord env -- | Handle metadata (wrapping fields in 'GHC.Generics.M1') instance GRecordParser f => GRecordParser (M1 C c f) where- gParseRecord :: Map String String -> Either String (M1 C c f p) gParseRecord env = M1 <$> gParseRecord env --- | Handle multiple fields in a record+-- | Handle multiple fields in a record — uses 'Validation' so both sides are+-- always evaluated, accumulating all failures. instance (GRecordParser f, GRecordParser g) => GRecordParser (f :*: g) where- gParseRecord :: Map String String -> Either String ((f :*: g) p) gParseRecord env = (:*:) <$> gParseRecord env <*> gParseRecord env --- | Handle individual fields+-- | Handle an individual field — wraps any 'TypeParser' failure in a+-- 'FieldError' keyed by the Haskell field name. instance (TypeParser a, Selector s) => GRecordParser (M1 S s (K1 i a)) where- gParseRecord :: Map String String -> Either String (M1 S s (K1 i a) p) gParseRecord env =- let key = selName (undefined :: M1 S s (K1 i a) p)- in M1 . K1 <$> case parseType (fromMaybe "" $ M.lookup key env) of- Left err -> Left $ "Field " ++ show key ++ " parsing error:\n" ++ err- Right val -> Right val+ let key = selName (undefined :: M1 S s (K1 i a) p)+ result = case M.lookup key env of+ Nothing -> parseMissing @a+ Just "" -> parseMissing @a+ Just v -> parseType v+ in M1 . K1 <$> case result of+ Left msg -> VFailure $ ParseError [FieldError { errField = key, errMessage = msg }]+ Right val -> VSuccess val
src/Data/Env/RecordParserW.hs view
@@ -10,6 +10,10 @@ -- records with witness types. The parsers are used to parse environment variables -- into records based on their string representation, with the witness types -- providing custom parsing behavior per field.+--+-- Like 'RecordParser', the generic implementation uses an internal 'Validation'+-- applicative so that all field failures are collected rather than+-- short-circuiting on the first one. module Data.Env.RecordParserW ( RecordParserW (..), ColumnType (..),@@ -18,11 +22,11 @@ ) where import Data.Data+import Data.Env.ParseError import Data.Env.TypeParserW import Data.Kind import Data.Map ( Map ) import Data.Map qualified as M-import Data.Maybe import GHC.Generics -- | Column type indicator for distinguishing between declaration and result types.@@ -49,12 +53,11 @@ type RecordParsedType a -- | Parse a record from environment variables using witness types.- parseRecordW :: Map String String -> Either String (RecordParsedType a)+ -- Returns a 'ParseError' listing *all* fields that failed, not just the+ -- first one.+ parseRecordW :: Map String String -> Either ParseError (RecordParsedType a) - -- | Parse a record, converting 'Either' to 'Maybe' and dropping any error messages.- --- -- This is a convenience function that calls 'parseRecordW' and converts the result- -- from 'Either String a' to 'Maybe a', discarding the error message on failure.+ -- | Parse a record, discarding any error message on failure. parseRecordW' :: Map String String -> Maybe (RecordParsedType a) parseRecordW' env = case parseRecordW @a env of Right val -> Just val@@ -68,11 +71,35 @@ ) => RecordParserW (a 'Dec) where type RecordParsedType (a 'Dec) = a 'Res - parseRecordW :: Map String String -> Either String (RecordParsedType (a 'Dec))- parseRecordW a = to <$> gParseRecord @(Rep (a 'Dec)) a+ parseRecordW :: Map String String -> Either ParseError (RecordParsedType (a 'Dec))+ parseRecordW a = validationToEither (to <$> gParseRecord @(Rep (a 'Dec)) a) --------------------------------------------------------------------------------+-- 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 -------------------------------------------------------------------------------- @@ -80,39 +107,41 @@ class GRecordParserW f where type GRecordParsedType f :: k -> Type - gParseRecord :: Map String String -> Either String ((GRecordParsedType f) r)+ gParseRecord :: Map String String -> Validation ParseError ((GRecordParsedType f) r) -- | Handle metadata (wrapping fields in 'GHC.Generics.M1') instance GRecordParserW f => GRecordParserW (M1 D c f) where type GRecordParsedType (M1 D c f) = M1 D c (GRecordParsedType f) - gParseRecord :: Map String String -> Either String (GRecordParsedType (M1 D c f) r) gParseRecord env = M1 <$> gParseRecord @f env -- | Handle metadata (wrapping fields in 'GHC.Generics.M1') instance GRecordParserW f => GRecordParserW (M1 C c f) where type GRecordParsedType (M1 C c f) = M1 C c (GRecordParsedType f) - gParseRecord :: Map String String -> Either String (GRecordParsedType (M1 C c f) r) gParseRecord env = M1 <$> gParseRecord @f env --- | Handle multiple fields in a record+-- | Handle multiple fields in a record — uses 'Validation' so both sides are+-- always evaluated, accumulating all failures. instance (GRecordParserW f, GRecordParserW g) => GRecordParserW (f :*: g) where type GRecordParsedType (f :*: g) = GRecordParsedType f :*: GRecordParsedType g - gParseRecord :: Map String String -> Either String ((GRecordParsedType f :*: GRecordParsedType g) p) gParseRecord env = (:*:) <$> gParseRecord @f env <*> gParseRecord @g env --- | Handle individual fields+-- | Handle an individual field — wraps any 'TypeParserW' failure in a+-- 'FieldError' keyed by the Haskell field name. instance (TypeParserW p a, Selector s) => GRecordParserW (M1 S s (K1 i (p, a))) where type GRecordParsedType (M1 S s (K1 i (p, a))) = M1 S s (K1 i a) - gParseRecord :: Map String String -> Either String (M1 S s (K1 i a) r) gParseRecord env =- let key = selName (undefined :: M1 S s (K1 i a) p)- in M1 . K1 <$> case parseTypeW @p Proxy (fromMaybe "" $ M.lookup key env) of- Left err -> Left $ "Field " ++ show key ++ " parsing error:\n" ++ err- Right val -> Right val+ let key = selName (undefined :: M1 S s (K1 i a) p)+ result = case M.lookup key env of+ Nothing -> parseMissingW @p Proxy+ Just "" -> parseMissingW @p Proxy+ Just v -> parseTypeW @p Proxy v+ in M1 . K1 <$> case result of+ Left msg -> VFailure $ ParseError [FieldError { errField = key, errMessage = msg }]+ Right val -> VSuccess val -- | Type alias for declaring fields with polymorphic witness types. --
src/Data/Env/TypeParser.hs view
@@ -14,6 +14,7 @@ ) where import Data.Int (Int8, Int16, Int32, Int64)+import Data.Set qualified as Set import Data.Text qualified as T import Data.Text.Lazy qualified as TL import Data.Tuple ( Solo(..) )@@ -29,7 +30,7 @@ -- | Type class for parsers associated with types. class TypeParser a where- -- | parse a value by its string representation.+ -- | Parse a value by its string representation. parseType :: String -> Either String a default parseType@@ -37,10 +38,16 @@ parseType s = to <$> gTypeParser s {-# INLINE parseType #-} - -- | Parse a value, converting 'Either' to 'Maybe' and dropping any error messages.+ -- | Result to use when the environment variable is absent (empty string). --- -- This is a convenience function that calls 'parseType' and converts the result- -- from 'Either String a' to 'Maybe a', discarding the error message on failure.+ -- The default signals that the variable is required. Override this for+ -- types that have a meaningful absence value, e.g. 'Maybe' returns+ -- 'Right' 'Nothing'.+ parseMissing :: Either String a+ parseMissing = Left "missing required environment variable"+ {-# INLINE parseMissing #-}++ -- | Parse a value, converting 'Either' to 'Maybe' and dropping any error messages. parseType' :: String -> Maybe a parseType' str = case parseType str of Right val -> Just val@@ -49,105 +56,111 @@ -- | Required (non-empty) String field. ----- in POSIX systems, an empty env variable is equivalent to an undefined env+-- In POSIX systems, an empty env variable is equivalent to an undefined env -- variable. To ensure consistency across platforms, we require that all -- environment variables are non-empty. instance TypeParser String where parseType :: String -> Either String String- parseType = parse (P.some P.item)+ parseType = parse (P.label (Set.singleton "a non-empty string") (P.some P.item)) {-# INLINE parseType #-} -- | Required @Integer@ field (parsed from String). instance TypeParser Integer where parseType :: String -> Either String Integer- parseType = parse (L.decimal integerParser)+ parseType = parse (P.label (Set.singleton "an integer") (L.decimal integerParser)) {-# INLINE parseType #-} -- | Required @Int@ field (parsed from String). instance TypeParser Int where parseType :: String -> Either String Int parseType = (fromInteger <$>) . parse do- P.filterSWith (simpleErrorGen "Int out of bound")- validateInt- (L.decimal integerParser)+ P.filterSWith (simpleErrorGen boundsMsg) validateInt+ $ P.label (Set.singleton "an integer") (L.decimal integerParser) where validateInt n = n >= fromIntegral @Int minBound && n <= fromIntegral @Int maxBound+ boundsMsg = "integer out of range for Int (valid: "+ ++ show (minBound :: Int) ++ " to " ++ show (maxBound :: Int) ++ ")" {-# INLINE parseType #-} -- | Required @Word@ field (parsed from String). instance TypeParser Word where parseType :: String -> Either String Word parseType = (fromInteger <$>) . parse do- P.filterSWith (simpleErrorGen "Word out of bound")- validateWord- (L.decimal naturalParser)+ P.filterSWith (simpleErrorGen boundsMsg) validateWord+ $ P.label (Set.singleton "a natural number") (L.decimal naturalParser) where validateWord n = n <= fromIntegral @Word maxBound+ boundsMsg = "natural number out of range for Word (valid: 0 to "+ ++ show (maxBound :: Word) ++ ")" {-# INLINE parseType #-} -- | Required @Bool@ field (parsed from String).+--+-- Accepts only @True@ or @False@ (case-sensitive). For a more lenient+-- boolean parser (accepting @true@, @1@, @t@, etc.) use the @DefaultBool@+-- witness. instance TypeParser Bool where parseType :: String -> Either String Bool- parseType = parse do- P.choice [P.string "True" P.$> True, P.string "False" P.$> False]+ parseType = parse $ P.label (Set.fromList ["True", "False"])+ $ P.choice [P.string "True" P.$> True, P.string "False" P.$> False] {-# INLINE parseType #-} -- | Required @Int8@ field (parsed from String). instance TypeParser Int8 where parseType :: String -> Either String Int8- parseType = parse (L.decimal8 integerParser)+ parseType = parse (P.label (Set.singleton "an integer") (L.decimal8 integerParser)) {-# INLINE parseType #-} -- | Required @Int16@ field (parsed from String). instance TypeParser Int16 where parseType :: String -> Either String Int16- parseType = parse (L.decimal16 integerParser)+ parseType = parse (P.label (Set.singleton "an integer") (L.decimal16 integerParser)) {-# INLINE parseType #-} -- | Required @Int32@ field (parsed from String). instance TypeParser Int32 where parseType :: String -> Either String Int32- parseType = parse (L.decimal32 integerParser)+ parseType = parse (P.label (Set.singleton "an integer") (L.decimal32 integerParser)) {-# INLINE parseType #-} -- | Required @Int64@ field (parsed from String). instance TypeParser Int64 where parseType :: String -> Either String Int64- parseType = parse (L.decimal64 integerParser)+ parseType = parse (P.label (Set.singleton "an integer") (L.decimal64 integerParser)) {-# INLINE parseType #-} -- | Required @Word8@ field (parsed from String). instance TypeParser Word8 where parseType :: String -> Either String Word8- parseType = parse (L.decimal8 naturalParser)+ parseType = parse (P.label (Set.singleton "a natural number") (L.decimal8 naturalParser)) {-# INLINE parseType #-} -- | Required @Word16@ field (parsed from String). instance TypeParser Word16 where parseType :: String -> Either String Word16- parseType = parse (L.decimal16 naturalParser)+ parseType = parse (P.label (Set.singleton "a natural number") (L.decimal16 naturalParser)) {-# INLINE parseType #-} -- | Required @Word32@ field (parsed from String). instance TypeParser Word32 where parseType :: String -> Either String Word32- parseType = parse (L.decimal32 naturalParser)+ parseType = parse (P.label (Set.singleton "a natural number") (L.decimal32 naturalParser)) {-# INLINE parseType #-} -- | Required @Word64@ field (parsed from String). instance TypeParser Word64 where parseType :: String -> Either String Word64- parseType = parse (L.decimal64 naturalParser)+ parseType = parse (P.label (Set.singleton "a natural number") (L.decimal64 naturalParser)) {-# INLINE parseType #-} --- | Required strict @Text@ field (parsed from String)+-- | Required strict @Text@ field (parsed from String). instance TypeParser T.Text where parseType :: String -> Either String T.Text parseType = fmap T.pack . parseType {-# INLINE parseType #-} --- | Required lazy @Text@ field (parsed from String)+-- | Required lazy @Text@ field (parsed from String). instance TypeParser TL.Text where parseType :: String -> Either String TL.Text parseType = fmap TL.pack . parseType@@ -156,7 +169,7 @@ -- | Required @()@ field (parsed from String). instance TypeParser () where parseType :: String -> Either String ()- parseType = parse (P.string "()" P.$> ())+ parseType = parse (P.label (Set.singleton "\"()\"") (P.string "()" P.$> ())) {-# INLINE parseType #-} -- | Solo fields isomorphic to the original (@Solo a@).@@ -170,7 +183,14 @@ {-# INLINE parseType #-} -- | Optional fields (@Maybe a@).+--+-- An absent (empty) value maps to 'Nothing'; a non-empty value is parsed+-- by the inner 'TypeParser'. instance TypeParser a => TypeParser (Maybe a) where+ -- | An absent optional field is 'Nothing', not an error.+ parseMissing :: Either String (Maybe a)+ parseMissing = Right Nothing+ parseType :: String -> Either String (Maybe a) parseType "" = Right Nothing parseType s = Just <$> parseType s@@ -203,7 +223,7 @@ {-# INLINE naturalParser #-} parseResultToEither :: P.Result String a -> Either String a-parseResultToEither (P.Failure e) = Left (show e)+parseResultToEither (P.Failure e) = Left e parseResultToEither (P.Success a) = Right a {-# INLINE parseResultToEither #-}
src/Data/Env/TypeParserW.hs view
@@ -41,6 +41,16 @@ -- how the parsing should be performed. 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. 'DefaultNum', 'DefaultString',+ -- 'DefaultBool'). Override this for witnesses that delegate to a+ -- 'TypeParser' instance — 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@@ -53,6 +63,11 @@ instance TypeParser a => TypeParserW (Solo a) a where parseTypeW :: Proxy (Solo a) -> String -> Either String a parseTypeW _ = parseType++ -- | Delegates to 'parseMissing' from 'TypeParser', so a 'Solo' field+ -- with no default behaves the same as a plain 'TypeParser' field.+ 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
test/RecordParserSpec.hs view
@@ -1,8 +1,8 @@ module RecordParserSpec ( spec ) where import Data.Coerce ( coerce )-import Data.Either ( isLeft ) import Data.Env.EnumParser+import Data.Env.ParseError import Data.Env.RecordParser import Data.Env.TypeParser import Data.Map qualified as M@@ -33,18 +33,52 @@ it "parses a valid record" do let env = M.fromList [("name", "Alice"), ("age", "30")] parseRecord @Person env `shouldBe` Right (Person "Alice" (Age 30) Nothing)+ it "allows extra fields" do let env = M.fromList [("name", "Alice"), ("age", "30"), ("extra", "value")] parseRecord @Person env `shouldBe` Right (Person "Alice" (Age 30) Nothing)+ it "parses optional fields" do let env = M.fromList [("name", "Alice"), ("age", "30"), ("gender", "Female")] parseRecord @Person env `shouldBe` Right (Person "Alice" (Age 30) (Just Female))- it "fails to parse an invalid record" do++ it "fails to parse an invalid enum value" do let env = M.fromList [("name", "Alice"), ("age", "30"), ("gender", "Other")]- parseRecord @Person env `shouldSatisfy` isLeft+ case parseRecord @Person env of+ Right _ -> expectationFailure "expected Left"+ Left (ParseError errs) -> do+ length errs `shouldBe` 1+ (head errs).errField `shouldBe` "gender"+ (head errs).errMessage `shouldContain` "\"Other\""+ (head errs).errMessage `shouldContain` "Male"+ (head errs).errMessage `shouldContain` "Female"+ it "fails to parse an invalid age" do let env = M.fromList [("name", "Alice"), ("age", "150"), ("gender", "Female")]- parseRecord @Person env `shouldSatisfy` isLeft- it "fails to parse a missing field" do+ case parseRecord @Person env of+ Right _ -> expectationFailure "expected Left"+ Left (ParseError errs) -> do+ length errs `shouldBe` 1+ (head errs).errField `shouldBe` "age"+ (head errs).errMessage `shouldBe` "Age is not within range!"++ it "fails to parse a missing required field" do let env = M.fromList [("name", "Alice")]- parseRecord @Person env `shouldSatisfy` isLeft+ case parseRecord @Person env of+ Right _ -> expectationFailure "expected Left"+ Left (ParseError errs) -> do+ length errs `shouldBe` 1+ (head errs).errField `shouldBe` "age"+ (head errs).errMessage `shouldBe` "missing required environment variable"++ it "collects errors from multiple invalid fields in one pass" do+ let env = M.fromList [("name", "Alice"), ("age", "150"), ("gender", "Other")]+ case parseRecord @Person env of+ Right _ -> expectationFailure "expected Left"+ Left (ParseError errs) -> do+ -- Both age and gender fail; name succeeds.+ 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!"+ (errs !! 1).errMessage `shouldContain` "\"Other\""
test/RecordParserWSpec.hs view
@@ -3,7 +3,7 @@ module RecordParserWSpec (spec) where import Data.Data-import Data.Either ( isLeft )+import Data.Env.ParseError import Data.Env.RecordParserW import Data.Env.TypeParser import Data.Env.TypeParserW@@ -39,15 +39,46 @@ it "uses default port 5432 and default debug False when not specified" do let envMap = M.fromList [("env", "production"), ("name", "name")] parseRecordW @(Config 'Dec) envMap `shouldBe` Right (Config 5432 "production" "name" False)+ it "parses config with custom port and explicit debug" do let envMap = M.fromList [("port", "8080"), ("env", "development"), ("name", "name"), ("debug", "True")] parseRecordW @(Config 'Dec) envMap `shouldBe` Right (Config 8080 "development" "name" True)+ it "fails to parse invalid port value" do let envMap = M.fromList [("port", "not-a-number"), ("env", "test"), ("name", "name")]- parseRecordW @(Config 'Dec) envMap `shouldSatisfy` isLeft+ case parseRecordW @(Config 'Dec) envMap of+ Right _ -> expectationFailure "expected Left"+ Left (ParseError errs) -> do+ length errs `shouldBe` 1+ (head errs).errField `shouldBe` "port"+ (head errs).errMessage `shouldSatisfy` (not . null)+ it "fails to parse invalid name value" do let envMap = M.fromList [("env", "test"), ("name", "1234567890poiuytrewq")]- parseRecordW @(Config 'Dec) envMap `shouldSatisfy` isLeft+ case parseRecordW @(Config 'Dec) envMap of+ Right _ -> expectationFailure "expected Left"+ Left (ParseError errs) -> do+ length errs `shouldBe` 1+ (head errs).errField `shouldBe` "name"+ (head errs).errMessage `shouldBe` "Name Too Long!!"+ it "fails to parse invalid debug value" do let envMap = M.fromList [("env", "test"), ("name", "name"), ("debug", "yes")]- parseRecordW @(Config 'Dec) envMap `shouldSatisfy` isLeft+ case parseRecordW @(Config 'Dec) envMap of+ Right _ -> expectationFailure "expected Left"+ Left (ParseError errs) -> do+ length errs `shouldBe` 1+ (head errs).errField `shouldBe` "debug"+ (head errs).errMessage `shouldSatisfy` (not . null)++ it "collects errors from multiple invalid fields in one pass" do+ -- port is invalid; name is too long; env and debug are fine (debug defaults).+ let envMap = M.fromList [("port", "not-a-number"), ("env", "test"), ("name", "1234567890poiuytrewq")]+ case parseRecordW @(Config 'Dec) envMap of+ Right _ -> expectationFailure "expected Left"+ Left (ParseError errs) -> do+ length errs `shouldBe` 2+ -- Errors in field-declaration order: port before name.+ map (.errField) errs `shouldBe` ["port", "name"]+ (errs !! 0).errMessage `shouldSatisfy` (not . null)+ (errs !! 1).errMessage `shouldBe` "Name Too Long!!"