Env.hs

{-# LANGUAGE AllowAmbiguousTypes #-}

{- |
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
  , validateEnvWDefaultFromMap
  , 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
import Data.Map ( Map )

-- | Type class for validating plain (non-witness) environment schemas.
class (ExtractFields a, RecordParser a) => EnvSchema a where
  -- | Validate environment variables, mapping field names from camelCase
  -- to UPPER_SNAKE_CASE.
  validateEnv :: MonadIO m => m (Either ParseError a)
  validateEnv = do
    envRaw <- getEnvRawCamelCaseToUpperSnake @a
    pure $ parseRecord envRaw

  -- | Validate with a custom field-name transform.
  validateEnvWith :: MonadIO m => (String -> String) -> m (Either ParseError a)
  validateEnvWith transform = do
    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
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 using the supplied schema value.
  validateEnvW :: MonadIO m => a -> m (Either ParseError (RecordParsedType a))
  validateEnvW schema = do
    envRaw <- getEnvRawCamelCaseToUpperSnake @a
    pure $ parseRecordW schema envRaw

  -- | 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
    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
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)

{- | 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)