packages feed

mmzk-env 0.4.0.0 → 0.5.0.0

raw patch · 9 files changed

+460/−238 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Data.Env.RecordParserW: instance (Data.Env.TypeParserW.TypeParserW p a, GHC.Generics.Selector s) => Data.Env.RecordParserW.GRecordParserW (GHC.Generics.M1 GHC.Generics.S s (GHC.Generics.K1 i (p, a)))
- Data.Env.RecordParserW: instance forall k (f :: k -> *) (c :: GHC.Generics.Meta). Data.Env.RecordParserW.GRecordParserW f => Data.Env.RecordParserW.GRecordParserW (GHC.Generics.M1 GHC.Generics.C c f)
- Data.Env.RecordParserW: instance forall k (f :: k -> *) (c :: GHC.Generics.Meta). Data.Env.RecordParserW.GRecordParserW f => Data.Env.RecordParserW.GRecordParserW (GHC.Generics.M1 GHC.Generics.D c f)
- Data.Env.RecordParserW: instance forall k (f :: k -> *) (g :: k -> *). (Data.Env.RecordParserW.GRecordParserW f, Data.Env.RecordParserW.GRecordParserW g) => Data.Env.RecordParserW.GRecordParserW (f GHC.Generics.:*: g)
- Data.Env.RecordParserW: parseRecordW' :: RecordParserW a => Map String String -> Maybe (RecordParsedType a)
- Data.Env.RecordParserW: type Di f c a = Column c (f a) a
+ Data.Env: class HasDefaultSchema a
+ Data.Env: defaultSchema :: HasDefaultSchema a => a 'Dec
+ Data.Env: validateEnvWDefault :: forall a m. (EnvSchemaW (a 'Dec), HasDefaultSchema a, MonadIO m) => m (Either ParseError (RecordParsedType (a 'Dec)))
+ Data.Env.RecordParserW: class HasDefaultSchema a
+ Data.Env.RecordParserW: defaultSchema :: HasDefaultSchema a => a 'Dec
+ Data.Env.RecordParserW: fromTypeParserW :: forall p a. TypeParserW p a => String -> Either String a
+ Data.Env.RecordParserW: instance (Data.Env.RecordParserW.GDefaultSchema f, Data.Env.RecordParserW.GDefaultSchema g) => Data.Env.RecordParserW.GDefaultSchema (f GHC.Generics.:*: g)
+ Data.Env.RecordParserW: instance (Data.Env.RecordParserW.GRecordParserW f, Data.Env.RecordParserW.GRecordParserW g) => Data.Env.RecordParserW.GRecordParserW (f GHC.Generics.:*: g)
+ Data.Env.RecordParserW: instance (GHC.Generics.Generic (a 'Data.Env.RecordParserW.Dec), Data.Env.RecordParserW.GDefaultSchema (GHC.Generics.Rep (a 'Data.Env.RecordParserW.Dec))) => Data.Env.RecordParserW.HasDefaultSchema a
+ Data.Env.RecordParserW: instance Data.Env.RecordParserW.GDefaultSchema f => Data.Env.RecordParserW.GDefaultSchema (GHC.Generics.M1 GHC.Generics.C c f)
+ Data.Env.RecordParserW: instance Data.Env.RecordParserW.GDefaultSchema f => Data.Env.RecordParserW.GDefaultSchema (GHC.Generics.M1 GHC.Generics.D c f)
+ Data.Env.RecordParserW: instance Data.Env.RecordParserW.GRecordParserW f => Data.Env.RecordParserW.GRecordParserW (GHC.Generics.M1 GHC.Generics.C c f)
+ Data.Env.RecordParserW: instance Data.Env.RecordParserW.GRecordParserW f => Data.Env.RecordParserW.GRecordParserW (GHC.Generics.M1 GHC.Generics.D c f)
+ Data.Env.RecordParserW: instance Data.Env.TypeParser.TypeParser a => Data.Env.RecordParserW.GDefaultSchema (GHC.Generics.M1 GHC.Generics.S s (GHC.Generics.K1 i (GHC.Base.String -> Data.Either.Either GHC.Base.String a)))
+ Data.Env.RecordParserW: instance GHC.Generics.Selector s => Data.Env.RecordParserW.GRecordParserW (GHC.Generics.M1 GHC.Generics.S s (GHC.Generics.K1 i (GHC.Base.String -> Data.Either.Either GHC.Base.String a)))
+ Data.Env.RecordParserW: orElse :: (String -> Either String a) -> a -> String -> Either String a
+ Data.Env.RecordParserW: typeParser :: forall a. TypeParser a => String -> Either String a
- Data.Env: validateEnvW :: (EnvSchemaW a, MonadIO m) => m (Either ParseError (RecordParsedType a))
+ Data.Env: validateEnvW :: (EnvSchemaW a, MonadIO m) => a -> m (Either ParseError (RecordParsedType a))
- Data.Env: validateEnvWWith :: (EnvSchemaW a, MonadIO m) => (String -> String) -> m (Either ParseError (RecordParsedType a))
+ Data.Env: validateEnvWWith :: (EnvSchemaW a, MonadIO m) => (String -> String) -> a -> m (Either ParseError (RecordParsedType a))
- Data.Env.RecordParserW: -- | The result type after parsing, which removes witness types.
+ Data.Env.RecordParserW: -- | The resolved type produced by parsing <tt>a</tt>.
- Data.Env.RecordParserW: parseRecordW :: RecordParserW a => Map String String -> Either ParseError (RecordParsedType a)
+ Data.Env.RecordParserW: parseRecordW :: RecordParserW a => a -> Map String String -> Either ParseError (RecordParsedType a)
- Data.Env.RecordParserW: type family Column (t :: ColumnType) (p :: Type) (a :: Type)
+ Data.Env.RecordParserW: type family Col (c :: ColumnType) (a :: Type) :: Type

Files

CHANGELOG.md view
@@ -1,6 +1,75 @@ # Revision history for mmzk-env  +## 0.5.0.0 -- 2026-07-01++### Value-level schema redesign (breaking)++The witness-column system has been replaced with a value-level schema+pattern. Schema records now use the `Col` column family instead of+`Column`/`Di`:++```haskell+-- Before:+data Config c = Config+  { port :: Di (DefaultNum 5432) c Int+  , host :: Di (DefaultString "localhost") c Text }++-- After:+data Config c = Config+  { port :: Col c Int+  , host :: Col c Text }+```++`Col 'Dec a = String -> Either String a` — each field in the declaration+record holds a parser function. `Col 'Res a = a` — unchanged.++`validateEnvW` now takes the schema value explicitly instead of a type+application:++```haskell+-- Before:+validateEnvW @(Config 'Dec)++-- After:+validateEnvW myConfig         -- myConfig :: Config 'Dec+validateEnvWDefault @Config   -- auto-derive from TypeParser instances+```++`parseRecordW` likewise takes the schema value:++```haskell+-- Before:+parseRecordW @(Config 'Dec) envMap++-- After:+parseRecordW myConfig envMap+```++`Column`, `Di`, and the old type-application-only `parseRecordW`/`validateEnvW`+are removed.++### New exports in `Data.Env.RecordParserW`++* `Col` — type family replacing `Column`/`Di`.+* `typeParser @T` — builds the standard `String -> Either String T` parser+  from the `TypeParser T` instance.+* `f \`orElse\` d` — sets the fallback value when the env variable is+  absent or empty; designed for infix: `typeParser @Int \`orElse\` 5432`.+* `fromTypeParserW @W` — bridges an existing `TypeParserW` witness into a+  field function.+* `HasDefaultSchema` / `defaultSchema @T` — generically derives a+  `T 'Dec` value whose every field uses `typeParser`.+* `validateEnvWDefault @T` — shorthand for+  `validateEnvW (defaultSchema @T)`.++### `TypeParser` and `TypeParserW` unchanged++`TypeParser`, `TypeParserW`, and all witness modules (`DefaultNum`,+`DefaultString`, `DefaultBool`) are unchanged. Witnesses remain usable+via `fromTypeParserW`.++ ## 0.4.0.0 -- 2026-04-16  **Breaking changes:**
README.md view
@@ -157,60 +157,40 @@  Enum parsing is case-sensitive and the error message lists all valid constructors. -## Witness Types: Avoiding Newtype Boilerplate+## Schema Types: Value-Level Parsing with Defaults -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.+The library provides a schema pattern that keeps your final data type clean (no newtype wrappers, no unpacking) while allowing defaults, validation, and custom parsing to be specified as plain Haskell values.  ### The Problem: Newtype Boilerplate  **[Full example →][newtype-example]** -Let's say you want to parse a PostgreSQL port that defaults to 5432. Without witnesses, you might create a newtype wrapper:+Suppose you want a PostgreSQL port that defaults to 5432. Without the schema pattern you might write a newtype:  ```Haskell-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE TypeApplications #-}--import Data.Env-import Data.Env.TypeParser-import Data.Word-import GHC.Generics---- Define a newtype wrapper for the port-newtype PsqlPort = PsqlPort Word16-  deriving (Show, Eq)+newtype PsqlPort = PsqlPort Word16 deriving (Show, Eq) --- Implement custom parsing with default value instance TypeParser PsqlPort where-  parseMissing = Right (PsqlPort 5432)  -- Default to 5432 when absent-  parseType str = case parseType str of-    Right port -> Right (PsqlPort port)-    Left err   -> Left err+  parseMissing = Right (PsqlPort 5432)+  parseType str = PsqlPort <$> parseType str -data Config = Config-  { psqlPort :: PsqlPort-  , dbName   :: String }+data Config = Config { psqlPort :: PsqlPort, dbName :: String }   deriving (Show, Generic, EnvSchema) ``` -Now when you use your config, you have to constantly unwrap the value:+Now every use site must unwrap `PsqlPort`:  ```Haskell-unpackPort :: PsqlPort -> Word16-unpackPort (PsqlPort port) = port--connectToDatabase :: Config -> IO Connection-connectToDatabase cfg = connect $ defaultConnectInfo-  { connectPort = unpackPort (psqlPort cfg)  -- Annoying unpacking!+connectToDatabase cfg = connect defaultConnectInfo+  { connectPort = unpackPort (psqlPort cfg)  -- annoying unpacking   , connectDatabase = dbName cfg } ``` -### The Solution: Witnesses+### The Solution: Schema Records  **[Full example →][witness-example]** -With witness types, you can specify parsing behaviour at the type level while keeping the final value unwrapped:+Define the config with the `Col` column family. Each field in `'Dec` holds a parser function; each field in `'Res` holds the resolved value:  ```Haskell {-# LANGUAGE DataKinds #-}@@ -218,64 +198,99 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}  import Data.Env import Data.Env.RecordParserW-import Data.Env.TypeParserW-import Data.Env.Witness.DefaultNum import Data.Word import GHC.Generics  data Config c = Config-  { psqlPort :: Column c (DefaultNum 5432 Word16) Word16  -- Defaults to 5432-  , dbName   :: Column c (Solo String) String }+  { psqlPort :: Col c Word16+  , dbName   :: Col c String }   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+-- Schema value: psqlPort defaults to 5432, dbName is required.+defaultConfig :: Config 'Dec+defaultConfig = Config+  { psqlPort = typeParser @Word16 `orElse` 5432+  , dbName   = typeParser @String }+ main :: IO () main = do-  errOrConfig <- validateEnvW @(Config 'Dec)+  errOrConfig <- validateEnvW defaultConfig   case errOrConfig of     Left err  -> putStrLn $ "Validation failed:\n" ++ renderParseError err     Right cfg -> connectToDatabase cfg  -- cfg :: Config 'Res ``` -The magic happens with the `Column` type family and the `ColumnType` phantom type:+The two column kinds: -- **`Config 'Dec`** (Declaration): The type used for parsing, where each field is `(witness, value)`-  - This works under the hood for the generic instances and users typically don't interact with it directly-- **`Config 'Res`** (Result): The type you work with, where each field is just `value`-- **`Column c witness a`**: Expands to `(witness, a)` when `c = 'Dec`, or just `a` when `c = 'Res`+- **`Config 'Dec`** — a real runtime value. Each field is a `String -> Either String a` parser function. Pass it to `validateEnvW`; swap individual fields for different defaults or custom logic.+- **`Config 'Res`** — the result after parsing. Each field is just the plain value.+- **`Col c a`** — expands to `String -> Either String a` when `c = 'Dec`, or `a` when `c = 'Res`. -Now your final config has no wrappers:+No wrappers in the result:  ```Haskell connectToDatabase :: Config 'Res -> IO Connection-connectToDatabase cfg = connect $ defaultConnectInfo-  { connectPort = psqlPort cfg  -- Direct access to Word16!-  , connectDatabase = dbName cfg }+connectToDatabase cfg = connect defaultConnectInfo+  { connectPort    = cfg.psqlPort  -- direct Word16, no unwrapping+  , connectDatabase = cfg.dbName } ``` -### Key Benefits+### Runtime overrides -1. **No Unpacking**: Your final data type contains raw values (Word16, String, etc.), not newtypes-2. **Type-Level Defaults**: Default values are specified in the type signature using type-level naturals-3. **Flexible Parsing**: Different witness types provide different parsing strategies (defaults, validation, transformation)+Because the schema is a value, you can override any field before parsing: -### Available Witnesses+```Haskell+-- Different default for a different environment:+stagingConfig :: Config 'Dec+stagingConfig = defaultConfig { psqlPort = typeParser @Word16 `orElse` 5433 } -- **`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`-- **`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+-- Custom validation:+strictDbConfig :: Config 'Dec+strictDbConfig = defaultConfig+  { dbName = \s -> do+      name <- typeParser @String s+      if length name > 32 then Left "DB name too long" else Right name }+``` -More built-in witnesses will be provided.+### Auto-derived schemas -For more complex parsing needs, witnesses provide a way to augment behaviour without polluting your domain types with wrapper noise.+If every field type has a `TypeParser` instance, `defaultSchema` derives the whole `'Dec` value automatically (all fields required, no defaults):++```Haskell+autoConfig :: Config 'Dec+autoConfig = defaultSchema @Config++-- Or validate directly:+result <- validateEnvWDefault @Config+```++### Helpers++- **`typeParser @T`** — standard parser for `T` from its `TypeParser` instance. Required by default (absent variable → error); `Maybe T` fields return `Right Nothing` when absent.+- **`f \`orElse\` d`** — wrap parser `f` so an absent or empty variable returns `Right d`.+- **`fromTypeParserW @W`** — build a field parser from a `TypeParserW` witness `W` (see below).++### Witness bridge++Existing witnesses implement `TypeParserW` and remain usable via `fromTypeParserW`:++- **`DefaultNum n a`** — numeric type with type-level default `n`.+- **`DefaultString s a`** — string type with type-level default `s`.+- **`DefaultBool b Bool`** — lenient bool parser (accepts `true`/`1`/`t`) with type-level default `b`.+- **Custom witnesses** — implement `TypeParserW` and pass to `fromTypeParserW`.++```Haskell+-- Equivalent ways to default psqlPort to 5432:+psqlPort = typeParser @Word16 `orElse` 5432+psqlPort = fromTypeParserW @(DefaultNum 5432 Word16)+```  [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
app/WitnessExample.hs view
@@ -1,45 +1,51 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingVia #-}-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE NoFieldSelectors #-}+{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}  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 Data.Env.Witness.DefaultNum (DefaultNum)+import qualified Data.Map.Strict as M+import Data.Word (Word16) import GHC.Generics  data Config c = Config-  { psqlPort :: Column c (DefaultNum 5432 Word16) Word16  -- Defaults to 5432-  , dbName   :: Column c (Solo String) String }-  deriving (Generic)+  { psqlPort :: Col c Word16+  , dbName   :: Col c String+  }+  deriving stock (Generic)  instance EnvSchemaW (Config 'Dec)+ deriving stock instance Show (Config 'Res) +-- Default schema: psqlPort defaults to 5432 via witness; dbName is required.+defaultConfig :: Config 'Dec+defaultConfig = Config+  { psqlPort = fromTypeParserW @(DefaultNum 5432 Word16)+  , dbName   = typeParser @String+  }+ 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+  case parseRecordW defaultConfig 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)+  errOrConfig <- validateEnvW defaultConfig   case errOrConfig of     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.4.0.0+version:            0.5.0.0  synopsis:           Read environment variables into a user-defined data type description:
src/Data/Env.hs view
@@ -1,71 +1,89 @@ {-# LANGUAGE AllowAmbiguousTypes #-} --- |--- Module      : Data.Env--- Description : Environment schema validation------ This module provides functionality to validate environment variables against--- a schema (a type that implements the `EnvSchema` class).-module Data.Env (-  EnvSchema (..),-  EnvSchemaW (..),-  ParseError (..),-  FieldError (..),-  renderParseError,-  renderFieldError,-) where+{- |+Module      : Data.Env+Description : Environment-variable schema validation +Top-level interface. 'EnvSchemaW' is the primary class; 'EnvSchema' covers+the simpler non-witness case.+-}+module Data.Env+  ( EnvSchema (..)+  , EnvSchemaW (..)+  , HasDefaultSchema (..)+  , validateEnvWDefault+  , 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 --- | Type class for validating environment schemas.+-- | Type class for validating plain (non-witness) environment schemas. class (ExtractFields a, RecordParser a) => EnvSchema a where-  -- | Validate the environment variables against the schema, transforming field-  -- names from camelCase to UPPER_SNAKE_CASE.+  -- | Validate environment variables, mapping field names from camelCase+  -- to UPPER_SNAKE_CASE.   validateEnv :: MonadIO m => m (Either ParseError a)   validateEnv = do     envRaw <- getEnvRawCamelCaseToUpperSnake @a-    return $ parseRecord envRaw+    pure $ parseRecord envRaw -  -- | Validate the environment variables against the schema, allowing for a-  -- custom transformation function to be applied to the field names to match-  -- with the environment variable names.+  -- | Validate with a custom field-name transform.   validateEnvWith :: MonadIO m => (String -> String) -> m (Either ParseError a)   validateEnvWith transform = do     envRaw <- getEnvRaw @a transform-    return $ parseRecord envRaw+    pure $ parseRecord envRaw --- | Type class for validating environment schemas using witness types.------ Uses the witness pattern to enhance parsing (e.g., default values) without--- wrapping final values in newtypes. Use @Config \'Dec@ for parsing and get--- @Config \'Res@ with unwrapped values as the result.------ @--- data Config c = Config---   { psqlPort :: Column c (DefaultNum 5432 Word16) Word16---   , dbName   :: Column c (Solo String) String }---   deriving (Generic)------ instance EnvSchemaW (Config \'Dec)------ loadConfig :: IO (Either ParseError (Config \'Res))--- loadConfig = validateEnvW \@(Config \'Dec)--- @+{- | Type class for validating 'Col'-based environment schemas.++The schema value (@a 'Dec@) is passed explicitly to 'validateEnvW', so+parsing behaviour — including defaults — is a runtime choice:++@+validateEnvW mySchema+validateEnvW mySchema { port = ''typeParser' \@Int \`orElse\` 5432 }+@++Use 'validateEnvWDefault' to auto-derive the schema from 'Data.Env.TypeParser.TypeParser'+instances when no overrides are needed.++Field names are converted from camelCase to UPPER_SNAKE_CASE. Notable+behaviours:++* Consecutive uppercase runs are not split: @myHTTPClient@ → @MY_HTTPCLIENT@.+* A digit before an uppercase letter inserts an underscore: @http2Client@ →+  @HTTP2_CLIENT@.+* A literal underscore passes through: @my_host@ → @MY_HOST@.+-} 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 ParseError (RecordParsedType a))-  validateEnvW = do+  -- | Validate using the supplied schema value.+  validateEnvW :: MonadIO m => a -> m (Either ParseError (RecordParsedType a))+  validateEnvW schema = do     envRaw <- getEnvRawCamelCaseToUpperSnake @a-    return $ parseRecordW @a envRaw+    pure $ parseRecordW schema 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 ParseError (RecordParsedType a))-  validateEnvWWith transform = do+  -- | Validate with a custom field-name transform.+  validateEnvWWith+    :: MonadIO m+    => (String -> String)+    -> a+    -> m (Either ParseError (RecordParsedType a))+  validateEnvWWith transform schema = do     envRaw <- getEnvRaw @a transform-    return $ parseRecordW @a envRaw+    pure $ parseRecordW schema envRaw++{- | Validate using the auto-derived default schema.++Shorthand for @'validateEnvW' ('defaultSchema' \@a)@; requires every field+type to have a 'Data.Env.TypeParser.TypeParser' instance.+-}+validateEnvWDefault+  :: forall a m+   . (EnvSchemaW (a 'Dec), HasDefaultSchema a, MonadIO m)+  => m (Either ParseError (RecordParsedType (a 'Dec)))+validateEnvWDefault = validateEnvW (defaultSchema @a)
src/Data/Env/ExtractFields.hs view
@@ -45,7 +45,7 @@           -> m (Map String String) getEnvRaw mapper = liftIO $ M.fromList <$> forM (extractFields @a) \field -> do   value <- lookupEnv (mapper field)-  return (field, fromMaybe "" value)+  pure (field, fromMaybe "" value) {-# INLINE getEnvRaw #-}  -- | Retrieve environment variables based on field names, converting them from
src/Data/Env/RecordParserW.hs view
@@ -2,85 +2,182 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE AllowAmbiguousTypes #-} --- |--- Module: Data.Env.RecordParserW--- Description: Type class that provides parsers for records with witnesses.------ This module provides a type class 'RecordParserW' that provides parsers for--- 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 (..),-  Column,-  Di,-) where+{- |+Module      : Data.Env.RecordParserW+Description : Schema-driven record parsing with value-level field parsers -import Data.Data+Provides 'RecordParserW' for parsing environment-variable schemas whose+fields use the 'Col' column family.++== Design++A @schema 'Dec@ is a plain Haskell record whose fields are functions+@'String' -> 'Either' 'String' a@. An absent or empty env variable is+passed as @""@; the function decides what to do. A @schema 'Res@ is the+same record with each field replaced by its resolved value.++@+data DbConfig c = DbConfig+  { host :: Col c Text+  , port :: Col c Int+  }+  deriving (Generic)++instance RecordParserW (DbConfig \'Dec)++-- Default schema (both fields required — no default):+schema :: DbConfig \'Dec+schema = 'defaultSchema' \@DbConfig++-- Schema with runtime defaults, using infix 'orElse':+schema' :: DbConfig \'Dec+schema' = schema+  { host = 'typeParser' \@Text \`orElse\` \"localhost\"+  , port = 'typeParser' \@Int  \`orElse\` 5432+  }+@++== Helpers++* 'typeParser' — builds the standard parser for any 'TypeParser' type.+* 'orElse' — sets the fallback value when the env variable is absent or empty.+* 'fromTypeParserW' — bridges a 'TypeParserW' witness into a field function.+-}+module Data.Env.RecordParserW+  ( RecordParserW (..)+  , HasDefaultSchema (..)+  , ColumnType (..)+  , Col+  , typeParser+  , orElse+  , fromTypeParserW+  ) where+ import Data.Env.ParseError-import Data.Env.TypeParserW-import Data.Kind-import Data.Map ( Map )+import Data.Env.TypeParser (TypeParser)+import Data.Env.TypeParser qualified as TP+import Data.Env.TypeParserW (TypeParserW)+import Data.Env.TypeParserW qualified as TPW+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 --- | Column type indicator for distinguishing between declaration and result types.+-- | Column type indicator. ----- * 'Dec' - Declaration type containing both witness and value types--- * 'Res' - Result type containing only value types+-- * 'Dec' — schema column; each field holds a @'String' -> 'Either' 'String' a@ parser.+-- * 'Res' — result column; each field holds the resolved @a@. data ColumnType = Dec | Res   deriving stock (Eq, Show) --- | Type family that maps column types to their representation.------ For 'Dec' (declaration) columns, the type is a pair of witness and value.--- For 'Res' (result) columns, the type is just the value.+-- | Type family mapping a column kind to the field representation. ----- In application code, typically only 'Res is used to access the parsed record values,--- while 'Dec is used for the schema definition during parsing.-type family Column (t :: ColumnType) (p :: Type) (a :: Type) where-  Column 'Dec p a = (p, a)-  Column 'Res p a = a+-- @'Col' ''Dec' a = 'String' -> 'Either' 'String' a@+-- @'Col' ''Res' a = a@+type family Col (c :: ColumnType) (a :: Type) :: Type where+  Col 'Dec a = String -> Either String a+  Col 'Res a = a --- | Type class for parsing environment schemas with witness types.+{- | Build the standard field parser for any 'TypeParser' type.++Passes non-empty strings to 'TP.parseType' and treats @""@ (absent or empty+env variable) as a missing value, delegating to 'TP.parseMissing'. Most+types treat absence as an error (required field); 'Maybe' returns+@'Right' 'Nothing'@.++Combine with 'orElse' to supply a fallback:++@+port = 'typeParser' \@Int \`orElse\` 5432+@+-}+typeParser :: forall a. TypeParser a => String -> Either String a+typeParser "" = TP.parseMissing @a+typeParser s = TP.parseType s+{-# INLINE typeParser #-}++{- | Set the fallback value when the env variable is absent or empty.++Designed for infix use with 'typeParser' or 'fromTypeParserW':++@+port  = 'typeParser' \@Int  \`orElse\` 5432+host  = 'typeParser' \@Text \`orElse\` \"localhost\"+model = 'typeParser' \@Text \`orElse\` \"claude-sonnet-4-6\"+@++@f \`orElse\` d@ returns @'Right' d@ when the variable is absent or empty,+and @f s@ for any non-empty string @s@.+-}+orElse :: (String -> Either String a) -> a -> String -> Either String a+orElse _ d "" = Right d+orElse f _ s = f s+{-# INLINE orElse #-}++{- | Build a field parser from a 'TypeParserW' witness.++Bridges existing witness types into the value-level field API. Also+composable with 'orElse':++@+fromTypeParserW \@MyCustomWitness \`orElse\` \"fallback\"+@+-}+fromTypeParserW :: forall p a. TypeParserW p a => String -> Either String a+fromTypeParserW "" = TPW.parseMissingW @p Proxy+fromTypeParserW s = TPW.parseTypeW @p Proxy s+{-# INLINE fromTypeParserW #-}++-- | Type class for schemas whose fields are 'Col' columns.+--+-- The method 'parseRecordW' takes the schema value (a @schema 'Dec@) and an+-- env map, returning all field failures collected rather than stopping at+-- the first. class RecordParserW a where-  -- | The result type after parsing, which removes witness types.+  -- | The resolved type produced by parsing @a@.   type RecordParsedType a -  -- | Parse a record from environment variables using witness types.-  -- Returns a 'ParseError' listing *all* fields that failed, not just the-  -- first one.-  parseRecordW :: Map String String -> Either ParseError (RecordParsedType a)--  -- | 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-    Left _    -> Nothing+  -- | Parse all fields from the env map using the schema's field functions.+  parseRecordW :: a -> Map String String -> Either ParseError (RecordParsedType a)  instance   ( Generic (a 'Dec)   , GRecordParserW (Rep (a 'Dec))-  , Generic (a Res)+  , Generic (a 'Res)   , GRecordParsedType (Rep (a 'Dec)) () ~ Rep (a 'Res) ()-  ) => RecordParserW (a 'Dec) where+  ) =>+  RecordParserW (a 'Dec)+  where   type RecordParsedType (a 'Dec) = a 'Res+  parseRecordW :: a 'Dec -> Map String String -> Either ParseError (a 'Res)+  parseRecordW schema env =+    validationToEither (to <$> gParseRecord (from schema) env) -  parseRecordW :: Map String String -> Either ParseError (RecordParsedType (a 'Dec))-  parseRecordW a = validationToEither (to <$> gParseRecord @(Rep (a 'Dec)) a)+{- | Generically derive a @schema 'Dec@ whose every field uses 'typeParser'. +Requires every field type to have a 'TypeParser' instance. Override+individual fields on the returned value to customise parsing: +@+mySchema :: MyConfig \'Dec+mySchema = ('defaultSchema' \@MyConfig)+  { host = 'typeParser' \@Text \`orElse\` \"localhost\" }+@+-}+class HasDefaultSchema a where+  defaultSchema :: a 'Dec++instance (Generic (a 'Dec), GDefaultSchema (Rep (a 'Dec))) => HasDefaultSchema a where+  defaultSchema :: a 'Dec+  defaultSchema = to gDefaultSchema++ ----------------------------------------------------------------------------------- Internal Validation applicative for error accumulation+-- Internal Validation applicative -------------------------------------------------------------------------------- --- | 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@@ -89,10 +186,10 @@  instance Semigroup e => Applicative (Validation e) where   pure = VSuccess-  VSuccess f  <*> VSuccess x  = VSuccess (f x)+  VSuccess f <*> VSuccess x = VSuccess (f x)   VFailure e1 <*> VFailure e2 = VFailure (e1 <> e2)-  VFailure e  <*> _           = VFailure e-  _           <*> VFailure e  = VFailure e+  VFailure e <*> _ = VFailure e+  _ <*> VFailure e = VFailure e  validationToEither :: Validation e a -> Either e a validationToEither (VSuccess a) = Right a@@ -100,51 +197,54 @@   ----------------------------------------------------------------------------------- Generic instances+-- Generic parsing -------------------------------------------------------------------------------- --- | Generic validation class. class GRecordParserW f where-  type GRecordParsedType f :: k -> Type--  gParseRecord :: Map String String -> Validation ParseError ((GRecordParsedType f) r)+  type GRecordParsedType f :: Type -> Type+  gParseRecord :: f () -> Map String String -> Validation ParseError ((GRecordParsedType f) ()) --- | 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 env = M1 <$> gParseRecord @f env+  gParseRecord (M1 x) env = M1 <$> gParseRecord x 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 env = M1 <$> gParseRecord @f env+  gParseRecord (M1 x) env = M1 <$> gParseRecord x env --- | 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 (x :*: y) env = (:*:) <$> gParseRecord x env <*> gParseRecord y env -  gParseRecord env = (:*:) <$> gParseRecord @f env <*> gParseRecord @g env+instance Selector s => GRecordParserW (M1 S s (K1 i (String -> Either String a))) where+  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 --- | 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 env =-    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+--------------------------------------------------------------------------------+-- Generic default schema+-------------------------------------------------------------------------------- --- | Type alias for declaring fields with polymorphic witness types.------ This is a convenience alias for 'Column c (f a) a', commonly used to declare--- record fields with a witness type @f a@ and a result type @a@.-type Di f c a = Column c (f a) a+class GDefaultSchema f where+  gDefaultSchema :: f ()++instance GDefaultSchema f => GDefaultSchema (M1 D c f) where+  gDefaultSchema :: M1 D c f ()+  gDefaultSchema = M1 gDefaultSchema++instance GDefaultSchema f => GDefaultSchema (M1 C c f) where+  gDefaultSchema :: M1 C c f ()+  gDefaultSchema = M1 gDefaultSchema++instance (GDefaultSchema f, GDefaultSchema g) => GDefaultSchema (f :*: g) where+  gDefaultSchema :: (f :*: g) ()+  gDefaultSchema = gDefaultSchema :*: gDefaultSchema++instance TypeParser a => GDefaultSchema (M1 S s (K1 i (String -> Either String a))) where+  gDefaultSchema :: M1 S s (K1 i (String -> Either String a)) ()+  gDefaultSchema = M1 (K1 (typeParser @a))
src/Data/Env/TypeParserW.hs view
@@ -44,8 +44,8 @@   -- | 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+  -- 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.   parseMissingW :: Proxy p -> Either String a   parseMissingW proxy = parseTypeW proxy ""
test/RecordParserWSpec.hs view
@@ -2,51 +2,59 @@  module RecordParserWSpec (spec) where -import Data.Data import Data.Env.ParseError import Data.Env.RecordParserW import Data.Env.TypeParser import Data.Env.TypeParserW-import Data.Env.Witness.DefaultNum+import Data.Env.Witness.DefaultBool (DefaultBool) import Data.Map qualified as M+import Data.Proxy (Proxy (..)) import GHC.Generics import Test.Hspec-import Data.Env.Witness.DefaultBool (DefaultBool) +-- Custom field parser: names may not exceed 16 characters. data NameW  instance TypeParserW NameW String where   parseTypeW :: Proxy NameW -> String -> Either String String   parseTypeW _ str = case parseType str of     Right s -> if length s > 16 then Left "Name Too Long!!" else Right s-    left    -> left-  {-# INLINE parseTypeW #-}-+    left -> left  data Config c = Config-  { port  :: Di (DefaultNum 5432) c Int-  , env   :: Di Solo c String-  , name  :: Column c NameW String-  , debug :: Di (DefaultBool 'False) c Bool+  { port  :: Col c Int+  , env   :: Col c String+  , name  :: Col c String+  , debug :: Col c Bool   }-  deriving (Generic)+  deriving stock (Generic) -deriving instance Show (Config 'Res)-deriving instance Eq (Config 'Res)+deriving stock instance Show (Config 'Res)+deriving stock instance Eq (Config 'Res) +-- Default schema: port defaults to 5432, debug to False via witness;+-- name uses the NameW witness; env is required.+defaultConfig :: Config 'Dec+defaultConfig = Config+  { port  = typeParser @Int    `orElse` 5432+  , env   = typeParser @String+  , name  = fromTypeParserW @NameW+  , debug = fromTypeParserW @(DefaultBool 'False Bool)+  }+ spec :: Spec spec = describe "parseRecordW for Config" do   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)+    parseRecordW defaultConfig 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)+    parseRecordW defaultConfig 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")]-    case parseRecordW @(Config 'Dec) envMap of+    case parseRecordW defaultConfig envMap of       Right _ -> expectationFailure "expected Left"       Left (ParseError errs) -> do         length errs `shouldBe` 1@@ -55,7 +63,7 @@    it "fails to parse invalid name value" do     let envMap = M.fromList [("env", "test"), ("name", "1234567890poiuytrewq")]-    case parseRecordW @(Config 'Dec) envMap of+    case parseRecordW defaultConfig envMap of       Right _ -> expectationFailure "expected Left"       Left (ParseError errs) -> do         length errs `shouldBe` 1@@ -64,7 +72,7 @@    it "fails to parse invalid debug value" do     let envMap = M.fromList [("env", "test"), ("name", "name"), ("debug", "yes")]-    case parseRecordW @(Config 'Dec) envMap of+    case parseRecordW defaultConfig envMap of       Right _ -> expectationFailure "expected Left"       Left (ParseError errs) -> do         length errs `shouldBe` 1@@ -72,13 +80,19 @@         (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+    case parseRecordW defaultConfig 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!!"++  it "orElse overrides the fallback at runtime" do+    let altConfig :: Config 'Dec+        altConfig = defaultConfig{port = typeParser @Int `orElse` 9999}+        envMap = M.fromList [("env", "test"), ("name", "name")]+        expected :: Config 'Res+        expected = Config 9999 "test" "name" False+    parseRecordW altConfig envMap `shouldBe` Right expected