atelier-core 0.6.0.0 → 0.6.1.0

raw patch · 4 files changed

+107/−9 lines, 4 filesdep +GlobPVP ok

version bump matches the API change (PVP)

Dependencies added: Glob

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• atelier-core.cabal +5/−2
• src/Atelier/Effects/FileSystem/Glob.hs +82/−0
• src/Atelier/Effects/Log.hs +13/−7

@@ -7,6 +7,13 @@  ## [Unreleased] +## [0.6.1.0] - 2026-09-15++### Added++- `Atelier.Effects.FileSystem.Glob`: lifted functions from the `Glob` library.+- Support for GHC 9.14.+ ## [0.6.0.0] - 2026-09-10  ### Changed

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           atelier-core-version:        0.6.0.0+version:        0.6.1.0 synopsis:       Foundational Effectful-based effects and utilities description:    Core effects and utilities for effect-based applications, built on Effectful — part of the atelier toolkit. category:       Control@@ -21,6 +21,7 @@   , GHC == 9.6.7   , GHC == 9.8.4   , GHC == 9.12.4+  , GHC == 9.14.1 extra-doc-files:     CHANGELOG.md     README.md@@ -47,6 +48,7 @@       Atelier.Effects.Exit       Atelier.Effects.File       Atelier.Effects.FileSystem+      Atelier.Effects.FileSystem.Glob       Atelier.Effects.FileWatcher       Atelier.Effects.Input       Atelier.Effects.Internal.Coroutine@@ -97,7 +99,8 @@       TypeFamilies   ghc-options: -Weverything -Wno-unsafe -Wno-missing-safe-haskell-mode -Wno-monomorphism-restriction -Wno-missing-kind-signatures -Wno-missing-local-signatures -Wno-missing-import-lists -Wno-implicit-prelude -Wno-unticked-promoted-constructors -Wno-unused-packages -Wno-all-missed-specialisations -Wno-missed-specialisations -fplugin=Effectful.Plugin -threaded   build-depends:-      aeson >=2.2 && <2.4+      Glob ==0.10.*+    , aeson >=2.2 && <2.4     , atelier-prelude ==0.3.*     , base >=4.18 && <4.23     , base64-bytestring ==1.2.*

@@ -0,0 +1,82 @@+module Atelier.Effects.FileSystem.Glob+    ( -- * Effect+      Glob (..)+    , globDir+    , globDir1+    , glob+    , globDirWith++      -- * Re-exports from 'System.FilePath.Glob'.+    , module GlobExports++      -- * Interpreters+    , runIO+    , runScripted+    , GlobScript (..)+    )+where++import Effectful (Effect, IOE)+import Effectful.Dispatch.Dynamic (interpret_, reinterpret)+import Effectful.State.Static.Shared (evalState, get, put)+import Effectful.TH (makeEffect)+import System.FilePath.Glob (GlobOptions, Pattern)++import System.FilePath.Glob qualified as Glob+import System.FilePath.Glob qualified as GlobExports hiding (glob, globDir, globDir1, globDirWith)+++data Glob :: Effect where+    -- | Lifted 'Glob.globDir'.+    GlobDir :: [Pattern] -> FilePath -> Glob m [[FilePath]]+    -- | Lifted 'Glob.globDir1'.+    GlobDir1 :: Pattern -> FilePath -> Glob m [FilePath]+    -- | Lifted 'Glob.glob'.+    Glob :: String -> Glob m [FilePath]+    -- | Lifted 'Glob.globDirWith'.+    GlobDirWith :: GlobOptions -> [Pattern] -> FilePath -> Glob m ([[FilePath]], Maybe [FilePath])+++makeEffect ''Glob+++runIO :: (IOE :> es) => Eff (Glob : es) a -> Eff es a+runIO = interpret_ \case+    GlobDir patterns filePath -> liftIO $ Glob.globDir patterns filePath+    GlobDir1 pattern filePath -> liftIO $ Glob.globDir1 pattern filePath+    Glob pattern -> liftIO $ Glob.glob pattern+    GlobDirWith opts patterns filePath -> liftIO $ Glob.globDirWith opts patterns filePath+++-- | Script element for the test interpreter.+data GlobScript+    = -- | Return this result for the next 'globDir' call.+      NextGlobDir [[FilePath]]+    | -- | Return this result for the next 'globDir1' call.+      NextGlobDir1 [FilePath]+    | -- | Return this result for the next 'glob' call.+      NextGlob [FilePath]+    | -- | Return this result for the next 'globDirWith' call.+      NextGlobDirWith ([[FilePath]], Maybe [FilePath])+++-- | Scripted interpreter for testing. Pops the next matching entry off the+-- queue for each call; does not require 'IOE'.+runScripted :: [GlobScript] -> Eff (Glob : es) a -> Eff es a+runScripted script = reinterpret (evalState script) \_ -> \case+    GlobDir _ _ ->+        get >>= \case+            NextGlobDir r : rest -> put rest >> pure r+            _ -> error "GlobScripted: expected NextGlobDir but queue was empty or mismatched"+    GlobDir1 _ _ ->+        get >>= \case+            NextGlobDir1 r : rest -> put rest >> pure r+            _ -> error "GlobScripted: expected NextGlobDir1 but queue was empty or mismatched"+    Glob _ ->+        get >>= \case+            NextGlob r : rest -> put rest >> pure r+            _ -> error "GlobScripted: expected NextGlob but queue was empty or mismatched"+    GlobDirWith _ _ _ ->+        get >>= \case+            NextGlobDirWith r : rest -> put rest >> pure r+            _ -> error "GlobScripted: expected NextGlobDirWith but queue was empty or mismatched"

@@ -41,6 +41,9 @@     , runLogNoOp     , runLogToHandle     , runLogWriter++      -- * Utils+    , minimumSeverityFromEnv     ) where @@ -181,13 +184,7 @@ runLog :: (Env :> es, IOE :> es, Reader Config :> es) => Eff (Log : es) a -> Eff es a runLog action = do     config <- ask-    env <- getEnvironment-    let overrideLog = (>>= readMaybe) $ lookup "LOG" env-        overrideLogging = (>>= readMaybe) $ lookup "LOGGING" env-        overrideDebug = (>>= \x -> if x == "0" then Nothing else Just DEBUG) $ lookup "DEBUG" env-    let severity =-            fromMaybe config.minimumSeverity-                $ overrideDebug <|> overrideLogging <|> overrideLog+    severity <- fromMaybe config.minimumSeverity <$> minimumSeverityFromEnv      reinterpretWith (runReader (Namespace "")) action \lenv -> \case         LogMsg msg ->@@ -240,6 +237,15 @@   where     showNamespace (Namespace "") = ""     showNamespace (Namespace ns) = square ns <> " "+++minimumSeverityFromEnv :: (Env :> es) => Eff es (Maybe Severity)+minimumSeverityFromEnv = do+    env <- getEnvironment+    let overrideLog = (>>= readMaybe) $ lookup "LOG" env+        overrideLogging = (>>= readMaybe) $ lookup "LOGGING" env+        overrideDebug = (>>= \x -> if x == "0" then Nothing else Just DEBUG) $ lookup "DEBUG" env+    pure $ overrideDebug <|> overrideLogging <|> overrideLog   square :: Text -> Text