sayo-hs/heftia
1
1
Fork 0
mirror of https://github.com/sayo-hs/heftia.git synced 2024-11-22 18:36:15 +03:00
Code Issues Actions 2 Packages Projects Releases Wiki Activity

[add] documentation for standard effects.

Browse Source
This commit is contained in:
Yamada Ryo 2024-11-03 20:36:39 +09:00
parent cb1e5f970c
commit d6f579daff
No known key found for this signature in database
GPG Key ID: AAE3C7A542B02DBF
15 changed files with 145 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
heftia-effects/Example/FileSystemProvider/Main.hs
View File

@ -18,7 +18,7 @@ import Control.Monad.Hefty (
type (<|),
type (~>),
)
import Control.Monad.Hefty.Provider (Provider_, runProvider_, scope_)
import Control.Monad.Hefty.Provider (Provide_, runProvider_, scope_)
data FileSystemF a where
ReadFS :: FilePath -> FileSystemF String
@ -28,7 +28,7 @@ data FileSystemH m (a :: Type) where
TransactFS :: m a -> FileSystemH m a
makeEffect [''FileSystemF] [''FileSystemH]
type FSProvider eh ef = Provider_ FilePath FileSystemH FileSystemF eh ef
type FSProvider eh ef = Provide_ FilePath FileSystemH FileSystemF eh ef
runDummyFSProvider :: (IO <| ef) => Eff (FSProvider eh ef ': eh) ef ~> Eff eh ef
runDummyFSProvider =

7
heftia-effects/src/Control/Monad/Hefty/Concurrent/Parallel.hs
View File

@ -2,6 +2,13 @@
-- SPDX-License-Identifier: MPL-2.0
{- |
Copyright : (c) 2024 Sayo Koyoneda
License : MPL-2.0 (see the LICENSE file)
Maintainer : ymdfield@outlook.jp
Interpreters for the [Parallel]("Data.Effect.Concurrent.Parallel") effects.
-}
module Control.Monad.Hefty.Concurrent.Parallel (
module Control.Monad.Hefty.Concurrent.Parallel,
module Data.Effect.Concurrent.Parallel,

7
heftia-effects/src/Control/Monad/Hefty/Concurrent/Stream.hs
View File

@ -1,7 +1,12 @@
{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
-- SPDX-License-Identifier: MPL-2.0
{- |
Copyright : (c) 2024 Sayo Koyoneda
License : MPL-2.0 (see the LICENSE file)
Maintainer : ymdfield@outlook.jp
Coroutine-based, composable, and resumable concurrent streams.
-}
module Control.Monad.Hefty.Concurrent.Stream (
module Control.Monad.Hefty.Concurrent.Stream,
module Control.Monad.Hefty.Input,

11
heftia-effects/src/Control/Monad/Hefty/Concurrent/Subprocess.hs
View File

@ -4,9 +4,14 @@
-- SPDX-License-Identifier: MPL-2.0 AND BSD-3-Clause
-- (c) The University of Glasgow 2004-2008
-- (c) Sayo Koyoneda 2024
{- |
Copyright : (c) 2024 Sayo Koyoneda
(c) The University of Glasgow 2004-2008
License : MPL-2.0 (see the LICENSE file) AND BSD-3-Clause
Maintainer : ymdfield@outlook.jp
Effects for subprocess.
-}
module Control.Monad.Hefty.Concurrent.Subprocess (
module Control.Monad.Hefty.Concurrent.Subprocess,
module Control.Monad.Hefty.Provider,
@ -62,7 +67,7 @@ data Lifecycle = Kill | Wait
makeEffectF [''Subprocess]
type SubprocProvider eh ef = Provider SubprocResult CreateProcess (Const2 LNop) Subprocess eh ef
type SubprocProvider eh ef = Provide SubprocResult CreateProcess (Const2 LNop) Subprocess eh ef
data SubprocResult p a where
RaceResult :: Either ExitCode a -> SubprocResult ('SubprocMode i o e 'Kill 'Kill) a

8
heftia-effects/src/Control/Monad/Hefty/Concurrent/Timer.hs
View File

@ -2,6 +2,13 @@
-- SPDX-License-Identifier: MPL-2.0
{- |
Copyright : (c) 2024 Sayo Koyoneda
License : MPL-2.0 (see the LICENSE file)
Maintainer : ymdfield@outlook.jp
Interpreters for the [Timer]("Data.Effect.Concurrent.Timer") effects.
-}
module Control.Monad.Hefty.Concurrent.Timer (
module Control.Monad.Hefty.Concurrent.Timer,
module Data.Effect.Concurrent.Timer,
@ -58,6 +65,7 @@ runCyclicTimer a = do
Continue () k -> put =<< raise (k delta)
& evalState timer0
-- | Re-zeros the clock time in the local scope.
restartClock :: (Timer <| ef) => eh :!! ef ~> eh :!! ef
restartClock a = do
t0 <- clock

10
heftia-effects/src/Control/Monad/Hefty/Coroutine.hs
View File

@ -1,5 +1,12 @@
-- SPDX-License-Identifier: MPL-2.0
{- |
Copyright : (c) 2024 Sayo Koyoneda
License : MPL-2.0 (see the LICENSE file)
Maintainer : ymdfield@outlook.jp
Interpreters for the [coroutine]("Data.Effect.Coroutine") effect.
-}
module Control.Monad.Hefty.Coroutine (
module Control.Monad.Hefty.Coroutine,
module Data.Effect.Coroutine,
@ -13,14 +20,17 @@ import Data.Effect.Coroutine
import Data.Effect.Input
import Data.Effect.Output
-- | Interpret the [coroutine]("Data.Effect.Coroutine")'s t'Yield' effect.
runCoroutine
:: forall a b ans ef
. Eff '[] (Yield a b ': ef) ans
-> Eff '[] ef (Status (Eff '[] ef) a b ans)
runCoroutine = interpretBy (pure . Done) (\(Yield a) k -> pure $ Continue a k)
-- | Converts the t'Input' effect into the [coroutine]("Data.Effect.Coroutine")'s t'Yield' effect.
inputToYield :: Input i ~> Yield () i
inputToYield Input = Yield ()
-- | Converts the t'Output' effect into the [coroutine]("Data.Effect.Coroutine")'s t'Yield' effect.
outputToYield :: Output o ~> Yield o ()
outputToYield (Output o) = Yield o

14
heftia-effects/src/Control/Monad/Hefty/Except.hs
View File

@ -1,14 +1,11 @@
-- 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/.
-- SPDX-License-Identifier: MPL-2.0
{- |
Copyright : (c) 2023 Sayo Koyoneda
License : MPL-2.0 (see the LICENSE file)
Maintainer : ymdfield@outlook.jp
Portability : portable
Interpreters for the t'Data.Effect.Except.Throw' / t'Data.Effect.Except.Catch' effects.
Interpreters for the [Except]("Data.Effect.Except") effects.
-}
module Control.Monad.Hefty.Except (
module Control.Monad.Hefty.Except,
@ -35,29 +32,36 @@ import Data.Effect.Unlift (UnliftIO)
import UnliftIO (throwIO)
import UnliftIO qualified as IO
-- | Interpret the t'Throw'/t'Catch' effects.
runExcept :: Eff '[Catch e] (Throw e ': r) a -> Eff '[] r (Either e a)
runExcept = runThrow . runCatch
-- | Interpret the t'Throw' effect.
runThrow :: Eff '[] (Throw e ': r) a -> Eff '[] r (Either e a)
runThrow = interpretBy (pure . Right) handleThrow
-- | Interpret the t'Catch' effect.
runCatch :: (Throw e <| ef) => Eff '[Catch e] ef ~> Eff '[] ef
runCatch = interpretH elabCatch
-- | A handler function for the t'Throw' effect.
handleThrow :: Interpreter (Throw e) (Eff '[] r) (Either e a)
handleThrow (Throw e) _ = pure $ Left e
{-# INLINE handleThrow #-}
-- | A elaborator function for the t'Catch' effect.
elabCatch :: (Throw e <| ef) => Catch e ~~> Eff '[] ef
elabCatch (Catch action hdl) = action & interposeWith \(Throw e) _ -> hdl e
{-# INLINE elabCatch #-}
-- | Interpret the t'Throw' effect based on an IO-fused semantics using IO-level exceptions.
runThrowIO
:: forall e eh ef
. (IO <| ef, Exception e)
=> Eff eh (Throw e ': ef) ~> Eff eh ef
runThrowIO = interpret \(Throw e) -> throwIO e
-- | Interpret the t'Catch' effect based on an IO-fused semantics using IO-level exceptions.
runCatchIO
:: forall e eh ef
. (UnliftIO <<| eh, IO <| ef, Exception e)

14
heftia-effects/src/Control/Monad/Hefty/Input.hs
View File

@ -1,12 +1,11 @@
-- 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/.
-- SPDX-License-Identifier: MPL-2.0
{- |
Copyright : (c) 2024 Sayo Koyoneda
License : MPL-2.0 (see the LICENSE file)
Maintainer : ymdfield@outlook.jp
Portability : portable
Interpreters for the t'Input' effect.
-}
module Control.Monad.Hefty.Input (
module Control.Monad.Hefty.Input,
@ -21,18 +20,25 @@ import Data.Effect.Input
import Data.Effect.State (gets, put)
import Data.List (uncons)
-- | Interprets the t'Input' effect by executing the given input handler each time an input is required.
runInputEff
:: forall i ef eh
. Eff eh ef i
-> Eff eh (Input i ': ef) ~> Eff eh ef
runInputEff a = interpret \Input -> a
-- | Interprets the t'Input' effect by providing the given constant as input.
runInputConst
:: forall i ef eh
. i
-> Eff eh (Input i ': ef) ~> Eff eh ef
runInputConst i = interpret \Input -> pure i
{- |
Interprets the t'Input' effect by using the given list as a series of inputs.
Each time 'input' is called, it retrieves elements from the list one by one from the beginning, and after all elements are consumed, 'Nothing' is returned indefinitely.
-}
runInputList :: forall i r. [i] -> Eff '[] (Input (Maybe i) ': r) ~> Eff '[] r
runInputList is =
raiseUnder

29
heftia-effects/src/Control/Monad/Hefty/NonDet.hs
View File

@ -2,15 +2,14 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
-- 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/.
-- SPDX-License-Identifier: MPL-2.0
{- |
Copyright : (c) 2024 Sayo Koyoneda
License : MPL-2.0 (see the LICENSE file)
Maintainer : ymdfield@outlook.jp
Portability : portable
Interpreters for the [non-determinism]("Data.Effect.NonDet") effects.
-}
module Control.Monad.Hefty.NonDet (
module Control.Monad.Hefty.NonDet,
@ -42,7 +41,7 @@ import Data.Effect.NonDet
import Data.Effect.Unlift (UnliftIO)
import UnliftIO (Exception, SomeException, throwIO, try)
-- | 'NonDet' effects handler for alternative answer type.
-- | [NonDet]("Data.Effect.NonDet") effects handler for alternative answer type.
runNonDet
:: forall f ef a
. (Alternative f)
@ -57,7 +56,7 @@ runNonDet =
!+ nil
)
-- | 'NonDet' effects handler for monoidal answer type.
-- | [NonDet]("Data.Effect.NonDet") effects handler for monoidal answer type.
runNonDetMonoid
:: forall ans ef a
. (Monoid ans)
@ -73,7 +72,7 @@ runNonDetMonoid f =
!+ nil
)
-- | 'Choose' effect handler for alternative answer type.
-- | t'Choose' effect handler for alternative answer type.
runChoose
:: forall f ef a
. (Alternative f)
@ -83,7 +82,7 @@ runChoose =
interpretBy (pure . pure) \Choose k ->
liftA2 (<|>) (k False) (k True)
-- | 'Choose' effect handler for monoidal answer type.
-- | t'Choose' effect handler for monoidal answer type.
runChooseMonoid
:: forall ans ef a
. (Semigroup ans)
@ -94,14 +93,14 @@ runChooseMonoid f =
interpretBy f \Choose k ->
liftA2 (<>) (k False) (k True)
-- | 'Empty' effect handler.
-- | t'Empty' effect handler.
runEmpty :: forall a ef. Eff '[] (Empty ': ef) a -> Eff '[] ef (Maybe a)
runEmpty =
interpretBy
(pure . Just)
\Empty _ -> pure Nothing
{- | 'ChooseH' effect elaborator.
{- | t'ChooseH' effect elaborator.
Convert a higher-order effect of the form
@ -125,16 +124,25 @@ branch a b = do
infixl 3 `branch`
-- | Selects one element from the list nondeterministically, branching the control as many times as the number of elements.
choice :: (Choose <| ef, Empty <| ef) => [a] -> Eff eh ef a
choice = \case
[] -> empty
x : xs -> pure x `branch` choice xs
-- | Selects one element from the list nondeterministically, branching the control as many times as the number of elements. Uses t'ChooseH'.
choiceH :: (ChooseH <<| eh, Empty <| ef) => [a] -> Eff eh ef a
choiceH = \case
[] -> empty
x : xs -> pure x <|> choiceH xs
{- |
Interprets the [NonDet]("Data.Effect.NonDet") effects using IO-level exceptions.
When 'empty' occurs, an 'EmptyException' is thrown, and unless all branches from
'chooseH' fail due to IO-level exceptions, only the leftmost result is returned
as the final result.
-}
runNonDetIO
:: (UnliftIO <<| eh, IO <| ef)
=> Eff (ChooseH ': eh) (Empty ': ef) a
@ -149,6 +157,7 @@ runNonDetIO m = try do
)
& interpret (\Empty -> throwIO EmptyException)
-- | Exception thrown when 'empty' occurs in 'runNonDetIO'.
data EmptyException = EmptyException
deriving stock (Show)
deriving anyclass (Exception)

12
heftia-effects/src/Control/Monad/Hefty/Output.hs
View File

@ -1,12 +1,11 @@
-- 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/.
-- SPDX-License-Identifier: MPL-2.0
{- |
Copyright : (c) 2024 Sayo Koyoneda
License : MPL-2.0 (see the LICENSE file)
Maintainer : ymdfield@outlook.jp
Portability : portable
Interpreters for the t'Output' effect.
-}
module Control.Monad.Hefty.Output (
module Control.Monad.Hefty.Output,
@ -22,17 +21,20 @@ import Data.Effect.Output
import Data.Effect.State (modify)
import Data.Effect.Writer (Tell (Tell))
-- | Interprets the t'Output' effect using the given output handler.
runOutputEff
:: forall o ef eh
. (o -> Eff eh ef ())
-> Eff eh (Output o ': ef) ~> Eff eh ef
runOutputEff f = interpret \(Output o) -> f o
-- | Interprets the t'Output' effect by ignoring the outputs.
ignoreOutput
:: forall o ef eh
. Eff eh (Output o ': ef) ~> Eff eh ef
ignoreOutput = runOutputEff $ const $ pure ()
-- | Interprets the t'Output' effect by accumulating the outputs into a list.
runOutputList
:: forall o a ef
. Eff '[] (Output o ': ef) a
@ -42,7 +44,7 @@ runOutputList =
>>> interpret (\(Output o) -> modify (o :))
>>> runState []
-- | Run an `Output` effect by transforming into a monoid.
-- | Interprets the t'Output' effect by accumulating the outputs into a monoid.
runOutputMonoid
:: forall o w a ef
. ( Monoid w

42
heftia-effects/src/Control/Monad/Hefty/Provider.hs
View File

@ -4,6 +4,8 @@
Copyright : (c) 2024 Sayo Koyoneda
License : MPL-2.0 (see the LICENSE file)
Maintainer : ymdfield@outlook.jp
Interpreters for the [Provider]("Data.Effect.Provider") effects.
-}
module Control.Monad.Hefty.Provider (
module Control.Monad.Hefty.Provider,
@ -30,48 +32,52 @@ import Control.Monad.Hefty (
type (~>),
)
import Data.Effect.HFunctor (hfmap)
import Data.Effect.Provider hiding (Provider, Provider_)
import Data.Effect.Provider qualified as D
import Data.Effect.Provider
import Data.Functor.Const (Const (Const))
import Data.Functor.Identity (Identity (Identity))
type Provider ctx i sh sf eh ef = D.Provider ctx i (ProviderEff ctx i sh sf eh ef)
type Provide ctx i sh sf eh ef = Provider ctx i (ProviderEff ctx i sh sf eh ef)
newtype ProviderEff ctx i sh sf eh ef p a
= ProviderEff {unProviderEff :: Eff (sh p ': Provider ctx i sh sf eh ef ': eh) (sf p ': ef) a}
= ProviderEff {unProviderEff :: Eff (sh p ': Provide ctx i sh sf eh ef ': eh) (sf p ': ef) a}
type Provider_ i sh sf eh ef =
D.Provider (Const1 Identity) (Const i :: () -> Type) (Const1 (ProviderEff_ i sh sf eh ef))
type Provide_ i sh sf eh ef =
Provider (Const1 Identity) (Const i :: () -> Type) (Const1 (ProviderEff_ i sh sf eh ef))
newtype ProviderEff_ i sh sf eh ef a
= ProviderEff_ {unProviderEff_ :: Eff (sh ': Provider_ i sh sf eh ef ': eh) (sf ': ef) a}
= ProviderEff_ {unProviderEff_ :: Eff (sh ': Provide_ i sh sf eh ef ': eh) (sf ': ef) 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
-- | Interpret the t'Provider' effect using the given effect interpreter.
runProvider
:: forall ctx i sh sf eh ef
. ( forall p x
. i p
-> Eff (sh p ': Provider ctx i sh sf eh ef ': eh) (sf p ': ef) x
-> Eff (Provider ctx i sh sf eh ef ': eh) ef (ctx p x)
-> Eff (sh p ': Provide ctx i sh sf eh ef ': eh) (sf p ': ef) x
-> Eff (Provide ctx i sh sf eh ef ': eh) ef (ctx p x)
)
-> Eff (Provider ctx i sh sf eh ef ': eh) ef ~> Eff eh ef
-> Eff (Provide ctx i sh sf eh ef ': eh) ef ~> Eff eh ef
runProvider run =
interpretH \(KeyH (Provide i f)) ->
runProvider run $
run i (unProviderEff $ f $ ProviderEff . transEffHF (weakenNH @2) weaken)
{- |
Interpret the t'Provider' effect using the given effect interpreter.
A version of 'runProvider' where the type of t'Provider' is simpler.
-}
runProvider_
:: forall i sh sf eh ef
. (HFunctor sh)
=> ( forall x
. i
-> Eff (sh ': Provider_ i sh sf eh ef ': eh) (sf ': ef) x
-> Eff (Provider_ i sh sf eh ef ': eh) ef x
-> Eff (sh ': Provide_ i sh sf eh ef ': eh) (sf ': ef) x
-> Eff (Provide_ i sh sf eh ef ': eh) ef x
)
-> Eff (Provider_ i sh sf eh ef ': eh) ef ~> Eff eh ef
-> Eff (Provide_ i sh sf eh ef ': eh) ef ~> Eff eh ef
runProvider_ run =
interpretH \(KeyH (Provide (Const i) f)) ->
runProvider_ run $
@ -86,6 +92,7 @@ runProvider_ run =
. transEffHF (weakenNH @2) weaken
)
-- | Introduces a new local scope that provides effects @sh p@ and @sf p@ parameterized by @i p@ value and with results wrapped in @ctx p@.
scope
:: forall key ctx i p eh ef a sh sf bh bf
. ( MemberHBy
@ -95,14 +102,15 @@ scope
, HFunctor (sh p)
)
=> i p
-> ( Eff eh ef ~> Eff (key ##> sh p ': Provider ctx i sh sf bh bf ': bh) (key #> sf p ': bf)
-> Eff (key ##> sh p ': Provider ctx i sh sf bh bf ': bh) (key #> sf p ': bf) a
-> ( Eff eh ef ~> Eff (key ##> sh p ': Provide ctx i sh sf bh bf ': bh) (key #> sf p ': bf)
-> Eff (key ##> sh p ': Provide ctx i sh sf bh bf ': bh) (key #> sf p ': bf) a
)
-> Eff eh ef (ctx p a)
scope i f =
i ..! \runInScope ->
ProviderEff $ unkeyH . unkey $ f (keyH . key . unProviderEff . runInScope)
-- | Introduces a new local scope that provides effects @sh@ and @sf@ parameterized by @i@ value.
scope_
:: forall key i eh ef a sh sf bh bf
. ( MemberHBy
@ -116,8 +124,8 @@ scope_
, HFunctor sh
)
=> i
-> ( Eff eh ef ~> Eff (key ##> sh ': Provider_ i sh sf bh bf ': bh) (key #> sf ': bf)
-> Eff (key ##> sh ': Provider_ i sh sf bh bf ': bh) (key #> sf ': bf) a
-> ( Eff eh ef ~> Eff (key ##> sh ': Provide_ i sh sf bh bf ': bh) (key #> sf ': bf)
-> Eff (key ##> sh ': Provide_ i sh sf bh bf ': bh) (key #> sf ': bf) a
)
-> Eff eh ef a
scope_ i f =

11
heftia-effects/src/Control/Monad/Hefty/Reader.hs
View File

@ -1,14 +1,11 @@
-- 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/.
-- SPDX-License-Identifier: MPL-2.0
{- |
Copyright : (c) 2023 Sayo Koyoneda
License : MPL-2.0 (see the LICENSE file)
Maintainer : ymdfield@outlook.jp
Portability : portable
Interpreters for the t'Ask' / t'Local' effects.
Interpreters for the [Reader]("Data.Effect.Reader") effects.
-}
module Control.Monad.Hefty.Reader (
module Control.Monad.Hefty.Reader,
@ -28,19 +25,21 @@ import Control.Monad.Hefty (
)
import Data.Effect.Reader
-- | Interpret the t'Ask'/t'Local' effects.
runReader
:: forall r eh ef
. r
-> Eff (Local r ': eh) (Ask r ': ef) ~> Eff eh ef
runReader r = runAsk r . runLocal
-- | Elaborate the t'Local' effect.
-- | Interpret the t'Local' effect.
runLocal
:: forall r eh ef
. (Ask r <| ef)
=> Eff (Local r ': eh) ef ~> Eff eh ef
runLocal = interpretH elabLocal
-- | A elaborator function for the t'Local' effect.
elabLocal
:: forall r eh ef
. (Ask r <| ef)

18
heftia-effects/src/Control/Monad/Hefty/State.hs
View File

@ -6,7 +6,6 @@
Copyright : (c) 2023 Sayo Koyoneda
License : MPL-2.0 (see the LICENSE file)
Maintainer : ymdfield@outlook.jp
Portability : portable
Interpreter for the t'Data.Effect.State.State' effect.
-}
@ -38,25 +37,35 @@ import Data.Effect.State
import Data.Functor ((<&>))
import UnliftIO (newIORef, readIORef, writeIORef)
-- | Interpret the 'Get'/'Put' effects.
-- | Interpret the 'State' effect.
runState :: forall s ef a. s -> Eff '[] (State s ': ef) a -> Eff '[] ef (s, a)
runState s0 = interpretStateBy s0 (curry pure) handleState
-- | Interpret the 'State' effect. Do not include the final state in the return value.
evalState :: forall s ef a. s -> Eff '[] (State s ': ef) a -> Eff '[] ef a
evalState s0 = interpretStateBy s0 (const pure) handleState
-- | Interpret the 'State' effect. Do not include the final result in the return value.
execState :: forall s ef a. s -> Eff '[] (State s ': ef) a -> Eff '[] ef s
execState s0 = interpretStateBy s0 (\s _ -> pure s) handleState
{- |
Interpret the 'State' effect.
Interpretation is performed recursively with respect to the scopes of unelaborated higher-order effects @eh@.
Note that the state is reset and does not persist beyond the scopes.
-}
evalStateRec :: forall s ef eh. s -> Eff eh (State s ': ef) ~> Eff eh ef
evalStateRec s0 = interpretStateRecWith s0 handleState
-- | A handler function for the 'State' effect.
handleState :: StateInterpreter s (State s) (Eff eh r) ans
handleState = \case
Put s -> \_ k -> k s ()
Get -> \s k -> k s s
{-# INLINE handleState #-}
-- | Interpret the 'State' effect based on an IO-fused semantics using t'Data.IORef.IORef'.
runStateIORef
:: forall s ef eh a
. (IO <| ef)
@ -71,6 +80,10 @@ runStateIORef s0 m = do
Put s -> writeIORef ref s
readIORef ref <&> (,a)
{- |
Interpret the 'State' effect based on an IO-fused semantics using t'Data.IORef.IORef'.
Do not include the final state in the return value.
-}
evalStateIORef
:: forall s ef eh a
. (IO <| ef)
@ -83,6 +96,7 @@ evalStateIORef s0 m = do
Get -> readIORef ref
Put s -> writeIORef ref s
-- | Within the given scope, make the state roll back to the beginning of the scope in case of exceptions, etc.
transactState :: forall s ef. (State s <| ef) => Eff '[] ef ~> Eff '[] ef
transactState m = do
pre <- get @s

7
heftia-effects/src/Control/Monad/Hefty/Unlift.hs
View File

@ -1,12 +1,11 @@
-- 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/.
-- SPDX-License-Identifier: MPL-2.0
{- |
Copyright : (c) 2024 Sayo Koyoneda
License : MPL-2.0 (see the LICENSE file)
Maintainer : ymdfield@outlook.jp
Portability : portable
Interpreters for the [Unlift]("Data.Effect.Unlift") effects.
-}
module Control.Monad.Hefty.Unlift (
module Control.Monad.Hefty.Unlift,

20
heftia-effects/src/Control/Monad/Hefty/Writer.hs
View File

@ -1,17 +1,11 @@
{-# 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/.
-- SPDX-License-Identifier: MPL-2.0
{- |
Copyright : (c) 2023 Sayo Koyoneda
License : MPL-2.0 (see the LICENSE file)
Maintainer : ymdfield@outlook.jp
Portability : portable
Interpreter and elaborator for the t'Data.Effect.Writer.Writer' effect class.
See [README.md](https://github.com/sayo-hs/heftia/blob/master/README.md).
Interpreters for the [Writer]("Data.Effect.Writer") effects.
-}
module Control.Monad.Hefty.Writer (
module Control.Monad.Hefty.Writer,
@ -32,26 +26,30 @@ import Control.Monad.Hefty (
)
import Data.Effect.Writer
-- | 'Writer' effect handler with post-applying censor semantics.
-- | Interpret the [Writer]("Data.Effect.Writer") effects with post-applying censor semantics.
runWriterPost :: (Monoid w) => Eff '[WriterH w] (Tell w ': ef) a -> Eff '[] ef (w, a)
runWriterPost = runTell . runWriterHPost
-- | 'Writer' effect handler with pre-applying censor semantics.
-- | Interpret the [Writer]("Data.Effect.Writer") effects with pre-applying censor semantics.
runWriterPre :: (Monoid w) => Eff '[WriterH w] (Tell w ': ef) a -> Eff '[] ef (w, a)
runWriterPre = runTell . runWriterHPre
-- | Interpret the t'Tell' effect.
runTell :: (Monoid w) => Eff '[] (Tell w ': ef) a -> Eff '[] ef (w, a)
runTell = interpretStateBy mempty (curry pure) handleTell
-- | A handler function for the 'Tell' effect.
handleTell :: (Monoid w) => StateInterpreter w (Tell w) (Eff '[] ef) (w, a)
handleTell (Tell w') w k = k (w <> w') ()
{-# INLINE handleTell #-}
-- | Interpret the 'WriterH' effect with post-applying censor semantics.
runWriterHPost :: (Monoid w, Tell w <| ef) => Eff '[WriterH w] ef ~> Eff '[] ef
runWriterHPost = interpretH \case
Listen m -> intercept m
Censor f m -> censorPost f m
-- | Interpret the 'WriterH' effect with pre-applying censor semantics.
runWriterHPre :: (Monoid w, Tell w <| ef) => Eff '[WriterH w] ef ~> Eff '[] ef
runWriterHPre = interpretH \case
Listen m -> intercept m
@ -83,6 +81,7 @@ confiscate
-> Eff '[] ef (w, a)
confiscate = interposeStateBy mempty (curry pure) handleTell
-- | 'censor' with post-applying semantics.
censorPost
:: forall w ef
. (Tell w <| ef, Monoid w)
@ -93,6 +92,7 @@ censorPost f m = do
tell $ f w
pure a
-- | 'censor' with pre-applying semantics.
censorPre
:: forall w eh ef
. (Tell w <| ef, Monoid w)