effectful-config-file (empty) → 0.1.0.0
raw patch · 10 files changed
+773/−0 lines, 10 filesdep +basedep +bytestringdep +directory
Dependencies added: base, bytestring, directory, effectful, effectful-config-file, filepath, hs-opentelemetry-api, hs-opentelemetry-exporter-in-memory, hs-opentelemetry-instrumentation-monad-logger, hs-opentelemetry-sdk, hspec, lens, megaparsec, monad-logger, parser-combinators, temporary, text, toml-parser
Files
- LICENSE +11/−0
- README.md +3/−0
- effectful-config-file.cabal +84/−0
- src/Data/Config.hs +186/−0
- src/Data/Error/Config.hs +18/−0
- src/Effectful/Config.hs +107/−0
- src/Effectful/Config/Log.hs +79/−0
- src/Effectful/Config/Secrets.hs +44/−0
- test/Effectful/ConfigSpec.hs +239/−0
- test/Spec.hs +2/−0
+ LICENSE view
@@ -0,0 +1,11 @@+Copyright 2026 drlkf++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,3 @@+# effectful-config-file++Config-file parser and utilities to use in conjunction with effectful.
+ effectful-config-file.cabal view
@@ -0,0 +1,84 @@+cabal-version: 2.2++-- This file has been generated from package.yaml by hpack version 0.39.6.+--+-- see: https://github.com/sol/hpack++name: effectful-config-file+version: 0.1.0.0+synopsis: Config-file effect for effectful+description: Config-file parser and utilities to use in conjunction with effectful+category: Configuration+author: drlkf+maintainer: drlkf@drlkf.net+copyright: 2026 drlkf+license: BSD-3-Clause+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md++library+ exposed-modules:+ Data.Config+ Data.Error.Config+ Effectful.Config+ Effectful.Config.Log+ Effectful.Config.Secrets+ other-modules:+ Paths_effectful_config_file+ autogen-modules:+ Paths_effectful_config_file+ hs-source-dirs:+ src+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+ build-tool-depends:+ hspec-discover:hspec-discover+ build-depends:+ base >=4.7 && <5+ , bytestring >=0.12 && <1+ , directory >=1.3 && <2+ , effectful >=2.6 && <3+ , filepath >=1.5 && <2+ , hs-opentelemetry-api ==1.*+ , lens >=5.3 && <6+ , megaparsec >=9.7 && <10+ , monad-logger >=0.3 && <1+ , parser-combinators >=1.3 && <2+ , text >=2.1 && <3+ , toml-parser ==2.*+ default-language: Haskell2010++test-suite effectful-config-file-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Effectful.ConfigSpec+ Paths_effectful_config_file+ autogen-modules:+ Paths_effectful_config_file+ hs-source-dirs:+ test+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+ build-tool-depends:+ hspec-discover:hspec-discover+ build-depends:+ base >=4.7 && <5+ , bytestring >=0.12 && <1+ , directory >=1.3 && <2+ , effectful >=2.6 && <3+ , effectful-config-file+ , filepath >=1.5 && <2+ , hs-opentelemetry-api+ , hs-opentelemetry-exporter-in-memory+ , hs-opentelemetry-instrumentation-monad-logger+ , hs-opentelemetry-sdk+ , hspec+ , lens >=5.3 && <6+ , megaparsec >=9.7 && <10+ , monad-logger >=0.3 && <1+ , parser-combinators >=1.3 && <2+ , temporary+ , text >=2.1 && <3+ , toml-parser ==2.*+ default-language: Haskell2010
+ src/Data/Config.hs view
@@ -0,0 +1,186 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}++module Data.Config (+ ConfigParse (..),+ ConfigFetch (..),+ ConfigValue (..),+ withSection,+) where++import Control.Applicative.Combinators (choice)+import Control.Monad (void)+import Data.ByteString.Char8 (ByteString)+import qualified Data.ByteString.Char8 as B (pack)+import Data.List (isPrefixOf)+import Data.Text (Text)+import qualified Data.Text as T (pack, unpack)+import Data.Typeable (Typeable, typeOf)+import Data.Void (Void)+import Effectful (Eff, IOE, liftIO, type (:>))+import Effectful.Config.Log (Log, logDebug)+import Effectful.Config.Secrets (Secrets, getSecret)+import OpenTelemetry.Trace.Core (+ Span,+ addAttribute,+ defaultSpanArguments,+ getGlobalTracerProvider,+ inSpan',+ instrumentationLibrary,+ makeTracer,+ tracerOptions,+ )+import System.Directory (getHomeDirectory)+import System.Environment (getEnv)+import System.FilePath ((</>))+import Text.Megaparsec (+ Parsec,+ chunk,+ errorBundlePretty,+ runParser,+ takeRest,+ try,+ )+import Text.Printf (printf)+import Toml.Schema (+ FromValue (..),+ Matcher,+ ParseTable,+ parseTable,+ reqKeyOf,+ warnAt,+ )+import Toml.Semantics.Types (Value' (..))++class ConfigParse a where+ parse :: Text -> a++instance ConfigParse Int where+ parse = read . T.unpack++instance ConfigParse ByteString where+ parse = B.pack . T.unpack++instance ConfigParse String where+ parse = T.unpack++-- | Class to fetch values from different sources.+class ConfigFetch a where+ fetch+ :: IOE :> es+ => Log :> es+ => Secrets :> es+ => a+ -> Eff es a++-- | Base configuration value.+--+-- @since 0.1.0.0+data ConfigValue a+ = -- | Literal string-readable value.+ Literal a+ | -- | Value from an environment variable (man 7 environ).+ Env String+ | -- | Value from a file.+ File FilePath+ | -- | Value from a secretspec-managed secret.+ Secret Text+ deriving (Eq, Show)++instance Functor ConfigValue where+ fmap f (Literal a) = Literal (f a)+ fmap _ (Env e) = Env e+ fmap _ (File f) = File f+ fmap _ (Secret s) = Secret s++configValueParser :: Parsec Void String (ConfigValue a)+configValueParser = choice [env, file, secret]+ where+ makePrefix = (<> "://")+ prefix = void . try . chunk . makePrefix+ withPrefix p = prefix p >> takeRest+ env = Env <$> withPrefix "env"+ file = File <$> withPrefix "file"+ secret = Secret . T.pack <$> withPrefix "secretspec"++parseTextValue+ :: FromValue a+ => Value' l+ -> Matcher l (ConfigValue a)+parseTextValue v@(Text' _ t) =+ either+ (const (Literal <$> fromValue v))+ pure+ (runParser configValueParser "ConfigValue String" (T.unpack t))+parseTextValue _ = fail "must be text value"++instance {-# OVERLAPPING #-} FromValue (ConfigValue String) where+ fromValue = parseTextValue++instance (FromValue a, Typeable a) => FromValue (ConfigValue a) where+ fromValue v@(Text' l t) =+ either+ (\e -> warnAt l (errorBundlePretty e) >> fromValue v)+ pure+ (runParser configValueParser ("ConfigValue " <> show (typeOf @a undefined)) (T.unpack t))+ fromValue v = Literal <$> fromValue v++-- | Wraps a config value fetch in a @config.fetch@ span tagged with the+-- source kind and the (unexpanded) key. Never logs the fetched value.+withConfigSpan+ :: IOE :> es+ => Text+ -> Text+ -> (Span -> Eff es a)+ -> Eff es a+withConfigSpan source key act = do+ tp <- getGlobalTracerProvider+ let tracer = makeTracer tp (instrumentationLibrary "effectful-config-file" "0.1.0.0") tracerOptions+ inSpan' tracer "config.fetch" defaultSpanArguments $ \sp -> do+ addAttribute sp "config.source" source+ addAttribute sp "config.key" key+ act sp++instance ConfigParse a => ConfigFetch (ConfigValue a) where+ fetch (Env e) =+ withConfigSpan "env" (T.pack e) $ \_ -> do+ logDebug $ "fetching config value from env " <> T.pack e+ v <- liftIO (getEnv e)+ pure $ Literal (parse (T.pack v))+ fetch (File fp) =+ withConfigSpan "file" (T.pack fp) $ \_ -> do+ fp' <-+ if "~/" `isPrefixOf` fp+ then do+ home <- liftIO getHomeDirectory+ pure $ home </> drop 2 fp+ else pure fp++ logDebug $ "fetching config value from file " <> T.pack fp+ v <- liftIO (readFile fp')+ pure $ Literal (parse (T.pack v))+ fetch (Secret k) =+ withConfigSpan "secretspec" k $ \_ -> do+ logDebug $ "fetching config value from secretspec " <> k+ Literal . parse <$> getSecret k+ fetch v@(Literal _) = pure v++-- | @since 0.1.0.0+withSection+ :: Text+ -> ParseTable l a+ -> Value' l+ -> Matcher l a+withSection key parser (Table' lo to) =+ parseTable (reqKeyOf key parseInner) lo to+ where+ parseInner (Table' li ti) = parseTable parser li ti+ parseInner _ = fail $ printf "section [%s] must be a table" (T.unpack key)+withSection key _ _ =+ fail $ printf "section [%s] expected a top-level table" (T.unpack key)
+ src/Data/Error/Config.hs view
@@ -0,0 +1,18 @@+module Data.Error.Config (+ ConfigError (..),+) where++import Data.List (intercalate)+import Toml (DecodeError, prettyDecodeError)++-- | @since 0.1.0.0+newtype ConfigError = ConfigError+ { _ce_errors :: [DecodeError]+ }++instance Eq ConfigError where+ (ConfigError a) == (ConfigError b) =+ concatMap prettyDecodeError a == concatMap prettyDecodeError b++instance Show ConfigError where+ show (ConfigError es) = "config error: " <> intercalate "; " (map prettyDecodeError es)
+ src/Effectful/Config.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}++module Effectful.Config (+ Config,+ getConfig,+ getConfigValue,+ readConfig,+ readConfig',+) where++import Control.Concurrent.MVar (MVar, modifyMVar, readMVar)+import Control.Lens (ALens', cloneLens, (&), (.~), (^.))+import Data.Config (ConfigFetch (fetch), ConfigParse, ConfigValue (..))+import Data.Error.Config (ConfigError (..))+import Data.Text (Text)+import qualified Data.Text as T (pack)+import qualified Data.Text.IO as T (readFile)+import Effectful (Eff, IOE, liftIO, withSeqEffToIO, type (:>))+import Effectful.Config.Log (Log, logWarn)+import Effectful.Config.Secrets (Secrets)+import Effectful.Error.Static (Error, throwError)+import Effectful.Reader.Static (Reader, ask)+import OpenTelemetry.Trace.Core (+ addAttribute,+ defaultSpanArguments,+ getGlobalTracerProvider,+ inSpan',+ instrumentationLibrary,+ makeTracer,+ tracerOptions,+ )+import Text.Printf (printf)+import Toml (Result (..), decode', prettyDecodeError)+import Toml.Schema.FromValue (FromValue)++-- | @since 0.1.0.0+type Config c = Reader (MVar c)++-- | @since 0.1.0.0+getConfig+ :: IOE :> es+ => Config c :> es+ => Eff es c+getConfig = ask >>= liftIO . readMVar++-- | @since 0.1.0.0+getConfigValue+ :: IOE :> es+ => Config c :> es+ => Log :> es+ => Secrets :> es+ => ConfigParse a+ => Show a+ => ALens' c (ConfigValue a)+ -> Eff es a+getConfigValue lens = do+ mvar <- ask+ withSeqEffToIO $ \runInIO ->+ modifyMVar mvar $ \cfg -> do+ v <- runInIO (fetch (cfg ^. cloneLens lens))+ case v of+ Literal b -> pure (cfg & cloneLens lens .~ v, b)+ _ ->+ error $+ unlines+ [ printf "tried to get raw config value from (%s)" (show v)+ , "this should be impossible and is most likely a bug in your ConfigFetch instance"+ ]++-- | @since 0.1.0.0+readConfig+ :: FromValue c+ => Text+ -> Either ConfigError c+readConfig =+ resultToEither . decode'+ where+ resultToEither (Failure es) = Left (ConfigError es)+ resultToEither (Success _ c) = Right c++-- | @since 0.1.0.0+readConfig'+ :: forall c es+ . IOE :> es+ => Error ConfigError :> es+ => Log :> es+ => FromValue c+ => FilePath+ -> Eff es c+readConfig' path = do+ tp <- getGlobalTracerProvider+ let tracer = makeTracer tp (instrumentationLibrary "effectful-config-file" "0.1.0.0") tracerOptions+ inSpan' tracer "config.read" defaultSpanArguments $ \sp -> do+ addAttribute sp "config.path" (T.pack path)+ processResult . decode' =<< liftIO (T.readFile path)+ where+ processResult (Failure es) = throwError (ConfigError es)+ processResult (Success [] c) = pure c+ processResult (Success es c) = do+ logWarn "configuration parsed with warnings:"+ mapM_ (logWarn . (" " <>) . T.pack . prettyDecodeError) es+ pure c
+ src/Effectful/Config/Log.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++module Effectful.Config.Log (+ Log,+ runLog,+ logDebug,+ logWarn,+) where++import Control.Monad.Logger (+ Loc (..),+ LogLevel (..),+ LogSource,+ LogStr,+ ToLogStr (toLogStr),+ )+import Data.Text (Text)+import Effectful (Dispatch (Static), DispatchOf, Eff, Effect, IOE, type (:>))+import Effectful.Dispatch.Static (+ SideEffects (WithSideEffects),+ StaticRep,+ evalStaticRep,+ getStaticRep,+ unsafeEff_,+ )+import GHC.Stack (CallStack, HasCallStack, SrcLoc (..), callStack, getCallStack)++-- | @since 0.1.0.0+data Log :: Effect++type instance DispatchOf Log = Static WithSideEffects++newtype instance StaticRep Log = Log (Loc -> LogSource -> LogLevel -> LogStr -> IO ())++-- | @since 0.1.0.0+runLog+ :: IOE :> es+ => (Loc -> LogSource -> LogLevel -> LogStr -> IO ())+ -> Eff (Log : es) a+ -> Eff es a+runLog = evalStaticRep . Log++logAt+ :: HasCallStack+ => Log :> es+ => LogLevel+ -> Text+ -> Eff es ()+logAt lvl msg = do+ Log cb <- getStaticRep+ unsafeEff_ $ cb (callSiteLoc callStack) "" lvl (toLogStr msg)++-- | @since 0.1.0.0+logDebug+ , logWarn+ :: HasCallStack+ => Log :> es+ => Text+ -> Eff es ()+logDebug = logAt LevelDebug++-- | @since 0.1.0.0+logWarn = logAt LevelWarn++callSiteLoc :: CallStack -> Loc+callSiteLoc cs = case getCallStack cs of+ (_, loc) : _ ->+ Loc+ { loc_filename = srcLocFile loc+ , loc_package = srcLocPackage loc+ , loc_module = srcLocModule loc+ , loc_start = (srcLocStartLine loc, srcLocStartCol loc)+ , loc_end = (srcLocEndLine loc, srcLocEndCol loc)+ }+ [] -> Loc "<unknown>" "<unknown>" "<unknown>" (0, 0) (0, 0)
+ src/Effectful/Config/Secrets.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++module Effectful.Config.Secrets (+ Secrets (..),+ getSecret,+ SecretsError (..),+ runSecretsError,+) where++import Data.Text (Text)+import Effectful (Dispatch (Dynamic), DispatchOf, Eff, Effect, type (:>))+import Effectful.Dispatch.Dynamic (interpret, send)+import Effectful.Error.Static (Error, throwError)+import GHC.Stack (HasCallStack)++-- | @since 0.1.0.0+data Secrets :: Effect where+ GetSecret :: Text -> Secrets m Text++type instance DispatchOf Secrets = Dynamic++-- | @since 0.1.0.0+getSecret+ :: HasCallStack+ => Secrets :> es+ => Text -> Eff es Text+getSecret = send . GetSecret++-- | @since 0.1.0.0+data SecretsError+ = NoSecretsBackend Text+ | SecretNotFound Text+ deriving (Eq, Show)++-- | @since 0.1.0.0+runSecretsError+ :: Error SecretsError :> es+ => Eff (Secrets : es) a+ -> Eff es a+runSecretsError = interpret $ \_ (GetSecret key) -> throwError (NoSecretsBackend key)
+ test/Effectful/ConfigSpec.hs view
@@ -0,0 +1,239 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Effectful.ConfigSpec (+ spec,+) where++import Control.Concurrent.MVar (newMVar, readMVar)+import Control.Exception (IOException, try)+import Control.Lens (makeLenses, (^.))+import Data.Bifunctor (Bifunctor (..), first)+import Data.Config (ConfigValue (..), withSection)+import Data.Error.Config (ConfigError (..))+import qualified Data.Text as T (isInfixOf, pack, unlines, unpack)+import Effectful (runEff)+import Effectful.Config (getConfigValue, readConfig, readConfig')+import Effectful.Config.Log (runLog)+import Effectful.Config.Secrets (SecretsError, runSecretsError)+import Effectful.Error.Static (runErrorNoCallStack)+import Effectful.Reader.Static (runReader)+import OpenTelemetry.Exporter.InMemory.LogRecord (+ getExportedLogRecords,+ inMemoryLogRecordExporter,+ )+import OpenTelemetry.Instrumentation.MonadLogger (makeOTelLogCallback)+import OpenTelemetry.Internal.Common.Types (AnyValue (TextValue))+import OpenTelemetry.Internal.Log.Types (logRecordBody)+import OpenTelemetry.Log.Core (+ createLoggerProvider,+ emptyLoggerProviderOptions,+ forceFlushLoggerProvider,+ makeLogger,+ readLogRecord,+ )+import OpenTelemetry.Processor.Simple.LogRecord (+ SimpleLogRecordProcessorConfig (..),+ simpleLogRecordProcessor,+ )+import OpenTelemetry.Trace.Core (instrumentationLibrary)+import System.Directory (removeFile)+import System.Environment (setEnv)+import System.IO (hClose, hPutStr)+import System.IO.Temp (withSystemTempFile)+import System.Timeout (timeout)+import Test.Hspec (+ Spec,+ describe,+ expectationFailure,+ it,+ runIO,+ shouldBe,+ shouldSatisfy,+ )+import Toml (decode', prettyDecodeError)+import Toml.Schema (+ FromValue (..),+ Result (..),+ reqKey,+ )++data TestConfig = TestConfig+ { _test_a :: ConfigValue Int+ , _test_b :: ConfigValue String+ }+ deriving (Eq, Show)++instance FromValue TestConfig where+ fromValue =+ withSection "test" $+ TestConfig+ <$> reqKey "a"+ <*> reqKey "b"++makeLenses ''TestConfig++newtype FileConfig = FileConfig+ { _file_val :: ConfigValue String+ }+ deriving (Eq, Show)++makeLenses ''FileConfig++instance Functor (Result e) where+ fmap _ (Failure e) = Failure e+ fmap f (Success e a) = Success e (f a)++instance Bifunctor Result where+ bimap f _ (Failure e) = Failure (fmap f e)+ bimap f g (Success e a) = Success (fmap f e) (g a)++-- | No-op logger for tests that don't care about log output.+silentLog :: a -> b -> c -> d -> IO ()+silentLog _ _ _ _ = pure ()++spec :: Spec+spec = do+ describe "getConfigValue" $ do+ let cfg = TestConfig (Env "test") (Literal "test")+ result <- runIO $ do+ p <- do+ setEnv "test" "42"+ newMVar cfg++ runEff+ . runErrorNoCallStack @SecretsError+ . runSecretsError+ . runLog silentLog+ . runReader p+ $ (,) <$> getConfigValue test_a <*> getConfigValue test_b++ it "fetch" $ do+ result `shouldBe` Right (42, "test")++ describe "readConfig" $ do+ let result = TestConfig (Literal 42) (Literal "test")++ it "parses without errors" $ do+ let inp =+ T.unlines+ [ "[test]"+ , "a = 42"+ , "b = \"test\""+ ]++ readConfig inp `shouldBe` Right result++ it "invalid schema" $ do+ first (fmap prettyDecodeError . _ce_errors) (readConfig @TestConfig "")+ `shouldBe` Left ["1:1: missing key: test in <top-level>"]++ it "unused key" $ do+ let inp =+ T.unlines+ [ "[test]"+ , "a = 42"+ , "b = \"test\""+ , "c = 0"+ ]++ first prettyDecodeError (decode' inp)+ `shouldBe` Success ["4:1: unexpected key: c in test"] result++ describe "getConfigValue file://" $ do+ it "reads the file contents" $ withSystemTempFile "effectful-config" $ \path h -> do+ hPutStr h "hello"+ hClose h++ p <- newMVar (FileConfig (File path))+ result <-+ runEff+ . runErrorNoCallStack @SecretsError+ . runSecretsError+ . runLog silentLog+ . runReader p+ $ getConfigValue file_val++ result `shouldBe` Right "hello"++ it "memoizes the fetched value" $ withSystemTempFile "effectful-config" $ \path h -> do+ hPutStr h "hello"+ hClose h++ p <- newMVar (FileConfig (File path))+ _ <-+ runEff+ . runErrorNoCallStack @SecretsError+ . runSecretsError+ . runLog silentLog+ . runReader p+ $ getConfigValue file_val++ cfg <- readMVar p+ (cfg ^. file_val) `shouldBe` Literal "hello"++ removeFile path++ result2 <-+ runEff+ . runErrorNoCallStack @SecretsError+ . runSecretsError+ . runLog silentLog+ . runReader p+ $ getConfigValue file_val++ result2 `shouldBe` Right "hello"++ it "restores the MVar when fetch throws" $ do+ p <- newMVar (FileConfig (File "/nonexistent"))+ result <-+ try @IOException+ $ runEff+ . runErrorNoCallStack @SecretsError+ . runSecretsError+ . runLog silentLog+ . runReader p+ $ getConfigValue file_val++ case result of+ Left _ -> pure ()+ Right _ -> expectationFailure "expected an IOException"++ cfg <- timeout 1000000 (readMVar p)+ cfg `shouldBe` Just (FileConfig (File "/nonexistent"))++ describe "readConfig' OTel logging" $ do+ it "emits parse warnings as OTel log records" $ withSystemTempFile "effectful-config" $ \path h -> do+ hPutStr h . T.unpack $+ T.unlines+ [ "[test]"+ , "a = 42"+ , "b = \"test\""+ , "c = 0"+ ]+ hClose h++ (exporter, ref) <- inMemoryLogRecordExporter+ proc' <- simpleLogRecordProcessor (SimpleLogRecordProcessorConfig exporter 5000000)+ lp <- createLoggerProvider [proc'] emptyLoggerProviderOptions+ let logger = makeLogger lp (instrumentationLibrary "effectful-config-file-test" "0.0.0")++ result <-+ runEff+ . runErrorNoCallStack @ConfigError+ . runLog (makeOTelLogCallback logger)+ $ readConfig' @TestConfig path++ case result of+ Left e -> expectationFailure (show e)+ Right _ -> pure ()++ _ <- forceFlushLoggerProvider lp Nothing+ records <- getExportedLogRecords ref+ bodies <- mapM readLogRecord records++ let texts = [t | ilr <- bodies, TextValue t <- [logRecordBody ilr]]+ texts `shouldSatisfy` any (T.isInfixOf (T.pack "unexpected key: c"))
+ test/Spec.hs view
@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+{-# OPTIONS_GHC -Wno-missing-export-lists #-}