-
Notifications
You must be signed in to change notification settings - Fork 71
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Can we write a mask effect? #135
Comments
Why are you like this? |
After staring at it for 15 minutes, I'm going to agree that I don't think this is doable. But the deeper question here is "what the hell kind of thing are you actually trying to model?" |
Nothing, I'm just trying to see what can and cannot be expressed within It is possible that this can be thought about in |
Okay, weird. I'm genuinely surprised by how many instances of |
I got it down to this:
We know by construction that |
runMask
:: LastMember (Lift IO) r
=> Sem (Mask ': r) a
-> Sem r a
runMask (Sem m) = withLowerToIO $ \lower finish ->
lower $ Sem $ \k -> m $ \u ->
case decomp u of
Right (Yo (Mask masked) s d y v) -> fmap y $ usingSem k $ do
runMask $ d $ masked (\m1a2 ->
_ $ lower $ runMask $ d $ m1a2 <$ s
) <$ s |
But in the meantime just use |
I'm going to close this, and we can reinvestigate if someone comes up for a genuine use case. |
You could also imagine that data Unmask m a where
Unmask :: m a -> Unmask m a
mask :: Sem (Unmask ': es) a -> Sem es a
mask = ... But I'm not sure if that's possible to write. Maybe it is though! |
Just a note: a data Mask m a where
Unblock :: m a -> Mask m a
Block :: m a -> Mask m a
BlockUninterruptible :: m a -> Mask m a
GetMaskingState :: Mask m MaskingState
mask :: Member Mask r => ((forall x. Sem r x -> Sem r x) -> Sem r a) -> Sem r a
mask main = send GetMaskingState >>= \case
Unmasked -> send $ Block $ main (\x -> send (Unblock x))
MaskedInterruptible -> main (\x -> send (Block x))
MaskedUninterruptible -> main (\x -> send (BlockUninterruptible x)) Interpreting maskToIOFinal :: Member (Final IO) r => Sem (Mask ': r) a -> Sem r a
maskToIOFinal = interpretFinal @IO $ \case
Unblock m -> do
m' <- runS m
pure $ GHC.IO.unsafeUnmask m'
Block m -> do
m' <- runS m
pure $ block m'
BlockUninterruptible m -> do
m' <- runS m
pure $ blockUninterruptible m'
GetMaskingState -> liftS GHC.IO.getMaskingState An easier approach if we don't want to bother with an intermediary effect is to use mask :: forall r a. Member (Final IO) r => ((forall x. Sem r x -> Sem r x) -> Sem r a) -> Sem r a
mask main = withWeavingToFinal $ \s wv _ -> Control.Exception.mask $ \restore ->
let
restore' :: forall x. Sem r x -> Sem r x
restore' m = withStrategicToFinal $ do
m' <- runS m
pure $ restore m'
in
wv (main restore' <$ s) So a |
There's a general pattern I've discovered for creating effects for actions that have contravariant occurrences of import qualified Control.Exception as X
data Mask s m a where
Mask' :: (s -> m a) -> Mask s m a
Restore' :: s -> m a -> Mask s m a
mask
:: Member (Mask s) r
=> ((forall x. Sem r x -> Sem r x) -> Sem r a)
-> Sem r a
mask main = send $ Mask' $ \s -> main (\m -> send (Restore' s m))
newtype Restoration = Restoration (forall x. IO x -> IO x)
runMask
:: Member (Final IO) r
=> Sem (Mask Restoration ': r) a
-> Sem r a
runMask = interpretFinal $ \case
Restore' (Restoration restore) m -> do
m' <- runS m
pure $ restore m'
Mask' main -> do
main' <- bindS main
s <- getInitialStateS
pure $ X.mask $ \restore -> main' (Restoration restore <$ s) The downside is, of course, the need for an intermediary variable. To give another example of how this pattern may be applied, it can be used to formulate import Control.Monad.Cont (MonadCont)
import qualified Control.Monad.Cont as C
data Cont s m a where
Abort :: s -> Cont s m a
CallCC' :: ((a -> s) -> m a) -> Cont s m a
callCC
:: Member (Cont s) r
=> ((forall b. a -> Sem r b) -> Sem r a)
-> Sem r a
callCC cc = send $ CallCC' $ \c -> cc (\a -> send (Abort (c a)))
contToFinal :: (Member (Final m) r, MonadCont m)
=> Sem (Cont (m Void) ': r) a
-> Sem r a
contToFinal = interpretFinal $ \case
Abort s -> pure $ vacuous s
CallCC' main -> do
main' <- bindS main
s <- getInitialStateS
pure $ C.callCC $ \exit -> main' ((exit . (<$ s)) <$ s) You can also use this pattern to create an effect for data Logic s m a where
Recall :: s a -> Logic s m a
Split' :: m a -> Logic s m (Maybe (a, s a))
split
:: Member (Logic s) r
=> Sem r a
-> Sem r (Maybe (a, Sem r a))
split m = (fmap . fmap . fmap) (send . Recall) $ send (Split' m) (Interpreting this is a bit dicey though; it forces you to use the inspector). |
https://github.com/fused-effects/fused-effects/blob/71d8468fa8f63d93c36a45452c178d395fc4d5c3/src/Control/Effect/Exception.hs#L162 suggests this might actually be possible. See fused-effects/fused-effects#306 for a very cool more powerful |
Actually, I'm not sure the |
That means it's possible for them to write |
Thanks for helping me associate them! |
You thought I was done with just an
Async
effect?I would like to know if it's possible to write
In my little toy work, I don't think what is essentially
weave
is sufficient to express such an effect. Ignore all functor stuff (or settingf = Identity
), weave gives us:But given an
m x -> n x
, I don't believe you can writeMask m x -> Mask n x
. Due to the nested functions, you will end up needingn x -> m x
.At this level of quantification, my brain begins to explode 😖 🤔
The text was updated successfully, but these errors were encountered: