data-effects 0.2.0.0 → 0.3.0.0

raw patch · 20 files changed

+467/−92 lines, 20 filesdep +infinite-listPVP ok

version bump matches the API change (PVP)

Dependencies added: infinite-list

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• data-effects.cabal +7/−4
• src/Data/Effect/Concurrent/Parallel.hs +141/−0
• src/Data/Effect/Concurrent/Thread.hs +0/−19
• src/Data/Effect/Concurrent/Timer.hs +57/−5
• src/Data/Effect/Cont.hs +0/−3
• src/Data/Effect/Coroutine.hs +34/−7
• src/Data/Effect/Except.hs +35/−7
• src/Data/Effect/Input.hs +5/−2
• src/Data/Effect/Log.hs +9/−0
• src/Data/Effect/NonDet.hs +13/−2
• src/Data/Effect/Output.hs +4/−2
• src/Data/Effect/Provider.hs +40/−12
• src/Data/Effect/Reader.hs +15/−3
• src/Data/Effect/Select.hs +12/−0
• src/Data/Effect/ShiftReset.hs +42/−15
• src/Data/Effect/State.hs +7/−2
• src/Data/Effect/Unlift.hs +7/−0
• src/Data/Effect/Writer.hs +29/−4
• src/Prelude.hs +5/−5

@@ -9,3 +9,8 @@     * Support for GHC 9.8.2. * Changed Shift/Reset and Provider effects to unlift form, making all effects HFunctor. * Renamed the 'Coroutine' constructor (incorrect) of the 'Status' type in coroutines to 'Continue'.++## 0.3.0.0 -- 2024-11-03+* Added parallelism effects.+* Added an effect for the `co-log` logging.+* Generalize the 'Provider' effect.

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               data-effects-version:            0.2.0.0+version:            0.3.0.0  -- A short (one-line) description of the package. synopsis: A basic framework for effect systems based on effects represented by GADTs.@@ -39,7 +39,7 @@ source-repository head     type: git     location: https://github.com/sayo-hs/data-effects-    tag: v0.2.0+    tag: v0.3.0     subdir: data-effects  library@@ -49,6 +49,7 @@         Data.Effect.State         Data.Effect.Except         Data.Effect.Accum+        Data.Effect.Select         Data.Effect.NonDet         Data.Effect.Coroutine         Data.Effect.Input@@ -59,12 +60,13 @@         Data.Effect.Chronicle         Data.Effect.Resource         Data.Effect.Fresh-        Data.Effect.Concurrent.Thread+        Data.Effect.Concurrent.Parallel         Data.Effect.Concurrent.Timer         Data.Effect.Unlift         Data.Effect.Provider         Data.Effect.ShiftReset         Data.Effect.KVStore+        Data.Effect.Log      reexported-modules:         Data.Effect,@@ -90,10 +92,11 @@         data-effects-core           ^>= 0.2,         data-effects-th             ^>= 0.2,         these                       ^>= 1.2,-        data-default                ^>= 0.7.1,+        data-default                >= 0.7.1 && < 0.9,         text                        >= 2.0 && < 2.2,         lens                        >= 5.2.3 && < 5.4,         time                        >= 1.11.1 && < 1.15,+        infinite-list               ^>= 0.1.1,      hs-source-dirs:   src     ghc-options:      -Wall

@@ -0,0 +1,141 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++-- SPDX-License-Identifier: MPL-2.0++{- |+Copyright   :  (c) 2024 Sayo Koyoneda+License     :  MPL-2.0 (see the file LICENSE)+Maintainer  :  ymdfield@outlook.jp++Effects for parallel computations.+-}+module Data.Effect.Concurrent.Parallel where++import Control.Applicative (Alternative (empty, (<|>)))+import Data.Tuple (swap)++-- | An `Applicative`-based effect for executing computations in parallel.+data Parallel f a where+    -- | Executes two actions in parallel and blocks until both are complete.+    -- Finally, aggregates the execution results based on the specified function.+    LiftP2+        :: (a -> b -> c)+        -- ^ A function that aggregates the two execution results.+        -> f a+        -- ^ The first action to be executed in parallel.+        -> f b+        -- ^ The second action to be executed in parallel.+        -> Parallel f c++-- | An effect that blocks a computation indefinitely.+data Halt (a :: Type) where+    -- | Blocks a computation indefinitely.+    Halt :: Halt a++{- |+An effect that adopts the result of the computation that finishes first among+two computations and cancels the other.+-}+data Race f (a :: Type) where+    -- | Adopts the result of the computation that finishes first among two+    --   computations and cancels the other.+    Race :: f a -> f a -> Race f a++makeEffect [''Halt] [''Parallel, ''Race]++{- |+A wrapper that allows using the `Parallel` effect in the form of `Applicative` /+ `Alternative` instances.+-}+newtype Concurrently f a = Concurrently {runConcurrently :: f a}+    deriving (Functor)++instance (Parallel <<: f, Applicative f) => Applicative (Concurrently f) where+    pure = Concurrently . pure+    {-# INLINE pure #-}++    liftA2 f (Concurrently a) (Concurrently b) = Concurrently $ liftP2 f a b+    {-# INLINE liftA2 #-}++instance (Race <<: f, Halt <: f, Parallel <<: f, Applicative f) => Alternative (Concurrently f) where+    empty = Concurrently halt+    {-# INLINE empty #-}++    (Concurrently a) <|> (Concurrently b) = Concurrently $ race a b+    {-# INLINE (<|>) #-}++{- |+Executes three actions in parallel and blocks until all are complete.+Finally, aggregates the execution results based on the specified function.+-}+liftP3+    :: (Parallel <<: f, Applicative f)+    => (a -> b -> c -> d)+    -- ^ A function that aggregates the three execution results.+    -> f a+    -- ^ The first action to be executed in parallel.+    -> f b+    -- ^ The second action to be executed in parallel.+    -> f c+    -- ^ The third action to be executed in parallel.+    -> f d+liftP3 f a b = liftP2 ($) (liftP2 f a b)+{-# INLINE liftP3 #-}++-- | An effect that realizes polling and cancellation of actions running in parallel.+data Poll f a where+    -- | Performs polling on an action running in parallel in the form of a fold.+    --+    -- First, the parallel execution of two actions begins.+    --+    -- When the execution of the first action completes, polling on the second+    -- action is performed at that point, and the result is passed to the+    -- folding function. If the function returns `Left`, the folding terminates+    -- and it becomes the final result. If the second action is not yet+    -- complete, it is canceled. If the function returns `Right`, the folding+    -- continues, and the same process repeats.+    Poldl+        :: (a -> Maybe b -> f (Either r a))+        -- ^ A function for folding.+        -> f a+        -- ^ The first action to be executed in parallel.+        -> f b+        -- ^ The second action to be executed in parallel; the target of polling.+        -> Poll f r++makeEffectH [''Poll]++-- | Executes two actions in parallel. If the first action completes before the second, the second action is canceled.+cancels+    :: (Poll <<: f, Applicative f)+    => f a+    -- ^ The action that controls the cancellation.+    -> f b+    -- ^ The action to be canceled.+    -> f (a, Maybe b)+cancels = poldl $ curry $ pure . Left+{-# INLINE cancels #-}++-- | Executes two actions in parallel. If the second action completes before the first, the first action is canceled.+cancelBy+    :: (Poll <<: f, Applicative f)+    => f a+    -- ^ The action to be canceled.+    -> f b+    -- ^ The action that controls the cancellation.+    -> f (Maybe a, b)+cancelBy = flip $ poldl $ curry $ pure . Left . swap+{-# INLINE cancelBy #-}++-- | An effect for parallel computations based on a `Traversable` container @t@.+data For (t :: Type -> Type) f a where+    -- | Executes in parallel the actions stored within a `Traversable` container @t@.+    For :: t (f a) -> For t f (t a)++makeEffectH_ [''For]+makeHFunctor' ''For \(t :< _) -> [t|Functor $t|]++-- | Converts the `Traversable` container-based parallel computation effect t`For` into the `Applicative`-based parallel computation effect `Parallel`.+forToParallel :: (Parallel <<: f, Traversable t, Applicative f) => For t f ~> f+forToParallel (For iters) = runConcurrently $ traverse Concurrently iters+{-# INLINE forToParallel #-}

@@ -1,19 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}---- This Source Code Form is subject to the terms of the Mozilla Public--- License, v. 2.0. If a copy of the MPL was not distributed with this--- file, You can obtain one at https://mozilla.org/MPL/2.0/.--{- |-Copyright   :  (c) 2023 Sayo Koyoneda-License     :  MPL-2.0 (see the file LICENSE)-Maintainer  :  ymdfield@outlook.jp-Stability   :  experimental-Portability :  portable--}-module Data.Effect.Concurrent.Thread where--data Thread' tid f (a :: Type) where-    ForkThread :: f () -> Thread' tid f tid--makeKeyedEffect [] [''Thread']

@@ -8,8 +8,8 @@ Copyright   :  (c) 2024 Sayo Koyoneda License     :  MPL-2.0 (see the file LICENSE) Maintainer  :  ymdfield@outlook.jp-Stability   :  experimental-Portability :  portable++Effects for controlling time-related operations. -} module Data.Effect.Concurrent.Timer where @@ -19,21 +19,40 @@ import Data.Functor ((<&>)) import Data.Time (DiffTime) +-- | An effect for time-related operations. data Timer a where+    -- | Retrieves the current relative time from an arbitrary fixed reference point.+    --   The reference point does not change within the context of that scope.     Clock :: Timer DiffTime+    -- | Temporarily suspends computation for the specified duration.     Sleep :: DiffTime -> Timer ()+ makeEffectF [''Timer] -withElapsedTime :: (Timer <: m, Monad m) => (m DiffTime -> m a) -> m a+{- |+Creates a scope where elapsed time can be obtained.+An action to retrieve the elapsed time, re-zeroed at the start of the scope, is passed to the scope.+-}+withElapsedTime+    :: (Timer <: m, Monad m)+    => (m DiffTime -> m a)+    -- ^ A scope where the elapsed time can be obtained.+    -- An action to retrieve the elapsed time is passed as an argument.+    -> m a withElapsedTime f = do     start <- clock     f $ clock <&> (`subtract` start) +-- | Returns the time taken for a computation along with the result as a pair. measureTime :: (Timer <: m, Monad m) => m a -> m (DiffTime, a) measureTime m = withElapsedTime \elapsedTime -> do     r <- m     elapsedTime <&> (,r) +{- |+Temporarily suspends computation until the relative time from the fixed reference point in the current scope's context, as given by the argument.+If the specified resume time has already passed, returns the elapsed time (positive value) in `Just`.+-} sleepUntil :: (Timer <: m, Monad m) => DiffTime -> m (Maybe DiffTime) sleepUntil t = do     now <- clock@@ -41,7 +60,18 @@         sleep $ t - now     pure if t < now then Just (now - t) else Nothing -runCyclic :: (Timer <: m, Monad m) => m DiffTime -> m () -> m a+{- |+Repeats a computation indefinitely. Controls so that each loop occurs at a specific time interval.+If the computation time exceeds and the requested interval cannot be realized, the excess delay occurs, which accumulates and is not canceled.+-}+runCyclic+    :: (Timer <: m, Monad m)+    => m DiffTime+    -- ^ An action called at the start of each loop to determine the time interval until the next loop.+    --   For example, @pure 1@ would control the loop to have a 1-second interval.+    -> m ()+    -- ^ The computation to repeat.+    -> m a runCyclic deltaTime a = do     t0 <- clock     flip fix t0 \next t -> do@@ -50,18 +80,40 @@         delay <- sleepUntil t'         next $ maybe t' (t' +) delay -runPeriodic :: (Timer <: m, Monad m) => DiffTime -> m () -> m a+{- |+Controls to repeat a specified computation at fixed time intervals. A specialized version of `runCyclic`.+If the computation time exceeds and the requested interval cannot be realized, the excess delay occurs, which accumulates and is not canceled.+-}+runPeriodic+    :: (Timer <: m, Monad m)+    => DiffTime+    -- ^ Loop interval+    -> m ()+    -- ^ The computation to repeat.+    -> m a runPeriodic interval = runCyclic (pure interval) {-# INLINE runPeriodic #-} +{- |+Calls `yield` of a coroutine at fixed intervals.+If the computation time exceeds and the requested interval cannot be realized, the excess delay occurs, which accumulates and is not canceled.+-} periodicTimer :: forall m a. (Timer <: m, Yield () () <: m, Monad m) => DiffTime -> m a periodicTimer interval = runPeriodic interval $ yield () {-# INLINE periodicTimer #-} +{- |+Calls `yield` of a coroutine at specific intervals.+Controls so that the time returned by `yield` becomes the time interval until the next loop.+If the computation time exceeds and the requested interval cannot be realized, the excess delay occurs, which accumulates and is not canceled.+-} cyclicTimer :: forall m a. (Timer <: m, Yield () DiffTime <: m, Monad m) => m a cyclicTimer = runCyclic (yield ()) (pure ()) {-# INLINE cyclicTimer #-} +-- | An effect that realizes control of wait times such that the specified time becomes the interval until the next @wait@ when @wait@ is executed repeatedly. data CyclicTimer a where+    -- | Controls the wait time so that when @wait@ is executed repeatedly, the specified time becomes the interval until the next @wait@.     Wait :: DiffTime -> CyclicTimer ()+ makeEffectF [''CyclicTimer]

@@ -6,9 +6,6 @@  module Data.Effect.Cont where -import Data.Effect.TH (noExtTemplate)-import Data.Effect.TH.Internal (noDeriveHFunctor)- data CallCC m a where     CallCC :: (forall r. (a -> m r) -> m a) -> CallCC m a 

@@ -9,10 +9,8 @@               (c) 2023-2024 Sayo Koyoneda License     :  MPL-2.0 (see the file LICENSE) Maintainer  :  ymdfield@outlook.jp-Stability   :  experimental-Portability :  portable -This module provides the t`Coroutine` effect, comes+This module provides effects for the coroutine, comes from [@Control.Monad.Freer.Coroutine@](https://hackage.haskell.org/package/freer-simple-1.2.1.2/docs/Control-Monad-Freer-Coroutine.html) in the @freer-simple@ package (The continuation part @(b -> c)@ has been removed. If necessary, please manually compose the t`Data.Functor.Coyoneda.Coyoneda`) . -}@@ -20,26 +18,55 @@  import Control.Monad ((>=>)) +{- |+An effect for coroutines.+Realizes an operation that transfers control to the caller of the computation with coroutines along with a value of type @a@,+and receives a value of type @b@ from the caller.+-} data Yield a b (c :: Type) where+    -- | Transfers control to the caller of the computation with coroutines along with a value of type @a@, and receives a value of type @b@ from the caller.     Yield :: a -> Yield a b b  makeEffectF [''Yield] +-- | A version of `yield` where the value returned from the caller of the computation with coroutines is unit. yield_ :: (Yield a () <: f) => a -> f () yield_ = yield {-# INLINE yield_ #-} +{- |+The execution result when handling a computation that includes the t`Yield` effect. A computation that may include suspension.+If the computation does not include `yield`, the completed result of the computation is obtained as `Done`.+If the computation includes `yield`, execution is suspended at that point, and the value of type @a@ thrown by `yield` and the continuation of the computation from the point of `yield` are obtained as `Continue`.+By re-executing this continuation, you can resume the computation.+-} data Status f a b r-    = Done r-    | Continue a (b -> f (Status f a b r))+    = -- | The computation has completely finished+      Done r+    | -- | The computation has been suspended by `yield`+      Continue a (b -> f (Status f a b r))     deriving (Functor) -continueStatus :: (Monad m) => (x -> m (Status m a b r)) -> Status m a b x -> m (Status m a b r)+-- | Extends the computation result by appending the specified continuation.+continueStatus+    :: (Monad m)+    => (x -> m (Status m a b r))+    -- ^ Additional continuation+    -> Status m a b x+    -- ^ Computation status to extend+    -> m (Status m a b r) continueStatus kk = \case     Done x -> kk x     Continue a k -> pure . Continue a $ k >=> continueStatus kk -loopStatus :: (Monad m) => (a -> m b) -> Status m a b r -> m r+-- | Repeats the computation until the final result is obtained by continuing the computation using the specified handler each time it suspends.+loopStatus+    :: (Monad m)+    => (a -> m b)+    -- ^ Handler to resume computation from a suspended state.+    -> Status m a b r+    -- ^ A computation that may include suspension.+    -> m r loopStatus f = \case     Done r -> pure r     Continue a k -> f a >>= k >>= loopStatus f

@@ -8,39 +8,67 @@ Copyright   :  (c) 2023 Sayo Koyoneda License     :  MPL-2.0 (see the file LICENSE) Maintainer  :  ymdfield@outlook.jp-Stability   :  experimental-Portability :  portable++An effect to escape from the normal control structure with an exception value in the middle of a context. -} module Data.Effect.Except where +-- | An effect to escape from the normal control structure with an exception value of type @e@ in the middle of a context. data Throw e (a :: Type) where+    -- | Throws an exception; that is, escapes from the normal control structure with an exception value in the middle of a context.     Throw :: e -> Throw e a +-- | An effect to catch exceptions. data Catch e f (a :: Type) where-    Catch :: f a -> (e -> f a) -> Catch e f a+    -- | Catches exceptions within a scope and processes them according to the given exception handler.+    Catch+        :: f a+        -- ^ The scope in which to catch exceptions.+        -> (e -> f a)+        -- ^ Exception handler. Defines the processing to perform when an exception is thrown within the scope.+        -> Catch e f a  makeEffect [''Throw] [''Catch] +-- | Throws the given `Either` value as an exception if it is `Left`. liftEither :: (Throw e <: f, Applicative f) => Either e a -> f a liftEither = either throw pure {-# INLINE liftEither #-} +-- | Throws the result of the given action as an exception if it is `Left`. joinEither :: (Throw e <: m, Monad m) => m (Either e a) -> m a joinEither = (>>= either throw pure) {-# INLINE joinEither #-} -joinExcept :: Monad m => Either (m a) a -> m a+-- | If the given `Either` value is `Left`, execute it as an action.+joinExcept :: (Monad m) => Either (m a) a -> m a joinExcept = either id pure {-# INLINE joinExcept #-} -exc :: Monad m => m (Either (m a) a) -> m a+-- | If the result of the given action is `Left`, execute it as an action.+exc :: (Monad m) => m (Either (m a) a) -> m a exc = (>>= either id pure) {-# INLINE exc #-} -withExcept :: (Catch e <<: f, Throw e <: f, Applicative f) => f a -> (e -> f ()) -> f a+-- | If an exception occurs, executes the given exception handler, but the exception is not stopped there and is rethrown.+withExcept+    :: (Catch e <<: f, Throw e <: f, Applicative f)+    => f a+    -- ^ Scope to which the exception handler applies+    -> (e -> f ())+    -- ^ Exception handler+    -> f a withExcept thing after = thing `catch` \e -> after e *> throw e {-# INLINE withExcept #-} -onExcept :: forall e f a. (Catch e <<: f, Throw e <: f, Applicative f) => f a -> f () -> f a+-- | If an exception occurs, executes the specified action, but the exception is not stopped there and is rethrown.+onExcept+    :: forall e f a+     . (Catch e <<: f, Throw e <: f, Applicative f)+    => f a+    -- ^ Scope in which to detect exceptions+    -> f ()+    -- ^ Action to execute in case of an exception+    -> f a onExcept thing after = thing `withExcept` \(_ :: e) -> after {-# INLINE onExcept #-}

@@ -8,19 +8,22 @@ Copyright   :  (c) 2023 Sayo Koyoneda License     :  MPL-2.0 (see the file LICENSE) Maintainer  :  ymdfield@outlook.jp-Stability   :  experimental-Portability :  portable  This module provides the t`Input` effect, comes from [@Polysemy.Input@](https://hackage.haskell.org/package/polysemy-1.9.1.1/docs/Polysemy-Input.html) in the @polysemy@ package.++Realizes input of values from the external world. -} module Data.Effect.Input where +-- | A general effect representing input of values from the external world. data Input i (a :: Type) where+    -- | Retrieve a value input from the external world.     Input :: Input i i  makeEffectF [''Input] +-- | Returns the value obtained by transforming the input value using the given function. inputs :: (Input i <: f, Functor f) => (i -> a) -> f a inputs f = f <$> input

@@ -0,0 +1,9 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++-- SPDX-License-Identifier: MPL-2.0++module Data.Effect.Log where++data Log msg a where+    Log :: msg -> Log msg ()+makeEffectF [''Log]

@@ -8,22 +8,33 @@ Copyright   : (c) 2024 Sayo Koyoneda License     :  MPL-2.0 (see the file LICENSE) Maintainer  :  ymdfield@outlook.jp-Stability   :  experimental-Portability :  portable++Effects that realize non-deterministic computations. -} module Data.Effect.NonDet where +-- | An effect that eliminates a branch by causing the current branch context of a non-deterministic computation to fail. data Empty (a :: Type) where+    -- | Eliminates a branch by causing the current branch context of a non-deterministic computation to fail.     Empty :: Empty a  makeEffectF [''Empty] +-- | An effect that splits the computation into two branches. data Choose (a :: Type) where+    -- | Splits the computation into two branches.+    -- As a result of executing @choose@, the world branches into one where `False` is returned and one where `True` is returned.     Choose :: Choose Bool  makeEffectF [''Choose] +{- |+An effect that executes two branches as scopes.+A higher-order version of the t`Choose` effect.+-} data ChooseH f (a :: Type) where+    -- | Executes the given two scopes as branches.+    -- Even if one fails due to the `empty` operation, the whole does not fail as long as the other does not fail.     ChooseH :: f a -> f a -> ChooseH f a  makeEffectH [''ChooseH]

@@ -8,16 +8,18 @@ Copyright   :  (c) 2023 Sayo Koyoneda License     :  MPL-2.0 (see the file LICENSE) Maintainer  :  ymdfield@outlook.jp-Stability   :  experimental-Portability :  portable  This module provides the t`Output` effect, comes from [@Polysemy.Output@](https://hackage.haskell.org/package/polysemy-1.9.1.1/docs/Polysemy-Output.html) in the @polysemy@ package.++Realizes output of values to the external world. -} module Data.Effect.Output where +-- | A general effect representing output of values to the external world. data Output o a where+    -- | Output a value to the external world.     Output :: o -> Output o ()  makeEffectF [''Output]

@@ -8,49 +8,77 @@ Copyright   :  (c) 2023-2024 Sayo Koyoneda License     :  MPL-2.0 (see the file LICENSE) Maintainer  :  ymdfield@outlook.jp-Stability   :  experimental-Portability :  portable  This module provides the `Provider` effect, like [@Effectful.Provider@](https://hackage.haskell.org/package/effectful-core-2.3.0.0/docs/Effectful-Provider.html) in the @effectful@ package. -} module Data.Effect.Provider where +import Data.Effect.HFunctor (HFunctor, hfmap) import Data.Effect.Key (type (##>))+import Data.Functor.Const (Const (Const)) import Data.Functor.Identity (Identity, runIdentity) +-- | An effect to introduce a new local scope that provides effect context @b@. data Provider' ctx i b (f :: Type -> Type) (a :: Type) where+    -- | Introduces a new local scope that provides an effect context @b p@ parameterized by type @i p@ and with results wrapped in @ctx p@.     Provide-        :: i-        -> ((forall x. f x -> b x) -> b a)-        -> Provider' ctx i b f (ctx a)+        :: i p+        -> ((forall x. f x -> b p x) -> b p a)+        -> Provider' ctx i b f (ctx p a)+ makeEffectH [''Provider'] +-- | A type-level key to uniquely resolve the effect context carrier @b@ from @ctx@ and @i@. data ProviderKey ctx i +-- | An effect to introduce a new local scope that provides effect context @b@. type Provider ctx i b = ProviderKey ctx i ##> Provider' ctx i b-type Provider_ i b = ProviderKey Identity i ##> Provider' Identity i b +{- |+An effect to introduce a new local scope that provides effect context @b@.+A version of `Provider` where the result is not wrapped in a specific container.+-}+type Provider_ i b = Provider (Const1 Identity) (Const i :: () -> Type) (Const1 b)++newtype Const1 f x a = Const1 {getConst1 :: f a}++newtype Const2 ff x f a = Const2 {getConst2 :: ff f a}+instance (HFunctor ff) => HFunctor (Const2 ff x) where+    hfmap phi (Const2 ff) = Const2 $ hfmap phi ff+    {-# INLINE hfmap #-}+ infix 2 .! +{- | A operator to introduce a new local scope that provides effect context @b@.+A version of `..!` where the result is not wrapped in a specific container.+-} (.!)     :: forall i f a b-     . ( SendHOEBy (ProviderKey Identity i) (Provider' Identity i b) f+     . ( SendHOEBy+            (ProviderKey (Const1 Identity :: () -> Type -> Type) (Const i :: () -> Type))+            (Provider' (Const1 Identity) (Const i) (Const1 b))+            f        , Functor f        )     => i     -> ((f ~> b) -> b a)     -> f a-i .! f = runIdentity <$> provide'' @(ProviderKey Identity i) i f+i .! f =+    runIdentity . getConst1+        <$> provide'' @(ProviderKey (Const1 Identity :: () -> _ -> _) (Const i :: () -> _))+            (Const i)+            \run -> Const1 $ f $ getConst1 . run {-# INLINE (.!) #-}  infix 2 ..! +-- | A operator to introduce a new local scope that provides effect context @b p@. (..!)-    :: forall ctx i f a b+    :: forall ctx i p f a b      . (SendHOEBy (ProviderKey ctx i) (Provider' ctx i b) f)-    => i-    -> ((f ~> b) -> b a)-    -> f (ctx a)+    => i p+    -> ((f ~> b p) -> b p a)+    -> f (ctx p a) i ..! f = provide'' @(ProviderKey ctx i) i f {-# INLINE (..!) #-}

@@ -8,18 +8,30 @@ Copyright   :  (c) 2023 Sayo Koyoneda License     :  MPL-2.0 (see the file LICENSE) Maintainer  :  ymdfield@outlook.jp-Stability   :  experimental-Portability :  portable++Effects that can be used to hold environmental values in the context.+Environmental values are immutable and do not change across procedures, but you+can modify the value within a local scope using the `local` operation. -} module Data.Effect.Reader where +-- | An effect that holds a value of type @r@ in the context (environment). data Ask r (a :: Type) where+    -- | Obtain a value from the environment.     Ask :: Ask r r +-- | An effect that locally modifies the value held in the environment. data Local r f (a :: Type) where-    Local :: (r -> r) -> f a -> Local r f a+    -- | Locally modifies the value held in the environment.+    Local+        :: (r -> r)+        -- ^ A function that transforms the original value to the modified value.+        -> f a+        -- ^ The local scope where the modification is applied.+        -> Local r f a  makeEffect [''Ask] [''Local] +-- | Obtains a value from the environment and returns it transformed by the given function. asks :: (Ask r <: f, Functor f) => (r -> a) -> f a asks f = f <$> ask

@@ -0,0 +1,12 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++-- This Source Code Form is subject to the terms of the Mozilla Public+-- License, v. 2.0. If a copy of the MPL was not distributed with this+-- file, You can obtain one at https://mozilla.org/MPL/2.0/.++module Data.Effect.Select where++data Select r a where+    Select :: ((a -> r) -> a) -> Select r a++makeEffectF [''Select]

@@ -7,39 +7,66 @@ module Data.Effect.ShiftReset where  import Control.Monad ((>=>))+import Data.Effect.Key (KeyH (KeyH)) import Data.Functor (void) -data Shift' (r :: Type) b m a where-    Shift :: forall r b m a. ((a -> b r) -> (forall x. m x -> b x) -> b r) -> Shift' r b m a-+data Shift' (ans :: Type) n m a where+    Shift+        :: forall ans n m a+         . ((a -> n ans) -> (forall x. m x -> n x) -> n ans)+        -> Shift' ans n m a makeKeyedEffect [] [''Shift']  callCC-    :: forall r b m a-     . (SendHOEBy ShiftKey (Shift' r b) m, Monad m, Monad b)-    => ((a -> b r) -> m a)+    :: forall a m ans n+     . (SendHOEBy ShiftKey (Shift' ans n) m, Monad m, Monad n)+    => ((a -> n ans) -> m a)     -> m a callCC f = shift \k run -> run (f $ k >=> run . exit) >>= k -exit :: (SendHOEBy ShiftKey (Shift' r b) m, Applicative b) => r -> m a-exit r = shift \_ _ -> pure r+exit+    :: forall a m ans n+     . (SendHOEBy ShiftKey (Shift' ans n) m, Applicative n)+    => ans+    -> m a+exit ans = shift \_ _ -> pure ans {-# INLINE exit #-}  getCC-    :: forall r b m-     . (SendHOEBy ShiftKey (Shift' r b) m, Monad m, Monad b)-    => m (b r)+    :: forall m ans n+     . (SendHOEBy ShiftKey (Shift' ans n) m, Monad m, Monad n)+    => m (n ans) getCC = callCC \exit' -> let a = exit' a in pure a -data Shift_' b m a where-    Shift_' :: (forall (r :: Type). (a -> b r) -> (forall x. m x -> b x) -> b r) -> Shift_' b m a+embed :: forall m ans n. (SendHOEBy ShiftKey (Shift' ans n) m, Monad n) => n ~> m+embed m = shift \k _ -> m >>= k+{-# INLINE embed #-} +data Shift_' n m a where+    Shift_'+        :: (forall (ans :: Type). (a -> n ans) -> (forall x. m x -> n x) -> n ans)+        -> Shift_' n m a makeKeyedEffect [] [''Shift_'] -getCC_ :: (SendHOEBy Shift_Key (Shift_' b) m, Functor b) => m (b ())+getCC_ :: forall m n. (SendHOEBy Shift_Key (Shift_' n) m, Functor n) => m (n ()) getCC_ = shift_' \k _ -> let k' = k $ void k' in k'  data Reset m (a :: Type) where     Reset :: m a -> Reset m a- makeEffectH [''Reset]++data ShiftF ans a where+    ShiftF :: forall ans a. ((a -> ans) -> ans) -> ShiftF ans a+makeEffectF [''ShiftF]++fromShiftF :: ShiftF (n ans) ~> Shift ans n m+fromShiftF (ShiftF f) = KeyH $ Shift \k _ -> f k+{-# INLINE fromShiftF #-}++exitF :: forall ans m a. (ShiftF ans <: m) => ans -> m a+exitF ans = shiftF @ans $ const ans+{-# INLINE exitF #-}++embedF :: forall ans n m. (ShiftF (n ans) <: m, Monad n) => n ~> m+embedF m = shiftF @(n ans) (m >>=)+{-# INLINE embedF #-}

@@ -8,19 +8,24 @@ Copyright   :  (c) 2023 Sayo Koyoneda License     :  MPL-2.0 (see the file LICENSE) Maintainer  :  ymdfield@outlook.jp-Stability   :  experimental-Portability :  portable++Effects for holding mutable state values in the context. -} module Data.Effect.State where +-- | An effect for holding mutable state values in the context. data State s a where+    -- | Retrieves the current state value from the context.     Get :: State s s+    -- | Overwrites the state value in the context.     Put :: s -> State s ()  makeEffectF [''State] +-- | Retrieves the current state value from the context and returns the value transformed based on the given function. gets :: (State s <: f, Functor f) => (s -> a) -> f a gets f = f <$> get +-- | Modifies the current state value in the context based on the given function. modify :: (State s <: m, Monad m) => (s -> s) -> m () modify f = put . f =<< get

@@ -4,6 +4,13 @@ -- License, v. 2.0. If a copy of the MPL was not distributed with this -- file, You can obtain one at https://mozilla.org/MPL/2.0/. +{- |+Copyright   :  (c) 2023-2024 Sayo Koyoneda+License     :  MPL-2.0 (see the file LICENSE)+Maintainer  :  ymdfield@outlook.jp++Realizes [@unliftio@](https://hackage.haskell.org/package/unliftio) in the form of higher-order effects.+-} module Data.Effect.Unlift where  import Data.Effect.Tag (type (##))

@@ -8,20 +8,45 @@ Copyright   :  (c) 2023 Sayo Koyoneda License     :  MPL-2.0 (see the file LICENSE) Maintainer  :  ymdfield@outlook.jp-Stability   :  experimental-Portability :  portable++Effects that can accumulate values monoidally in a context. -} module Data.Effect.Writer where +-- | An effect that can accumulate values monoidally in a context. data Tell w a where+    -- | Accumulates new values to the cumulative value held in the context.     Tell :: w -> Tell w () +-- | An effect that performs local operations on accumulations in the context on a per-scope basis. data WriterH w f a where-    Listen :: f a -> WriterH w f (w, a)-    Censor :: (w -> w) -> f a -> WriterH w f a+    -- | Obtains the accumulated value in the scope and returns it together as a pair.+    Listen+        :: f a+        -- ^ The scope from which to obtain the accumulation.+        -> WriterH w f (w, a)+    -- | Modifies the accumulation in the scope based on the given function.+    Censor+        :: (w -> w)+        -- ^ A function for modifying the accumulated value.+        -> f a+        -- ^ The scope where the modification is applied.+        -> WriterH w f a  makeEffect [''Tell] [''WriterH] +{- |+For a given scope, uses the function (the first component of the pair returned+by that scope) to modify the accumulated value of that scope, and then+accumulates the result into the current outer scope.++@+pass m = do+    (w, (f, a)) <- listen m+    tell $ f w+    pure a+@+-} pass :: (Tell w <: m, WriterH w <<: m, Monad m) => m (w -> w, a) -> m a pass m = do     (w, (f, a)) <- listen m

@@ -9,18 +9,18 @@     module Control.Effect,     module Control.Effect.Key,     module Data.Effect.TH,+    module Data.Effect.HFunctor.TH,     module Data.Effect.Key.TH,     Type,-    def,-    (&),+    Infinite ((:<)), ) where  import Control.Effect (type (<:), type (<<:), type (~>)) import Control.Effect.Key (SendFOEBy, SendHOEBy)-import Data.Default (Default (def))+import Data.Effect.HFunctor.TH import Data.Effect.Key.TH (makeKeyedEffect, makeKeyedEffect_)-import Data.Effect.TH (makeEffect, makeEffect', makeEffectF, makeEffectH, makeEffectH_)-import Data.Function ((&))+import Data.Effect.TH import Data.Kind (Type)+import Data.List.Infinite (Infinite ((:<)))  import "base" Prelude