bluefin-internal 0.5.1.0 → 0.5.100.0

raw patch · 11 files changed

+449/−98 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +2/−0
• bluefin-internal.cabal +2/−2
• src/Bluefin/Internal.hs +321/−32
• src/Bluefin/Internal/DslBuilderEffects.hs +1/−2
• src/Bluefin/Internal/Examples.hs +48/−48
• src/Bluefin/Internal/Exception.hs +18/−7
• src/Bluefin/Internal/GadtEffect.hs +1/−0
• src/Bluefin/Internal/OneWayCoercible.hs +4/−3
• src/Bluefin/Internal/Prim.hs +26/−3
• test/Main.hs +25/−0
• test/Test/SpecH.hs +1/−1

@@ -1,3 +1,5 @@+* Add exports for change to "capability" nomenclature+ # 0.5.1.0  * Add `<:` type synonym for `:>`

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               bluefin-internal-version:            0.5.1.0+version:            0.5.100.0 license:            MIT license-file:       LICENSE author:             Tom Ellis@@ -79,7 +79,7 @@       async >= 2.2 && < 2.3,       base >= 4.14 && < 4.23,       unliftio-core < 0.3,-      primitive >= 0.9,+      primitive >= 0.8 && < 0.10,       transformers < 0.7,       transformers-base < 0.5,       monad-control < 1.1

@@ -340,12 +340,12 @@   Eff (e1 :& es) r useImplWithin k = useImplUnder . k --- | Handle to a capability to create strict mutable state handles+-- | Capability to create strict mutable state capabilities data StateSource (e :: Effects) = StateSource  type role StateSource nominal --- | Handle to an exception of type @exn@+-- | Capability to throw an exception of type @exn@ newtype Exception exn (e :: Effects)   = MkException (forall a. exn -> Eff e a)   deriving (Handle) via OneWayCoercibleHandle (Exception exn)@@ -355,7 +355,7 @@ instance (e <: es) => OneWayCoercible (Exception ex e) (Exception ex es) where   oneWayCoercibleImpl = oneWayCoercible --- | A handle to a strict mutable state of type @s@+-- | Capability to modify a reference to an @s@ newtype State s (e :: Effects) = UnsafeMkState (IORef s)   deriving (Handle) via OneWayCoercibleHandle (State s) @@ -364,28 +364,28 @@ instance (e <: es) => OneWayCoercible (State s e) (State s es) where   oneWayCoercibleImpl = oneWayCoercible --- | A handle to a coroutine that yields values of type @a@ and then--- expects values of type @b@.+-- | Capability to yield a value of type @a@ and then await a value of+-- type @b@ in response. newtype Coroutine a b (e :: Effects) = MkCoroutine (a -> Eff e b)   deriving (Handle) via OneWayCoercibleHandle (Coroutine a b)  instance (e <: es) => OneWayCoercible (Coroutine a b e) (Coroutine a b es) where   oneWayCoercibleImpl = oneWayCoercible --- | A handle to a stream that yields values of type @a@.  It is--- implemented as a handle to a coroutine that yields values of type--- @a@ and then expects values of type @()@.+-- | Capability to yield values of type @a@.  It is implemented as a+-- 'Bluefin.Capability.Request' capability that can yield values of+-- type @a@ and then await values of type @()@. type Stream a = Coroutine a ()  type Consume a = Coroutine () a --- | Every Bluefin handle should have an instance of class @Handle@.--- Built-in handles, such as 'Exception', 'State' and 'IOE', come with+-- | Every Bluefin capability should have an instance of class @Handle@.+-- Built-in capabilities, such as 'Exception', 'State' and 'IOE', come with -- @Handle@ instances. ----- You should define a @Handle@ instance for each handle that you+-- You should define a @Handle@ instance for each capability that you -- define yourself.  As--- an example, an "application" handle with a dynamic effect for+-- an example, an "application" capability with a dynamic effect for -- database queries, a concrete effect for application state and a -- concrete effect for a logging effect might look like this: --@@ -406,9 +406,12 @@ -- you can instead use -- -- @--- instance (e \<: es) => OneWayCoercible (MyHandle e) (MyHandle es) where+-- instance (e \<: es) => OneWayCoercible (MyCapability e) (MyCapability es) where --   oneWayCoercibleImpl = 'oneWayCoercibleTrustMe' $ \\h -> \<mapHandle definition\> -- @+--+-- Please note the "handle" nomeclature is legacy and will probably+-- change to "capability" in the future.  See "Bluefin.Capability". class Handle (h :: Effects -> Type) where   handleImpl :: HandleD h @@ -418,18 +421,18 @@ -- @mapHandle@, for example like this: -- -- @--- instance Handle MyHandle where+-- instance Handle MyCapability where --   mapHandle h = \<mapHandle definition\> -- @ -- -- you should change it to -- -- @--- data MyHandle e = ...+-- data MyCapability e = ... --   deriving (Generic)---   deriving (Handle) via 'OneWayCoercibleHandle' MyHandle+--   deriving (Handle) via 'OneWayCoercibleHandle' MyCapability ----- instance (e \<: es) => 'OneWayCoercible' (MyHandle e) (MyHandle es) where+-- instance (e \<: es) => 'OneWayCoercible' (MyCapability e) (MyCapability es) where --   'oneWayCoercibleImpl' = 'gOneWayCoercible' -- @ --@@ -437,7 +440,7 @@ -- you can instead use -- -- @--- instance (e \<: es) => OneWayCoercible (MyHandle e) (MyHandle es) where+-- instance (e \<: es) => OneWayCoercible (MyCapability e) (MyCapability es) where --   oneWayCoercibleImpl = 'oneWayCoercibleTrustMe' $ \\h -> \<mapHandle definition\> -- @ mapHandle :: forall h e es. (Handle h, e <: es) => h e -> h es@@ -446,6 +449,7 @@ withHandle ::   forall h r.   (Handle h) =>+  -- | ͘   ((forall e es. (e <: es) => OneWayCoercible (h e) (h es)) => r) ->   r withHandle r = case handleDictImpl @h of MkHandleDict -> r@@ -577,7 +581,7 @@ -- }  -- | A convenience type whose only purpose is to avoid writing @(# #)@--- as an argument to functions which are only function because+-- as an argument to functions which are only functions because -- top-level definitions of unlifted kind are forbidden. newtype ZW = MkZW (# #) @@ -763,8 +767,7 @@       withScopedException_ $ \throw_ -> do         effToIO (f (MkException (effIO io . throw_))) --- | 'handle', but with the argument order swapped---+-- | -- @ -- >>> runPureEff $ handle (pure . show) $ \\e -> do --       throw e 42@@ -782,6 +785,7 @@     Left e -> h e     Right a -> pure a +-- | 'handle', but with the argument order swapped catch ::   forall exn (es :: Effects) a.   (forall e. Exception exn e -> Eff (e :& es) a) ->@@ -986,9 +990,9 @@ newState ::   (e <: es) =>   StateSource e ->-  -- | The initial value for the state handle+  -- | The initial value for the state capability   s ->-  -- | A new state handle+  -- | A new state capability   Eff es (State s e) newState StateSource s = unsafeProvideIO $ \io -> do   fmap UnsafeMkState (effIO io (newIORef s))@@ -1055,9 +1059,9 @@ -- Apply an effectful function to each element yielded to the stream. -- -- @--- >>> runPureEff $ yieldToList $ \\y -> do---       forEach (inFoldable [0 .. 3]) $ \\i -> do---         yield y i+-- >>> 'runPureEff' $ 'yieldToList' $ \\y -> do+--       'forEach' ('inFoldable' [0 .. 3]) $ \\i -> do+--         'yield' y i --         yield y (i * 10) -- ([0, 0, 1, 10, 2, 20, 3, 30], ()) -- @@@ -1119,7 +1123,7 @@ -- starting from an inital value. -- -- @--- >>> runPureEff $ yieldToList $ enumerateFrom1 (inFoldable [\"A\", \"B\", \"C\"])+-- >>> runPureEff $ yieldToList $ enumerateFrom 1 (inFoldable [\"A\", \"B\", \"C\"]) -- ([(1, \"A\"), (2, \"B\"), (3, \"C\")], ()) -- @ enumerateFrom ::@@ -1380,8 +1384,8 @@ -- @ -- runPureEff $ yieldToList $ \yOut -> do --   consumeStream---     (\c -> takeConsume 6 c yOut)---     (\yIn -> cycleToStream [1..3] yIn)+--     (\\c -> takeConsume 6 c yOut)+--     (\\yIn -> cycleToStream [1..3] yIn) -- ([1,2,3,1,2,3],()) -- @ cycleToStream ::@@ -1397,8 +1401,8 @@ -- @ -- runPureEff $ yieldToList $ \yOut -> do --   consumeStream---     (\c -> takeConsume 4 c yOut)---     (\yIn -> inFoldable [1..10] yIn)+--     (\\c -> takeConsume 4 c yOut)+--     (\\yIn -> inFoldable [1..10] yIn) -- ([1,2,3,4],()) -- @ takeConsume ::@@ -1465,7 +1469,7 @@   Nothing -> jumpTo j   Just a -> pure a --- | Handle that allows you to run 'IO' operations+-- | Capability to run 'IO' operations data IOE (e :: Effects) = MkIOE   deriving (Handle) via OneWayCoercibleHandle IOE @@ -1765,3 +1769,288 @@   -- | ͘   Eff es a runConstEffect r k = useImplIn k (MkConstEffect r)++-- Capbility synonyms++type Ask = Reader++type AskCapability = HandleReader++-- | Capability to await values of type @a@+type Await a = Consume a++type JumpTo = Jump++-- | Capability to yield a value of type @a@ and then await a value of+-- type @b@ in response.+type Request = Coroutine++type ReturnEarly = EarlyReturn++-- | Capability to modify a reference to an @s@+type Modify = State++type Tell = Writer++-- | Capability to throw an exception of type @exn@+type Throw = Exception++-- | Capability to yield values of type @a@.  It is implemented as a+-- 'Bluefin.Capability.Request' capability that can yield values of+-- type @a@ and then await values of type @()@.+type Yield a = Stream a++runAsk ::+  -- | Initial value for @Ask@.+  r ->+  (forall e. Ask r e -> Eff (e :& es) a) ->+  Eff es a+runAsk = runReader++-- | Interleave the execution of two Bluefin operations by sending+-- their requests to each other.  @a@s are sent from the first to the+-- second which responds by returning @b@s.  The first runs until it+-- yields its first @a@ it starts the second (which is awaiting an+-- @a@).+connectRequests ::+  forall es a b r.+  (forall e. Request a b e -> Eff (e :& es) r) ->+  (forall e. a -> Request b a e -> Eff (e :& es) r) ->+  -- | ͘+  Eff es r+connectRequests = connectCoroutines++request ::+  (e1 <: es) =>+  Request a b e1 ->+  -- | ͘+  a ->+  Eff es b+request = yieldCoroutine++-- | 'awaitYield' is 'Bluefin.Capability.Request.connectRequests'+-- specialized to @Await@ and @Yield@, which is the most common case.+awaitYield ::+  -- | Starts running first. Each 'await' from the @Consume@ ...+  (forall e. Await a e -> Eff (e :& es) r) ->+  -- | ... receives the value 'yield'ed from the @Yield@+  (forall e. Yield a e -> Eff (e :& es) r) ->+  Eff es r+awaitYield = consumeStream++-- | A version of 'forEach' specialized to @Await@.  Every time the+-- @Await@ is used to 'await' a @b@, feed it the one created by the+-- handler.+eachAwait ::+  -- | Body+  (forall e. Await b e -> Eff (e :& es) r) ->+  -- | Value to send to each @await@ in the body.+  Eff es b ->+  Eff es r+eachAwait = consumeEach++-- |+-- @+-- runPureEff $ yieldToList $ \yOut -> do+--   awaitYield+--     (\\c -> takeAwait 4 c yOut)+--     (\\yIn -> inFoldable [1..10] yIn)+-- ([1,2,3,4],())+-- @+takeAwait ::+  (e1 <: es, e2 <: es) =>+  Int ->+  Await a e1 ->+  Yield a e2 ->+  -- | ͘+  Eff es ()+takeAwait = takeConsume++-- |+--+-- Ignore all yielded elements.+--+-- @+-- >>> runPureEff $ ignoreYield $ \\y -> do+--      for_ [0 .. 4] $ \\i -> do+--        yield y i+--        yield y (i * 10)+--+--      pure 42+-- 42+-- @+ignoreYield ::+  (forall e1. Stream a e1 -> Eff (e1 :& es) r) ->+  -- | ͘+  Eff es r+ignoreYield = ignoreStream++-- |+-- @+-- runPureEff $ yieldToList $ \yOut -> do+--   consumeStream+--     (\\c -> takeAwait 6 c yOut)+--     (\\yIn -> cycleToYield [1..3] yIn)+-- ([1,2,3,1,2,3],())+-- @+cycleToYield ::+  (Foldable f, e1 <: es) =>+  f a ->+  Yield a e1 ->+  -- | ͘+  Eff es ()+cycleToYield = cycleToStream++-- | Run an 'Eff' action with the ability to return early to this+-- point.  In the language of exceptions, @withReturnEarly@ installs+-- an exception handler for an exception of type @r@.+--+-- @+-- >>> runPureEff $ withReturnEarly $ \\e -> do+--       for_ [1 .. 10] $ \\i -> do+--         when (i >= 5) $+--           returnEarly e ("Returned early with " ++ show i)+--       pure "End of loop"+-- "Returned early with 5"+-- @+withReturnEarly ::+  (forall e. EarlyReturn r e -> Eff (e :& es) r) ->+  -- | ͘+  Eff es r+withReturnEarly = withEarlyReturn++-- |+-- @+-- >>> runPureEff $ evalModify 10 $ \\st -> do+--       n <- get st+--       pure (2 * n)+-- 20+-- @+evalModify ::+  -- | Initial value of modifyable state+  s ->+  -- | Stateful computation+  (forall e. Modify s e -> Eff (e :& es) a) ->+  -- | Result+  Eff es a+evalModify = evalState++-- |+-- @+-- >>> runPureEff $ withModify 10 $ \\st -> do+--       n <- get st+--       pure (\s -> (2 * n, s))+-- (20,10)+-- @+withModify ::+  -- | Initial value of modifyable state+  s ->+  -- | Stateful computation+  (forall e. Modify s e -> Eff (e :& es) (s -> a)) ->+  -- | Result+  Eff es a+withModify = withState++-- |+-- @+-- >>> runPureEff $ runModify 10 $ \\st -> do+--       n <- get st+--       pure (2 * n)+-- (20,10)+-- @+runModify ::+  -- | Initial value of modifyable state+  s ->+  -- | Stateful computation+  (forall e. Modify s e -> Eff (e :& es) a) ->+  -- | Result and final state+  Eff es (a, s)+runModify = runState++-- |+-- @+-- >>> 'Data.Monoid.getAny' $ snd $ runPureEff $ runTell $ \\w -> do+--       -- Non-empty list (the tell event does happen)+--       for_ [1 .. 10] $ \\_ -> tell w ('Data.Monoid.Any' True)+-- True+-- @+runTell ::+  (Monoid w) =>+  -- | ͘+  (forall e. Tell w e -> Eff (e :& es) r) ->+  Eff es (r, w)+runTell = runWriter++-- |+-- @+-- >>> 'Data.Monoid.getAny' $ runPureEff $ execTell $ \\w -> do+--       -- Non-empty list (the tell event does happen)+--       for_ [1 .. 10] $ \\_ -> tell w ('Data.Monoid.Any' True)+-- True+-- @+--+-- @+-- >>> 'Data.Monoid.getAny' $ runPureEff $ execTell $ \\w -> do+--       -- Empty list (the tell event does not happen)+--       for_ [] $ \\_ -> tell w ('Data.Monoid.Any' True)+-- False+-- @+execTell ::+  (Monoid w) =>+  -- | ͘+  (forall e. Tell w e -> Eff (e :& es) r) ->+  Eff es w+execTell = execWriter++runAskCapability ::+  (e1 <: es, Handle h) =>+  h e1 ->+  (forall e. HandleReader h e -> Eff (e :& es) r) ->+  -- | ͘+  Eff es r+runAskCapability = runHandleReader++askCapability ::+  (e <: es, Handle h) =>+  HandleReader h e ->+  -- | ͘+  Eff es (h es)+askCapability = askHandle++asksCapability ::+  (e1 <: es, Handle h) =>+  AskCapability h e1 ->+  (forall e. h e -> Eff (e :& es) r) ->+  -- | ͘+  Eff es r+asksCapability = asksHandle++localCapability ::+  (e <: es, Handle h) =>+  AskCapability h e ->+  (h es -> h es) ->+  Eff es r ->+  -- | ͘+  Eff es r+localCapability = localHandle++-- |+-- @+-- runPureEff $ 'withStateSource' $ \\source -> do+--   n <- 'newState' source 5+--   total <- newState source 0+--+--   'Bluefin.JumpTo.withJumpTo' $ \\done -> forever $ do+--     n' <- 'Bluefin.Capability.Modify.get' n+--     'Bluefin.Capability.Modify.modify' total (+ n')+--     when (n' == 0) $ 'Bluefin.JumpTo.jumpTo' done+--     modify n (subtract 1)+--+--   get total+-- 15+-- @+withJumpTo ::+  (forall e. JumpTo e -> Eff (e :& es) ()) ->+  -- | ͘+  Eff es ()+withJumpTo = withEarlyReturn

@@ -1,6 +1,5 @@ -- This will probably be superseded by DslBuilderEff because the -- latter has a better name- {-# LANGUAGE DerivingVia #-} {-# LANGUAGE QuantifiedConstraints #-} @@ -9,9 +8,9 @@ import Bluefin.Internal import Bluefin.Internal.OneWayCoercible   ( OneWayCoercible,+    oneWayCoerce,     oneWayCoercible,     oneWayCoercibleImpl,-    oneWayCoerce,   )  newtype DslBuilderEffects h es r

@@ -55,16 +55,16 @@   pure "No exception thrown"  exampleGet :: (Int, Int)-exampleGet = runPureEff $ runState 10 $ \st -> do+exampleGet = runPureEff $ runModify 10 $ \st -> do   n <- get st   pure (2 * n)  examplePut :: ((), Int)-examplePut = runPureEff $ runState 10 $ \st -> do+examplePut = runPureEff $ runModify 10 $ \st -> do   put st 30  exampleModify :: ((), Int)-exampleModify = runPureEff $ runState 10 $ \st -> do+exampleModify = runPureEff $ runModify 10 $ \st -> do   modify st (* 2)  yieldExample :: ([Int], ())@@ -86,8 +86,8 @@   (forall e. Stream () e -> Eff (e :& es) ()) ->   Eff es () doubleNestedForEach f =-  withState () $ \_ -> do-    withState () $ \_ -> do+  withModify () $ \_ -> do+    withModify () $ \_ -> do       forEach (insertManySecond . f) (\_ -> pure ())       pure (\_ _ -> ()) @@ -139,7 +139,7 @@ example1_ :: (Int, Int) example1_ =   let example1 :: Int -> Int-      example1 n = runPureEff $ evalState n $ \st -> do+      example1 n = runPureEff $ evalModify n $ \st -> do         n' <- get st         when (n' < 10) $           put st (n' + 10)@@ -150,8 +150,8 @@ example2_ =   let example2 :: (Int, Int) -> (Int, Int)       example2 (m, n) = runPureEff $-        evalState m $ \sm -> do-          evalState n $ \sn -> do+        evalModify m $ \sm -> do+          evalModify n $ \sn -> do             do               n' <- get sn               m' <- get sm@@ -169,7 +169,7 @@ example3' :: Int -> Either String Int example3' n = runPureEff $   try $ \ex -> do-    evalState 0 $ \total -> do+    evalModify 0 $ \total -> do       for_ [1 .. n] $ \i -> do         soFar <- get total         when (soFar > 20) $ do@@ -211,7 +211,7 @@   IOE e ->   (forall e1. Consume a e1 -> Eff (e1 :& es) ()) ->   Eff es ()-awaitList l io k = evalState l $ \s -> do+awaitList l io k = evalModify l $ \s -> do   withJump $ \done ->     bracket       (pure ())@@ -232,7 +232,7 @@   Consume a e3 ->   Eff es () takeRec n k rec =-  withJump $ \done -> evalState n $ \s -> consumeEach (useImplUnder . k) $ do+  withJump $ \done -> evalModify n $ \s -> consumeEach (useImplUnder . k) $ do     s' <- get s     if s' <= 0       then jumpTo done@@ -370,7 +370,7 @@ zipCoroutinesExample = runEff_ $ \io -> do   let m1 y = do         r <- yieldCoroutine y 1-        evalState r $ \rs -> do+        evalModify r $ \rs -> do           for_ [1 .. 10 :: Int] $ \i -> do             r' <- get rs             r'' <- yieldCoroutine y (r' + i)@@ -378,7 +378,7 @@    let m2 y = do         r <- yieldCoroutine y 1-        evalState r $ \rs -> do+        evalModify r $ \rs -> do           for_ [1 .. 5 :: Int] $ \i -> do             r' <- get rs             r'' <- yieldCoroutine y (r' - i)@@ -393,9 +393,9 @@ -- error message. countPositivesNegatives :: [Int] -> String countPositivesNegatives is = runPureEff $-  evalState (0 :: Int) $ \positives -> do+  evalModify (0 :: Int) $ \positives -> do     r <- try $ \ex ->-      evalState (0 :: Int) $ \negatives -> do+      evalModify (0 :: Int) $ \negatives -> do         for_ is $ \i -> do           case compare i 0 of             GT -> modify positives (+ 1)@@ -422,7 +422,7 @@  -- How to make compound effects -type MyHandle = Compound (State Int) (Exception String)+type MyHandle = Compound (Modify Int) (Throw String)  myInc :: (e <: es) => MyHandle e -> Eff es () myInc h = withCompound h (\s _ -> modify s (+ 1))@@ -437,7 +437,7 @@   Eff es (Either String (a, Int)) runMyHandle f =   try $ \e -> do-    runState 0 $ \s -> do+    runModify 0 $ \s -> do       runCompound s e f  compoundExample :: Either String (a, Int)@@ -448,7 +448,7 @@  countExample :: IO () countExample = runEff_ $ \io -> do-  evalState @Int 0 $ \sn -> do+  evalModify @Int 0 $ \sn -> do     withJump $ \break -> forever $ do       n <- get sn       when (n >= 10) (jumpTo break)@@ -486,8 +486,8 @@  incrementReadLine ::   (e1 <: es, e2 <: es, e3 <: es) =>-  State Int e1 ->-  Exception String e2 ->+  Modify Int e1 ->+  Throw String e2 ->   IOE e3 ->   Eff es () incrementReadLine state exception io = do@@ -507,13 +507,13 @@ runIncrementReadLine :: IO (Either String Int) runIncrementReadLine = runEff_ $ \io -> do   try $ \exception -> do-    ((), r) <- runState 0 $ \state -> do+    ((), r) <- runModify 0 $ \state -> do       incrementReadLine state exception io     pure r  -- Counter 1 -newtype Counter1 e = MkCounter1 (State Int e)+newtype Counter1 e = MkCounter1 (Modify Int e)  incCounter1 :: (e <: es) => Counter1 e -> Eff es () incCounter1 (MkCounter1 st) = modify st (+ 1)@@ -522,7 +522,7 @@   (forall e. Counter1 e -> Eff (e :& es) r) ->   Eff es Int runCounter1 k =-  evalState 0 $ \st -> do+  evalModify 0 $ \st -> do     _ <- k (MkCounter1 st)     get st @@ -537,7 +537,7 @@  -- Counter 2 -data Counter2 e1 e2 = MkCounter2 (State Int e1) (Exception () e2)+data Counter2 e1 e2 = MkCounter2 (Modify Int e1) (Throw () e2)  incCounter2 :: (e1 <: es, e2 <: es) => Counter2 e1 e2 -> Eff es () incCounter2 (MkCounter2 st ex) = do@@ -550,7 +550,7 @@   (forall e1 e2. Counter2 e1 e2 -> Eff (e2 :& e1 :& es) r) ->   Eff es Int runCounter2 k =-  evalState 0 $ \st -> do+  evalModify 0 $ \st -> do     _ <- try $ \ex -> do       k (MkCounter2 st ex)     get st@@ -565,7 +565,7 @@  -- Counter 3 -data Counter3 e = MkCounter3 (State Int e) (Exception () e)+data Counter3 e = MkCounter3 (Modify Int e) (Throw () e)  incCounter3 :: (e <: es) => Counter3 e -> Eff es () incCounter3 (MkCounter3 st ex) = do@@ -578,7 +578,7 @@   (forall e. Counter3 e -> Eff (e :& es) r) ->   Eff es Int runCounter3 k =-  evalState 0 $ \st -> do+  evalModify 0 $ \st -> do     _ <- try $ \ex -> do       useImplIn k (MkCounter3 (mapHandle st) (mapHandle ex))     get st@@ -620,7 +620,7 @@ -- Counter 4  data Counter4 e-  = MkCounter4 (State Int e) (Exception () e) (Stream String e)+  = MkCounter4 (Modify Int e) (Throw () e) (Stream String e)  incCounter4 :: (e <: es) => Counter4 e -> Eff es () incCounter4 (MkCounter4 st ex y) = do@@ -645,7 +645,7 @@   (forall e. Counter4 e -> Eff (e :& es) r) ->   Eff es Int runCounter4 y k =-  evalState 0 $ \st -> do+  evalModify 0 $ \st -> do     _ <- try $ \ex -> do       useImplIn k (MkCounter4 (mapHandle st) (mapHandle ex) (mapHandle y))     get st@@ -686,7 +686,7 @@   (forall e. Counter5 e -> Eff (e :& es) r) ->   Eff es Int runCounter5 y k =-  evalState 0 $ \st -> do+  evalModify 0 $ \st -> do     _ <- try $ \ex -> do       useImplIn         k@@ -724,7 +724,7 @@  data Counter6 e = MkCounter6   { incCounter6Impl :: Eff e (),-    counter6State :: State Int e,+    counter6Modify :: Modify Int e,     counter6Stream :: Stream String e   }   deriving (Generic)@@ -747,7 +747,7 @@   (forall e. Counter6 e -> Eff (e :& es) r) ->   Eff es Int runCounter6 y k =-  evalState 0 $ \st -> do+  evalModify 0 $ \st -> do     _ <- try $ \ex -> do       useImplIn         k@@ -762,7 +762,7 @@                   throw ex ()                  put st (count + 1),-              counter6State = mapHandle st,+              counter6Modify = mapHandle st,               counter6Stream = mapHandle y             }         )@@ -783,8 +783,8 @@ -- Counter 7  data Counter7 e = MkCounter7-  { incCounter7Impl :: forall e'. Exception () e' -> Eff (e' :& e) (),-    counter7State :: State Int e,+  { incCounter7Impl :: forall e'. Throw () e' -> Eff (e' :& e) (),+    counter7Modify :: Modify Int e,     counter7Stream :: Stream String e   }   deriving (Handle) via OneWayCoercibleHandle Counter7@@ -796,12 +796,12 @@   oneWayCoercibleImpl = oneWayCoercibleTrustMe $ \c ->     MkCounter7       { incCounter7Impl = \ex -> useImplUnder (incCounter7Impl c ex),-        counter7State = mapHandle (counter7State c),+        counter7Modify = mapHandle (counter7Modify c),         counter7Stream = mapHandle (counter7Stream c)       }  incCounter7 ::-  (e <: es, e1 <: es) => Counter7 e -> Exception () e1 -> Eff es ()+  (e <: es, e1 <: es) => Counter7 e -> Throw () e1 -> Eff es () incCounter7 e ex = makeOp (incCounter7Impl (mapHandle e) (mapHandle ex))  getCounter7 :: (e <: es) => Counter7 e -> String -> Eff es Int@@ -815,7 +815,7 @@   (forall e. Counter7 e -> Eff (e :& es) r) ->   Eff es Int runCounter7 y k =-  evalState 0 $ \st -> do+  evalModify 0 $ \st -> do     _ <-       useImplIn         k@@ -830,7 +830,7 @@                   throw ex ()                  put st (count + 1),-              counter7State = mapHandle st,+              counter7Modify = mapHandle st,               counter7Stream = mapHandle y             }         )@@ -879,12 +879,12 @@  runFileSystemPure ::   (e1 <: es) =>-  Exception String e1 ->+  Throw String e1 ->   [(FilePath, String)] ->   (forall e2. FileSystem e2 -> Eff (e2 :& es) r) ->   Eff es r runFileSystemPure ex fs0 k =-  evalState fs0 $ \fs ->+  evalModify fs0 $ \fs ->     useImplIn       k       MkFileSystem@@ -901,7 +901,7 @@ runFileSystemIO ::   forall e1 e2 es r.   (e1 <: es, e2 <: es) =>-  Exception String e1 ->+  Throw String e1 ->   IOE e2 ->   (forall e. FileSystem e -> Eff (e :& es) r) ->   Eff es r@@ -948,7 +948,7 @@  data Application e = MkApplication   { queryDatabase :: String -> Int -> Eff e [String],-    applicationState :: State (Int, Bool) e,+    applicationModify :: Modify (Int, Bool) e,     logger :: Stream String e   }   deriving (Generic)@@ -962,7 +962,7 @@ -- set of effects that includes exceptions. polymorphicBracket ::   (st <: es) =>-  State (Integer, Bool) st ->+  Modify (Integer, Bool) st ->   Eff es () ->   Eff es () polymorphicBracket st act =@@ -977,14 +977,14 @@ polymorphicBracketExample1 :: (Integer, Bool) polymorphicBracketExample1 =   runPureEff $ do-    (_res, st) <- runState (0, False) $ \st -> polymorphicBracket st (pure ())+    (_res, st) <- runModify (0, False) $ \st -> polymorphicBracket st (pure ())     pure st  -- Results in (0, True) polymorphicBracketExample2 :: (Integer, Bool) polymorphicBracketExample2 =   runPureEff $ do-    (_res, st) <- runState (0, False) $ \st -> try @Int $ \e -> polymorphicBracket st (throw e 42)+    (_res, st) <- runModify (0, False) $ \st -> try @Int $ \e -> polymorphicBracket st (throw e 42)     pure st  pipesExample1 :: IO ()@@ -1086,8 +1086,8 @@ -- (otherwise I guess it "commits to it too soon") example :: () example = runPureEff $-  evalState () $ \st1 ->-    evalState () $ \st2 -> do+  evalModify () $ \st1 ->+    evalModify () $ \st2 -> do       Proxy :: Proxy es <- effTag       satisfied @(es <: es) 

@@ -5,7 +5,22 @@  module Bluefin.Internal.Exception where -import Bluefin.Internal hiding (UnsafeMkEff, b)+import Bluefin.Internal+  ( Eff,+    Exception (..),+    Handle,+    OneWayCoercibleHandle (..),+    effIO,+    handleTag,+    makeOp,+    mapHandle,+    unsafeProvideIO,+    useImpl,+    useImplIn,+    withEffToIO_,+    (:&),+    type (<:),+  ) import Bluefin.Internal.CloneableHandle (app, (:~>)) import Bluefin.Internal.Exception.Scoped (InFlight) import Bluefin.Internal.Exception.Scoped qualified as SE@@ -60,17 +75,13 @@ -- @Applicative@-like functions that produce and combine them. newtype MakeExceptions r a h es   = MkMakeExceptions (Eff es (HandlerUnwrapped r a h es))+  deriving (Handle) via OneWayCoercibleHandle (MakeExceptions r a h)  data HandlerUnwrapped r a h es   = MkHandlerUnwrapped       [HandledKey (r -> Eff es a)]       (forall b. (forall e. h e -> Eff (e :& es) b) -> Eff es b)--instance (Handle h) => Handle (MakeExceptions r a h) where-  handleImpl = handleOneWayCoercible--instance (Handle h) => Handle (HandlerUnwrapped r a h) where-  handleImpl = handleOneWayCoercible+  deriving (Handle) via OneWayCoercibleHandle (HandlerUnwrapped r a h)  instance   (Handle h, e <: es) =>

@@ -20,6 +20,7 @@ import Data.Kind (Type)  type Send :: Effect -> Effects -> Type+ -- | Bring a 'Send' into scope with 'interpret'. newtype Send f e = MkSend (EffectHandler f e)   deriving (Handle) via OneWayCoercibleHandle (Send f)

@@ -122,13 +122,13 @@         MkOneWayCoercibleD (MkOneWayCoercion Coercion)  instance-  OneWayCoercible (h e) (h es) =>+  (OneWayCoercible (h e) (h es)) =>   OneWayCoercible (Rec1 h e) (Rec1 h es)   where   oneWayCoercibleImpl = gOneWayCoercible  instance-  OneWayCoercible (h e) (h es) =>+  (OneWayCoercible (h e) (h es)) =>   OneWayCoercible (M1 i t h e) (M1 i t h es)   where   oneWayCoercibleImpl = gOneWayCoercible@@ -136,4 +136,5 @@ instance   (OneWayCoercible (h1 e) (h1 es), OneWayCoercible (h2 e) (h2 es)) =>   OneWayCoercible ((h1 :*: h2) e) ((h1 :*: h2) es)-  where oneWayCoercibleImpl = gOneWayCoercible+  where+  oneWayCoercibleImpl = gOneWayCoercible

@@ -1,17 +1,31 @@+{-# LANGUAGE DerivingVia #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE DerivingVia #-}  module Bluefin.Internal.Prim where  import Bluefin.Internal+  ( Eff,+    Effects,+    Handle,+    HandleD (MkHandleD),+    OneWayCoercibleHandle,+    effIO,+    makeOp,+    unsafeProvideIO,+    (:&),+    type (<:),+  ) import Bluefin.Internal.OneWayCoercible+  ( OneWayCoercible (..),+    unsafeOneWayCoercible,+  ) import Control.Monad.Primitive qualified as P import GHC.Exts (State#) import Unsafe.Coerce (unsafeCoerce)  data Prim (e :: Effects) = UnsafeMkPrim-  deriving Handle via OneWayCoercibleHandle Prim+  deriving (Handle) via OneWayCoercibleHandle Prim  data PrimStateEff (es :: Effects) @@ -24,10 +38,19 @@   Eff es r runPrim k = makeOp (k UnsafeMkPrim) +type StateM s a = State# s -> (# State# s, a #)++unsafeCoerceStateM :: forall s1 s2 a. StateM s1 a -> StateM s2 a+unsafeCoerceStateM = unsafeCoerce+ primitive ::+  forall e1 es a.   (e1 <: es) =>   Prim e1 ->   (State# (PrimStateEff e1) -> (# State# (PrimStateEff e1), a #)) ->   -- | ͘   Eff es a-primitive UnsafeMkPrim = unsafeCoerce (P.primitive @IO)+primitive UnsafeMkPrim k = unsafeProvideIO $ \io ->+  effIO+    io+    (P.primitive @IO (unsafeCoerceStateM @(PrimStateEff e1) @P.RealWorld k))

@@ -38,6 +38,7 @@     test_localInHandler y     test_generalBracket io y     test_streamConsumeReader y+    test_streamConsumeHandleReader y  (!?) :: [a] -> Int -> Maybe a xs !? i = runPureEff $@@ -131,3 +132,27 @@                 local r (subtract 100) $ do                   forever p       )++-- This test confirms the buggy behavior reported in+--+--    https://github.com/tomjaguarpaw/bluefin/issues/98+test_streamConsumeHandleReader :: (e <: es) => SpecH e -> Eff es ()+test_streamConsumeHandleReader spech = do+  runConstEffect @Int 0 $ \ce ->+    runHandleReader ce $ \r -> do+      streamConsume+        ( \y -> do+            let s = yield y ()+            let check i = do+                  MkConstEffect i' <- askHandle r+                  assertEqual spech "HandleReader local" i i'+            check 0+            s+            check (-100) -- Should be 0+        )+        ( \a -> do+            let p = await a+            p+            localHandle r (\(MkConstEffect i) -> MkConstEffect (subtract 100 i)) $ do+              forever p+        )

@@ -1,9 +1,9 @@ module Test.SpecH where -import System.Exit (ExitCode (ExitFailure), exitWith) import Bluefin.Internal import Bluefin.Internal.DslBuilder import Data.Monoid (All (All))+import System.Exit (ExitCode (ExitFailure), exitWith)  -- A SpecH yields pairs of --