bluefin-internal 0.6.0.0 → 0.8.0.0
raw patch · 8 files changed
Files
- CHANGELOG.md +14/−0
- bluefin-internal.cabal +5/−3
- src/Bluefin/Internal.hs +81/−62
- src/Bluefin/Internal/CloneableHandle.hs +9/−9
- src/Bluefin/Internal/Examples.hs +4/−1083
- src/Bluefin/Internal/Pipes.hs +3/−3
- src/Bluefin/Internal/Vault.hs +37/−0
- test/Main.hs +36/−17
CHANGELOG.md view
@@ -1,3 +1,17 @@+# 0.8.0.0++* Restrict `Reader` type tag to `Effects`++* Move most of `Bluefin.Internal.Examples`, `zipCoroutines` and+ `mapStream` to `Bluefin.Examples`++# 0.7.0.0++* Fix `Reader` bug that caused incorrect scoping in+ `awaitYield`/`connectRequests`/`streamConsume`/`connectCoroutines`++ <https://github.com/tomjaguarpaw/bluefin/issues/98>+ # 0.6.0.0 * Changed type of `runEff` to match `runEff_`
bluefin-internal.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: bluefin-internal-version: 0.6.0.0+version: 0.8.0.0 license: MIT license-file: LICENSE author: Tom Ellis@@ -82,7 +82,8 @@ primitive >= 0.8 && < 0.10, transformers < 0.7, transformers-base < 0.5,- monad-control < 1.1+ monad-control < 1.1,+ vault >= 0.3 && < 0.4 exposed-modules: Bluefin.Internal, Bluefin.Internal.CloneableHandle,@@ -97,7 +98,8 @@ Bluefin.Internal.OneWayCoercible, Bluefin.Internal.Pipes, Bluefin.Internal.Prim,- Bluefin.Internal.System.IO+ Bluefin.Internal.System.IO,+ Bluefin.Internal.Vault test-suite bluefin-test import: defaults
src/Bluefin/Internal.hs view
@@ -16,11 +16,16 @@ import Bluefin.Internal.OneWayCoercible ( OneWayCoercible (oneWayCoercibleImpl), OneWayCoercibleD,+ OneWayCoercion, gOneWayCoercible, oneWayCoerce, oneWayCoercible,+ oneWayCoercion,+ unsafeCoercionOfOneWayCoercion, unsafeOneWayCoercible, )+import Bluefin.Internal.Vault (Vault)+import Bluefin.Internal.Vault qualified as Vault import Control.Concurrent.Async qualified as Async import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) import Control.Exception qualified@@ -30,10 +35,11 @@ import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.IO.Unlift (MonadUnliftIO, withRunInIO) import Control.Monad.Trans.Control (MonadBaseControl, StM, liftBaseWith, restoreM)+import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Reader qualified as Reader import Data.Coerce (coerce) import Data.Foldable (for_)-import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.IORef (IORef, modifyIORef, newIORef, readIORef, writeIORef) import Data.Kind (Type) import Data.Proxy (Proxy (Proxy)) import Data.Type.Coercion (Coercion (Coercion))@@ -55,14 +61,16 @@ type (:&) = Union -newtype Eff (es :: Effects) a = UnsafeMkEff {unsafeUnEff :: IO a}+type Env = IORef Vault++newtype Eff (es :: Effects) a = UnsafeMkEff {unsafeUnEff :: Env -> IO a} deriving stock (Functor)- deriving newtype (Applicative, Monad, MonadFix)+ deriving (Applicative, Monad, MonadFix) via ReaderT Env IO type role Eff nominal representational instance (e <: es) => OneWayCoercible (Eff e) (Eff es) where- oneWayCoercibleImpl = oneWayCoercible+ oneWayCoercibleImpl = unsafeOneWayCoercible instance (e <: es) => OneWayCoercible (Eff e r) (Eff es r) where oneWayCoercibleImpl = oneWayCoercible@@ -89,7 +97,7 @@ ((forall r. (forall e1. IOE e1 -> Eff (e1 :& es) r) -> IO r) -> IO a) -> IOE e2 -> Eff es a-withEffToIO k io = effIO io (k (\f -> unsafeUnEff (f io)))+withEffToIO k io = UnsafeMkEff (\env -> k (\f -> unsafeUnEff (f io) env)) withEffToIO' :: (e2 <: es) =>@@ -142,15 +150,24 @@ Eff es a race x y io = do r <- withEffToIO' io $ \toIO ->- Async.race (toIO x) (toIO y)+ Async.race (toIO (withClonedEnv . x)) (toIO (withClonedEnv . y)) pure $ case r of Left a -> a Right a -> a +withClonedEnv :: Eff es r -> Eff es r+withClonedEnv m = UnsafeMkEff $ \vault -> do+ vault' <- cloneIORef vault+ case m of UnsafeMkEff m' -> m' vault'+ where+ cloneIORef ref = do+ orig <- readIORef ref+ newIORef orig+ -- | Connect two coroutines. Their execution is interleaved by--- exchanging @a@s and @b@s. When the first yields its first @a@ it--- starts the second (which is awaiting an @a@).+-- exchanging @a@s and @b@s. When the former yields its first @a@ it+-- starts the latter (which is awaiting an @a@). connectCoroutines :: forall es a b r. (forall e. Coroutine a b e -> Eff (e :& es) r) ->@@ -200,24 +217,6 @@ Eff es r streamConsume s c = consumeStream c s -zipCoroutines ::- (e1 <: es) =>- Coroutine (a1, a2) b e1 ->- (forall e. Coroutine a1 b e -> Eff (e :& es) r) ->- (forall e. Coroutine a2 b e -> Eff (e :& es) r) ->- -- | ͘- Eff es r-zipCoroutines c m1 m2 = do- connectCoroutines m1 $ \a1 c1 -> do- connectCoroutines (useImplUnder . m2) $ \a2 c2 -> do- evalState (a1, a2) $ \ass -> do- forever $ do- as <- get ass- b' <- yieldCoroutine c as- a1' <- yieldCoroutine c1 b'- a2' <- yieldCoroutine c2 b'- put ass (a1', a2')- instance (e <: es) => MonadBase IO (EffReader (IOE e) es) where liftBase = liftIO @@ -1347,16 +1346,6 @@ as <- get s pure (as, r) -mapStream ::- (e2 <: es) =>- -- | Apply this function to all elements of the input stream.- (a -> b) ->- -- | Input stream- (forall e1. Stream a e1 -> Eff (e1 :& es) r) ->- Stream b e2 ->- Eff es r-mapStream f = mapMaybe (Just . f)- mapMaybe :: (e2 <: es) => -- | Yield from the output stream all of the elemnts of the input@@ -1491,7 +1480,7 @@ IO a -> -- | ͘ Eff es a-effIO MkIOE = UnsafeMkEff+effIO MkIOE = UnsafeMkEff . const -- | Run an 'Eff' whose only unhandled effect is 'IO'. --@@ -1520,7 +1509,9 @@ (forall e. IOE e -> Eff e a) -> -- | ͘ IO a-runEff_ eff = unsafeUnEff (eff MkIOE)+runEff_ eff = do+ emptyEnv <- newIORef Vault.empty+ unsafeUnEff (eff MkIOE) emptyEnv unsafeProvideIO :: (forall e. IOE e -> Eff (e :& es) a) ->@@ -1616,18 +1607,27 @@ Eff es () tell (Writer y) = yield y -newtype Reader r e = MkReader (State r e)- deriving newtype (Handle)+type Reader :: Type -> Effects -> Type +newtype Reader r e = MkReader (Vault.Key r)+ deriving (Handle) via OneWayCoercibleHandle (Reader r)+ instance (e <: es) => OneWayCoercible (Reader r e) (Reader r es) where oneWayCoercibleImpl = oneWayCoercible +type role Reader representational nominal+ runReader :: -- | Initial value for @Reader@. r -> (forall e. Reader r e -> Eff (e :& es) a) -> Eff es a-runReader r f = evalState r (f . MkReader)+runReader r f = do+ k <- UnsafeMkEff $ \vault -> do+ k <- Vault.newKey+ modifyIORef vault (\v -> Vault.insert k r v)+ pure k+ makeOp (f (MkReader k)) -- | Read the value. Note that @ask@ has the property that these two -- operations are always equivalent:@@ -1649,7 +1649,22 @@ -- | ͘ Reader r e -> Eff es r-ask (MkReader st) = get st+ask (MkReader k) = UnsafeMkEff $ \vault -> do+ v <- readIORef vault+ case Vault.lookup k v of+ Nothing -> error msg+ Just ref -> pure ref+ where+ msg =+ unlines+ [ "ask called on out of scope reference",+ unwords+ [ "If you haven't subverted Bluefin's type system",+ "then this is a Bluefin bug.",+ "Please report it at",+ "https://github.com/tomjaguarpaw/bluefin/issues/new"+ ]+ ] -- | Read the value modified by a function asks ::@@ -1658,7 +1673,7 @@ -- | Read the value modified by this function (r -> a) -> Eff es a-asks (MkReader st) f = fmap f (get st)+asks r f = fmap f (ask r) -- | Locally override the value in the @Reader@. It will be restored -- when the @local@ block ends.@@ -1670,14 +1685,14 @@ -- | Body Eff es a -> Eff es a-local (MkReader st) f k = do- orig <- get st- bracket- (put st (f orig))- (\() -> put st orig)- (\() -> k)+local (MkReader key) f k = UnsafeMkEff $ \env@vault -> do+ orig <- readIORef vault+ Control.Exception.bracket+ (writeIORef vault (Vault.adjust f key orig))+ (\() -> writeIORef vault orig)+ (\() -> case k of UnsafeMkEff m -> m env) -newtype HandleReader h e = UnsafeMkHandleReader (State (h e) e)+newtype HandleReader h e = UnsafeMkHandleReader (Reader (h e) e) deriving (Handle) via OneWayCoercibleHandle (HandleReader h) -- In general this is really tremendously unsafe because we could take@@ -1695,8 +1710,12 @@ HandleReader h es mapHandleReader = case coerceH of Coercion -> coerce where+ oneWayCoerceH :: OneWayCoercion (h e) (h es)+ oneWayCoerceH = case handleDictOfHandleD (handleImpl @h) of+ MkHandleDict -> oneWayCoercion+ coerceH :: Coercion (h e) (h es)- coerceH = unsafeCoerce (Coercion :: Coercion (h e) (h e))+ coerceH = unsafeCoercionOfOneWayCoercion oneWayCoerceH localHandle :: (e <: es, Handle h) =>@@ -1705,20 +1724,16 @@ Eff es r -> -- | ͘ Eff es r-localHandle hh@(UnsafeMkHandleReader st) f k = do- let UnsafeMkHandleReader st' = mapHandle hh- orig <- get st- bracket- (put st' (f (mapHandle orig)))- (\() -> put st orig)- (\() -> k)+localHandle hh f k = do+ let UnsafeMkHandleReader st = mapHandle hh+ local st f k askHandle :: (e <: es, Handle h) => HandleReader h e -> -- | ͘ Eff es (h es)-askHandle hh = let UnsafeMkHandleReader st = mapHandle hh in get st+askHandle hh = let UnsafeMkHandleReader st = mapHandle hh in ask st asksHandle :: (e1 <: es, Handle h) =>@@ -1737,11 +1752,15 @@ -- | ͘ Eff es r runHandleReader h k = do- evalState (mapHandle h) $ \(st :: State (h es) e) -> do+ runReader (mapHandle h) $ \(st :: Reader (h es) e) -> do+ let oneWayCoerceH :: OneWayCoercion (h es) (h (e :& es))+ oneWayCoerceH = case handleDictOfHandleD (handleImpl @h) of+ MkHandleDict -> oneWayCoercion+ let coerceH :: Coercion (h es) (h (e :& es))- coerceH = unsafeCoerce (Coercion :: Coercion (h es) (h es))+ coerceH = unsafeCoercionOfOneWayCoercion oneWayCoerceH - let mapS :: State (h es) e' -> State (h (e :& es)) e'+ let mapS :: Reader (h es) e' -> Reader (h (e :& es)) e' mapS = case coerceH of Coercion -> coerce let h' :: HandleReader h (e :& es)
src/Bluefin/Internal/CloneableHandle.hs view
@@ -34,12 +34,13 @@ ((forall r. (forall e. IOE e -> h e -> Eff e r) -> IO r) -> IO a) -> Eff es a withEffToIOCloneHandle io h k = do- withEffToIO_ io $ \runInIO -> do- k $ \body -> do- runInIO $ do- cloneHandleClass h $ \h' -> do- cloneHandleClass io $ \io' -> do- body (mapHandle io') (mapHandle h')+ withClonedEnv $ do+ withEffToIO_ io $ \runInIO -> do+ k $ \body -> do+ runInIO $ do+ cloneHandleClass h $ \h' -> do+ cloneHandleClass io $ \io' -> do+ body (mapHandle io') (mapHandle h') newtype HandleCloner h1 h2 es = MkHandleCloner@@ -98,9 +99,8 @@ cloneableHandleImpl = MkCloneableHandleD hcReader hcReader :: HandleCloner (Reader r) (Reader r) e-hcReader = MkHandleCloner $ \(MkReader s) k -> do- cloneHandleClass s $ \s' -> do- useImplIn k (MkReader (mapHandle s'))+hcReader = MkHandleCloner $ \r k -> do+ useImplIn k (mapHandle r) -- | Cloning a @HandleReader@ copies its contents to a new -- @HandleReader@. Changes to one will not effect the other.
src/Bluefin/Internal/Examples.hs view
@@ -1,1086 +1,7 @@-{-# LANGUAGE DerivingVia #-}-{-# LANGUAGE NoMonoLocalBinds #-}-{-# LANGUAGE NoMonomorphismRestriction #-}--module Bluefin.Internal.Examples where--import Bluefin.Internal hiding (b, w)-import Bluefin.Internal.OneWayCoercible-import Bluefin.Internal.Pipes- ( Producer,- runEffect,- stdinLn,- stdoutLn,- takeWhile',- (>->),- )-import Bluefin.Internal.Pipes qualified as P-import Control.Exception (IOException)-import Control.Exception qualified-import Control.Monad (forever, replicateM_, unless, when)-import Control.Monad.IO.Class (liftIO)-import Data.Foldable (for_)-import Data.Monoid (Any (Any, getAny))-import Data.Proxy (Proxy (Proxy))-import Text.Read (readMaybe)-import Prelude hiding- ( break,- drop,- head,- read,- readFile,- return,- writeFile,- )-import Prelude qualified--monadIOExample :: IO ()-monadIOExample = runEff $ \io -> withMonadIO io $ liftIO $ do- name <- readLn- putStrLn ("Hello " ++ name)--monadFailExample :: Either String ()-monadFailExample = runPureEff $ try $ \e ->- when ((2 :: Int) > 1) $- withMonadFail e (fail "2 was bigger than 1")--throwExample :: Either Int String-throwExample = runPureEff $ try $ \e -> do- _ <- throw e 42- pure "No exception thrown"--handleExample :: String-handleExample = runPureEff $ handle (pure . show) $ \e -> do- _ <- throw e (42 :: Int)- pure "No exception thrown"--exampleGet :: (Int, Int)-exampleGet = runPureEff $ runModify 10 $ \st -> do- n <- get st- pure (2 * n)--examplePut :: ((), Int)-examplePut = runPureEff $ runModify 10 $ \st -> do- put st 30--exampleModify :: ((), Int)-exampleModify = runPureEff $ runModify 10 $ \st -> do- modify st (* 2)--yieldExample :: ([Int], ())-yieldExample = runPureEff $ yieldToList $ \y -> do- yield y 1- yield y 2- yield y 100--withYieldToListExample :: Int-withYieldToListExample = runPureEff $ withYieldToList @Int $ \y -> do- yield y 1- yield y 2- yield y 100- pure length---- This shows we can use forEach at any level of nesting with--- insertManySecond-doubleNestedForEach ::- (forall e. Stream () e -> Eff (e :& es) ()) ->- Eff es ()-doubleNestedForEach f =- withModify () $ \_ -> do- withModify () $ \_ -> do- forEach (insertManySecond . f) (\_ -> pure ())- pure (\_ _ -> ())--forEachExample :: ([Int], ())-forEachExample = runPureEff $ yieldToList $ \y -> do- forEach (inFoldable [0 .. 4]) $ \i -> do- yield y i- yield y (i * 10)--ignoreStreamExample :: Int-ignoreStreamExample = runPureEff $ ignoreStream @Int $ \y -> do- for_ [0 .. 4] $ \i -> do- yield y i- yield y (i * 10)-- pure 42---- ([1,2,3,1,2,3],())-cycleToStreamExample :: ([Int], ())-cycleToStreamExample = runPureEff $ yieldToList $ \yOut -> do- consumeStream- (\c -> takeConsume 6 c yOut)- (\yIn -> cycleToStream [1 .. 3] yIn)---- ([1,2,3,4],())-takeConsumeExample :: ([Int], ())-takeConsumeExample = runPureEff $ yieldToList $ \yOut -> do- consumeStream- (\c -> takeConsume 4 c yOut)- (\yIn -> inFoldable [1 .. 10] yIn)--inFoldableExample :: ([Int], ())-inFoldableExample = runPureEff $ yieldToList $ inFoldable [1, 2, 100]--enumerateExample :: ([(Int, String)], ())-enumerateExample = runPureEff $ yieldToList $ enumerate (inFoldable ["A", "B", "C"])--returnEarlyExample :: String-returnEarlyExample = runPureEff $ withEarlyReturn $ \e -> do- for_ [1 :: Int .. 10] $ \i -> do- when (i >= 5) $- returnEarly e ("Returned early with " ++ show i)- pure "End of loop"--effIOExample :: IO ()-effIOExample = runEff $ \io -> do- effIO io (putStrLn "Hello world!")--example1_ :: (Int, Int)-example1_ =- let example1 :: Int -> Int- example1 n = runPureEff $ evalModify n $ \st -> do- n' <- get st- when (n' < 10) $- put st (n' + 10)- get st- in (example1 5, example1 12)--example2_ :: ((Int, Int), (Int, Int))-example2_ =- let example2 :: (Int, Int) -> (Int, Int)- example2 (m, n) = runPureEff $- evalModify m $ \sm -> do- evalModify n $ \sn -> do- do- n' <- get sn- m' <- get sm-- if n' < m'- then put sn (n' + 10)- else put sm (m' + 10)-- n' <- get sn- m' <- get sm-- pure (n', m')- in (example2 (5, 10), example2 (12, 5))--example3' :: Int -> Either String Int-example3' n = runPureEff $- try $ \ex -> do- evalModify 0 $ \total -> do- for_ [1 .. n] $ \i -> do- soFar <- get total- when (soFar > 20) $ do- throw ex ("Became too big: " ++ show soFar)- put total (soFar + i)-- get total---- Count non-empty lines from stdin, and print a friendly message,--- until we see "STOP".-example3_ :: IO ()-example3_ = runEff $ \io -> do- let getLineUntilStop y = withJump $ \stop -> forever $ do- line <- effIO io getLine- when (line == "STOP") $- jumpTo stop- yield y line-- nonEmptyLines =- mapMaybe- ( \case- "" -> Nothing- line -> Just line- )- getLineUntilStop-- enumeratedLines = enumerateFrom 1 nonEmptyLines-- formattedLines =- mapStream- (\(i, line) -> show i ++ ". Hello! You said " ++ line)- enumeratedLines-- forEach formattedLines $ \line -> effIO io (putStrLn line)--awaitList ::- (e <: es) =>- [a] ->- IOE e ->- (forall e1. Consume a e1 -> Eff (e1 :& es) ()) ->- Eff es ()-awaitList l io k = evalModify l $ \s -> do- withJump $ \done ->- bracket- (pure ())- (\() -> effIO io (putStrLn "Released"))- $ \() -> do- consumeEach (useImplUnder . k) $ do- (x, xs) <-- get s >>= \case- [] -> jumpTo done- x : xs -> pure (x, xs)- put s xs- pure x--takeRec ::- (e3 <: es) =>- Int ->- (forall e. Consume a e -> Eff (e :& es) ()) ->- Consume a e3 ->- Eff es ()-takeRec n k rec =- withJump $ \done -> evalModify n $ \s -> consumeEach (useImplUnder . k) $ do- s' <- get s- if s' <= 0- then jumpTo done- else do- modify s (subtract 1)- await rec--mapRec ::- (e <: es) =>- (a -> b) ->- (forall e1. Consume b e1 -> Eff (e1 :& es) ()) ->- Consume a e ->- Eff es ()-mapRec f = traverseRec (pure . f)--traverseRec ::- (e <: es) =>- (a -> Eff es b) ->- (forall e1. Consume b e1 -> Eff (e1 :& es) ()) ->- Consume a e ->- Eff es ()-traverseRec f k rec = forEach k $ \() -> do- r <- await rec- f r--awaitUsage ::- (e1 <: es, e2 <: es) =>- IOE e1 ->- (forall e. Consume () e -> Eff (e :& es) ()) ->- Consume Int e2 ->- Eff es ()-awaitUsage io x = do- mapRec (* 11) $- mapRec (subtract 1) $- takeRec 3 $- traverseRec (effIO io . print) $- useImplUnder . x--awaitExample :: IO ()-awaitExample = runEff $ \io -> do- awaitList [1 :: Int ..] io $ awaitUsage io $ \rec -> do- replicateM_ 5 (await rec)--consumeStreamExample :: IO (Either String String)-consumeStreamExample = runEff $ \io -> do- try $ \ex -> do- consumeStream- ( \r ->- bracket- (effIO io (putStrLn "Starting 2"))- (\_ -> effIO io (putStrLn "Leaving 2"))- $ \_ -> do- for_ [1 :: Int .. 100] $ \n -> do- b <- await r- effIO- io- ( putStrLn- ("Consumed body " ++ show b ++ " at time " ++ show n)- )- pure "Consumer finished first"- )- ( \y -> bracket- (effIO io (putStrLn "Starting 1"))- (\_ -> effIO io (putStrLn "Leaving 1"))- $ \_ -> do- for_ [1 :: Int .. 10] $ \n -> do- effIO io (putStrLn ("Sending " ++ show n))- yield y n- when (n > 5) $ do- effIO io (putStrLn "Aborting...")- throw ex "Aborted"-- pure "Yielder finished first"- )--consumeStreamExample2 :: IO ()-consumeStreamExample2 = runEff $ \io -> do- let counter yeven yodd = for_ [0 :: Int .. 10] $ \i -> do- if even i- then yield yeven i- else yield yodd i-- let foo yeven =- consumeStream- ( \r -> forever $ do- i <- await r- effIO io (putStrLn ("Odd: " ++ show i))- )- (counter yeven)-- let bar =- consumeStream- ( \r -> forever $ do- i <- await r- effIO io (putStrLn ("Even: " ++ show i))- )- foo-- bar--connectExample :: IO (Either String String)-connectExample = runEff $ \io -> do- try $ \ex -> do- connectCoroutines- ( \y -> bracket- (effIO io (putStrLn "Starting 1"))- (\_ -> effIO io (putStrLn "Leaving 1"))- $ \_ -> do- for_ [1 :: Int .. 10] $ \n -> do- effIO io (putStrLn ("Sending " ++ show n))- yield y n- when (n > 5) $ do- effIO io (putStrLn "Aborting...")- throw ex "Aborted"-- pure "Yielder finished first"- )- ( \binit r ->- bracket- (effIO io (putStrLn "Starting 2"))- (\_ -> effIO io (putStrLn "Leaving 2"))- $ \_ -> do- effIO io (putStrLn ("Consumed intial " ++ show binit))- for_ [1 :: Int .. 100] $ \n -> do- b <- await r- effIO- io- ( putStrLn- ("Consumed body " ++ show b ++ " at time " ++ show n)- )- pure "Consumer finished first"- )--zipCoroutinesExample :: IO ()-zipCoroutinesExample = runEff $ \io -> do- let m1 y = do- r <- yieldCoroutine y 1- evalModify r $ \rs -> do- for_ [1 .. 10 :: Int] $ \i -> do- r' <- get rs- r'' <- yieldCoroutine y (r' + i)- put rs r''-- let m2 y = do- r <- yieldCoroutine y 1- evalModify r $ \rs -> do- for_ [1 .. 5 :: Int] $ \i -> do- r' <- get rs- r'' <- yieldCoroutine y (r' - i)- put rs r''-- forEach (\c -> zipCoroutines c m1 m2) $ \i@(i1, i2) -> do- effIO io (print i)- pure (i1 + i2)---- Count the number of (strictly) positives and (strictly) negatives--- in a list, unless we see a zero, in which case we bail with an--- error message.-countPositivesNegatives :: [Int] -> String-countPositivesNegatives is = runPureEff $- evalModify (0 :: Int) $ \positives -> do- r <- try $ \ex ->- evalModify (0 :: Int) $ \negatives -> do- for_ is $ \i -> do- case compare i 0 of- GT -> modify positives (+ 1)- EQ -> throw ex ()- LT -> modify negatives (+ 1)-- p <- get positives- n <- get negatives-- pure $- "Positives: "- ++ show p- ++ ", negatives "- ++ show n-- case r of- Right r' -> pure r'- Left () -> do- p <- get positives- pure $- "We saw a zero, but before that there were "- ++ show p- ++ " positives"---- How to make compound effects--type MyHandle = Compound (Modify Int) (Throw String)--myInc :: (e <: es) => MyHandle e -> Eff es ()-myInc h = withCompound h (\s _ -> modify s (+ 1))--myBail :: (e <: es) => MyHandle e -> Eff es r-myBail h = withCompound h $ \s e -> do- i <- get s- throw e ("Current state was: " ++ show i)--runMyHandle ::- (forall e. MyHandle e -> Eff (e :& es) a) ->- Eff es (Either String (a, Int))-runMyHandle f =- try $ \e -> do- runModify 0 $ \s -> do- runCompound s e f--compoundExample :: Either String (a, Int)-compoundExample = runPureEff $ runMyHandle $ \h -> do- myInc h- myInc h- myBail h--countExample :: IO ()-countExample = runEff $ \io -> do- evalModify @Int 0 $ \sn -> do- withJump $ \break -> forever $ do- n <- get sn- when (n >= 10) (jumpTo break)- effIO io (print n)- modify sn (+ 1)--writerExample1 :: Bool-writerExample1 = getAny $ runPureEff $ execWriter $ \w -> do- for_ [] $ \_ -> tell w (Any True)--writerExample2 :: Bool-writerExample2 = getAny $ runPureEff $ execWriter $ \w -> do- for_ [1 :: Int .. 10] $ \_ -> tell w (Any True)--while :: Eff es Bool -> Eff es a -> Eff es ()-while condM body =- withJump $ \break_ -> do- forever $ do- cond <- insertFirst condM- unless cond (jumpTo break_)- insertFirst body--stateSourceExample :: Int-stateSourceExample = runPureEff $ withStateSource $ \source -> do- n <- newState source 5- total <- newState source 0-- withJump $ \done -> forever $ do- n' <- get n- modify total (+ n')- when (n' == 0) $ jumpTo done- modify n (subtract 1)-- get total--incrementReadLine ::- (e1 <: es, e2 <: es, e3 <: es) =>- Modify Int e1 ->- Throw String e2 ->- IOE e3 ->- Eff es ()-incrementReadLine state exception io = do- withJump $ \break -> forever $ do- line <- effIO io getLine- i <- case readMaybe line of- Nothing ->- throw exception ("Couldn't read: " ++ line)- Just i ->- pure i-- when (i == 0) $- jumpTo break-- modify state (+ i)--runIncrementReadLine :: IO (Either String Int)-runIncrementReadLine = runEff $ \io -> do- try $ \exception -> do- ((), r) <- runModify 0 $ \state -> do- incrementReadLine state exception io- pure r---- Counter 1--newtype Counter1 e = MkCounter1 (Modify Int e)--incCounter1 :: (e <: es) => Counter1 e -> Eff es ()-incCounter1 (MkCounter1 st) = modify st (+ 1)--runCounter1 ::- (forall e. Counter1 e -> Eff (e :& es) r) ->- Eff es Int-runCounter1 k =- evalModify 0 $ \st -> do- _ <- k (MkCounter1 st)- get st--exampleCounter1 :: Int-exampleCounter1 = runPureEff $ runCounter1 $ \c -> do- incCounter1 c- incCounter1 c- incCounter1 c---- > exampleCounter1--- 3---- Counter 2--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- count <- get st- when (count >= 10) $- throw ex ()- put st (count + 1)--runCounter2 ::- (forall e1 e2. Counter2 e1 e2 -> Eff (e2 :& e1 :& es) r) ->- Eff es Int-runCounter2 k =- evalModify 0 $ \st -> do- _ <- try $ \ex -> do- k (MkCounter2 st ex)- get st--exampleCounter2 :: Int-exampleCounter2 = runPureEff $ runCounter2 $ \c ->- forever $- incCounter2 c---- > exampleCounter2--- 10---- Counter 3--data Counter3 e = MkCounter3 (Modify Int e) (Throw () e)--incCounter3 :: (e <: es) => Counter3 e -> Eff es ()-incCounter3 (MkCounter3 st ex) = do- count <- get st- when (count >= 10) $- throw ex ()- put st (count + 1)--runCounter3 ::- (forall e. Counter3 e -> Eff (e :& es) r) ->- Eff es Int-runCounter3 k =- evalModify 0 $ \st -> do- _ <- try $ \ex -> do- useImplIn k (MkCounter3 (mapHandle st) (mapHandle ex))- get st--exampleCounter3 :: Int-exampleCounter3 = runPureEff $ runCounter3 $ \c ->- forever $- incCounter3 c---- > exampleCounter3--- 10---- Counter 3B--newtype Counter3B e = MkCounter3B (IOE e)--incCounter3B :: (e <: es) => Counter3B e -> Eff es ()-incCounter3B (MkCounter3B io) =- effIO io (putStrLn "You tried to increment the counter")--runCounter3B ::- (e1 <: es) =>- IOE e1 ->- (forall e. Counter3B e -> Eff (e :& es) r) ->- Eff es r-runCounter3B io k = useImplIn k (MkCounter3B (mapHandle io))--exampleCounter3B :: IO ()-exampleCounter3B = runEff $ \io -> runCounter3B io $ \c -> do- incCounter3B c- incCounter3B c- incCounter3B c---- ghci> exampleCounter3B--- You tried to increment the counter--- You tried to increment the counter--- You tried to increment the counter---- Counter 4--data Counter4 e- = MkCounter4 (Modify Int e) (Throw () e) (Stream String e)--incCounter4 :: (e <: es) => Counter4 e -> Eff es ()-incCounter4 (MkCounter4 st ex y) = do- count <- get st-- when (even count) $- yield y "Count was even"-- when (count >= 10) $- throw ex ()-- put st (count + 1)--getCounter4 :: (e <: es) => Counter4 e -> String -> Eff es Int-getCounter4 (MkCounter4 st _ y) msg = do- yield y msg- get st--runCounter4 ::- (e1 <: es) =>- Stream String e1 ->- (forall e. Counter4 e -> Eff (e :& es) r) ->- Eff es Int-runCounter4 y k =- evalModify 0 $ \st -> do- _ <- try $ \ex -> do- useImplIn k (MkCounter4 (mapHandle st) (mapHandle ex) (mapHandle y))- get st--exampleCounter4 :: ([String], Int)-exampleCounter4 = runPureEff $ yieldToList $ \y -> do- runCounter4 y $ \c -> do- incCounter4 c- incCounter4 c- n <- getCounter4 c "I'm getting the counter"- when (n == 2) $- yield y "n was 2, as expected"---- > exampleCounter4--- (["Count was even","I'm getting the counter","n was 2, as expected"],2)---- Counter 5--data Counter5 e = MkCounter5- { incCounter5Impl :: Eff e (),- getCounter5Impl :: String -> Eff e Int- }- deriving (Generic)- deriving (Handle) via OneWayCoercibleHandle Counter5--instance (e <: es) => OneWayCoercible (Counter5 e) (Counter5 es) where- oneWayCoercibleImpl = gOneWayCoercible--incCounter5 :: (e <: es) => Counter5 e -> Eff es ()-incCounter5 e = incCounter5Impl (mapHandle e)--getCounter5 :: (e <: es) => Counter5 e -> String -> Eff es Int-getCounter5 e msg = getCounter5Impl (mapHandle e) msg--runCounter5 ::- (e1 <: es) =>- Stream String e1 ->- (forall e. Counter5 e -> Eff (e :& es) r) ->- Eff es Int-runCounter5 y k =- evalModify 0 $ \st -> do- _ <- try $ \ex -> do- useImplIn- k- ( MkCounter5- { incCounter5Impl = do- count <- get st-- when (even count) $- yield y "Count was even"-- when (count >= 10) $- throw ex ()-- put st (count + 1),- getCounter5Impl = \msg -> do- yield y msg- get st- }- )- get st--exampleCounter5 :: ([String], Int)-exampleCounter5 = runPureEff $ yieldToList $ \y -> do- runCounter5 y $ \c -> do- incCounter5 c- incCounter5 c- n <- getCounter5 c "I'm getting the counter"- when (n == 2) $- yield y "n was 2, as expected"---- > exampleCounter5--- (["Count was even","I'm getting the counter","n was 2, as expected"],2)---- Counter 6--data Counter6 e = MkCounter6- { incCounter6Impl :: Eff e (),- counter6Modify :: Modify Int e,- counter6Stream :: Stream String e- }- deriving (Generic)- deriving (Handle) via OneWayCoercibleHandle Counter6--instance (e <: es) => OneWayCoercible (Counter6 e) (Counter6 es) where- oneWayCoercibleImpl = gOneWayCoercible--incCounter6 :: (e <: es) => Counter6 e -> Eff es ()-incCounter6 e = incCounter6Impl (mapHandle e)--getCounter6 :: (e <: es) => Counter6 e -> String -> Eff es Int-getCounter6 (MkCounter6 _ st y) msg = do- yield y msg- get st--runCounter6 ::- (e1 <: es) =>- Stream String e1 ->- (forall e. Counter6 e -> Eff (e :& es) r) ->- Eff es Int-runCounter6 y k =- evalModify 0 $ \st -> do- _ <- try $ \ex -> do- useImplIn- k- ( MkCounter6- { incCounter6Impl = do- count <- get st-- when (even count) $- yield y "Count was even"-- when (count >= 10) $- throw ex ()-- put st (count + 1),- counter6Modify = mapHandle st,- counter6Stream = mapHandle y- }- )- get st--exampleCounter6 :: ([String], Int)-exampleCounter6 = runPureEff $ yieldToList $ \y -> do- runCounter6 y $ \c -> do- incCounter6 c- incCounter6 c- n <- getCounter6 c "I'm getting the counter"- when (n == 2) $- yield y "n was 2, as expected"---- > exampleCounter6--- (["Count was even","I'm getting the counter","n was 2, as expected"],2)---- Counter 7--data Counter7 e = MkCounter7- { incCounter7Impl :: forall e'. Throw () e' -> Eff (e' :& e) (),- counter7Modify :: Modify Int e,- counter7Stream :: Stream String e- }- deriving (Handle) via OneWayCoercibleHandle Counter7---- | The "forall" in the type of @incCounter7@ means that we can't--- derive the @OneWayCoercible@ instance with 'gOneWayCoercible' so--- instead we use @oneWayCoercibleTrustMe@.-instance (e <: es) => OneWayCoercible (Counter7 e) (Counter7 es) where- oneWayCoercibleImpl = oneWayCoercibleTrustMe $ \c ->- MkCounter7- { incCounter7Impl = \ex -> useImplUnder (incCounter7Impl c ex),- counter7Modify = mapHandle (counter7Modify c),- counter7Stream = mapHandle (counter7Stream c)- }--incCounter7 ::- (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-getCounter7 (MkCounter7 _ st y) msg = do- yield y msg- get st--runCounter7 ::- (e1 <: es) =>- Stream String e1 ->- (forall e. Counter7 e -> Eff (e :& es) r) ->- Eff es Int-runCounter7 y k =- evalModify 0 $ \st -> do- _ <-- useImplIn- k- ( MkCounter7- { incCounter7Impl = \ex -> do- count <- get st-- when (even count) $- yield y "Count was even"-- when (count >= 10) $- throw ex ()-- put st (count + 1),- counter7Modify = mapHandle st,- counter7Stream = mapHandle y- }- )- get st--exampleCounter7A :: ([String], Int)-exampleCounter7A = runPureEff $ yieldToList $ \y -> do- handle (\() -> pure (-42)) $ \ex ->- runCounter7 y $ \c -> do- incCounter7 c ex- incCounter7 c ex- n <- getCounter7 c "I'm getting the counter"- when (n == 2) $- yield y "n was 2, as expected"---- > exampleCounter7A--- (["Count was even","I'm getting the counter","n was 2, as expected"],2)--exampleCounter7B :: ([String], Int)-exampleCounter7B = runPureEff $ yieldToList $ \y -> do- handle (\() -> pure (-42)) $ \ex ->- runCounter7 y $ \c -> do- forever (incCounter7 c ex)---- > exampleCounter7B--- (["Count was even","Count was even","Count was even","Count was even","Count was even","Count was even"],-42)---- FileSystem--data FileSystem es = MkFileSystem- { readFileImpl :: FilePath -> Eff es String,- writeFileImpl :: FilePath -> String -> Eff es ()- }- deriving (Generic)- deriving (Handle) via OneWayCoercibleHandle FileSystem--instance (e <: es) => OneWayCoercible (FileSystem e) (FileSystem es) where- oneWayCoercibleImpl = gOneWayCoercible--readFile :: (e <: es) => FileSystem e -> FilePath -> Eff es String-readFile fs filepath = readFileImpl (mapHandle fs) filepath--writeFile :: (e <: es) => FileSystem e -> FilePath -> String -> Eff es ()-writeFile fs filepath contents =- writeFileImpl (mapHandle fs) filepath contents--runFileSystemPure ::- (e1 <: es) =>- Throw String e1 ->- [(FilePath, String)] ->- (forall e2. FileSystem e2 -> Eff (e2 :& es) r) ->- Eff es r-runFileSystemPure ex fs0 k =- evalModify fs0 $ \fs ->- useImplIn- k- MkFileSystem- { readFileImpl = \path -> do- fs' <- get fs- case lookup path fs' of- Nothing ->- throw ex ("File not found: " <> path)- Just s -> pure s,- writeFileImpl = \path contents ->- modify fs ((path, contents) :)- }--runFileSystemIO ::- forall e1 e2 es r.- (e1 <: es, e2 <: es) =>- Throw String e1 ->- IOE e2 ->- (forall e. FileSystem e -> Eff (e :& es) r) ->- Eff es r-runFileSystemIO ex io k =- useImplIn- k- MkFileSystem- { readFileImpl =- adapt . Prelude.readFile,- writeFileImpl =- \path -> adapt . Prelude.writeFile path- }- where- adapt :: (e1 <: ess, e2 <: ess) => IO a -> Eff ess a- adapt m =- effIO io (Control.Exception.try @IOException m) >>= \case- Left e -> throw ex (show e)- Right r -> pure r--action :: (e <: es) => FileSystem e -> Eff es String-action fs = do- file <- readFile fs "/dev/null"- when (length file == 0) $ do- writeFile fs "/tmp/bluefin" "Hello!\n"- readFile fs "/tmp/doesn't exist"--exampleRunFileSystemPure :: Either String String-exampleRunFileSystemPure = runPureEff $ try $ \ex ->- runFileSystemPure ex [("/dev/null", "")] action---- > exampleRunFileSystemPure--- Left "File not found: /tmp/doesn't exist"--exampleRunFileSystemIO :: IO (Either String String)-exampleRunFileSystemIO = runEff $ \io -> try $ \ex ->- runFileSystemIO ex io action---- > exampleRunFileSystemIO--- Left "/tmp/doesn't exist: openFile: does not exist (No such file or directory)"--- \$ cat /tmp/bluefin--- Hello!---- instance Handle example--data Application e = MkApplication- { queryDatabase :: String -> Int -> Eff e [String],- applicationModify :: Modify (Int, Bool) e,- logger :: Stream String e- }- deriving (Generic)- deriving (Handle) via OneWayCoercibleHandle Application--instance (e <: es) => OneWayCoercible (Application e) (Application es) where- oneWayCoercibleImpl = gOneWayCoercible---- This example shows a case where we can use @bracket@ polymorphically--- in order to perform correct cleanup if @es@ is instantiated to a--- set of effects that includes exceptions.-polymorphicBracket ::- (st <: es) =>- Modify (Integer, Bool) st ->- Eff es () ->- Eff es ()-polymorphicBracket st act =- bracket- (pure ())- -- Always set the boolean indicating that we have terminated- (\_ -> modify st (\(c, _b) -> (c, True)))- -- Perform the given effectful action, then increment the counter- (\_ -> do act; modify st (\(c, b) -> ((c + 1), b)))---- Results in (1, True)-polymorphicBracketExample1 :: (Integer, Bool)-polymorphicBracketExample1 =- runPureEff $ do- (_res, st) <- runModify (0, False) $ \st -> polymorphicBracket st (pure ())- pure st---- Results in (0, True)-polymorphicBracketExample2 :: (Integer, Bool)-polymorphicBracketExample2 =- runPureEff $ do- (_res, st) <- runModify (0, False) $ \st -> try @Int $ \e -> polymorphicBracket st (throw e 42)- pure st--pipesExample1 :: IO ()-pipesExample1 = runEff $ \io -> runEffect (count >-> P.print io)- where- count :: (e <: es) => Producer Int e -> Eff es ()- count p = for_ [1 .. 5] $ \i -> P.yield p i--pipesExample2 :: IO String-pipesExample2 = runEff $ \io -> runEffect $ do- stdinLn io >-> takeWhile' (/= "quit") >-> stdoutLn io---- Acquiring resource--- 1--- 2--- 3--- 4--- 5--- Releasing resource--- Finishing-promptCoroutine :: IO ()-promptCoroutine = runEff $ \io -> do- -- consumeStream connects a consumer to a producer- consumeStream- -- Like a pipes Consumer. Prints the first five elements it- -- awaits.- ( \r -> for_ [1 :: Int .. 5] $ \_ -> do- v <- await r- effIO io (print v)- )- -- Like a pipes Producer. Yields successive integers indefinitely.- -- Unlike in pipes, we can simply use Bluefin's standard bracket- -- for prompt release of a resource- ( \y ->- bracket- (effIO io (putStrLn "Acquiring resource"))- (\_ -> effIO io (putStrLn "Releasing resource"))- (\_ -> for_ [1 :: Int ..] $ \i -> yield y i)- )- effIO io (putStrLn "Finishing")--rethrowIOExample :: IO ()-rethrowIOExample = runEff $ \io -> do- r <- try $ \ex -> do- rethrowIO @Control.Exception.IOException io ex $ do- effIO io (Prelude.readFile "/tmp/doesnt-exist")-- effIO io $ putStrLn $ case r of- Left e -> "Caught IOException:\n" ++ show e- Right contents -> contents---- | The "forall" in the type of @localRImpl@ means that we can't--- derive the @OneWayCoercible@ instance with 'gOneWayCoercible' so--- instead we use @oneWayCoercibleTrustMe@.-data DynamicReader r e = DynamicReader- { askLRImpl :: Eff e r,- localLRImpl :: forall e' a. (r -> r) -> Eff e' a -> Eff (e' :& e) a- }- deriving (Handle) via OneWayCoercibleHandle (DynamicReader r)--instance- (e <: es) =>- OneWayCoercible (DynamicReader r e) (DynamicReader r es)- where- oneWayCoercibleImpl = oneWayCoercibleTrustMe $ \h ->- DynamicReader- { askLRImpl = useImpl (askLRImpl h),- localLRImpl = \f k -> useImplUnder (localLRImpl h f k)- }--askLR ::- (e <: es) =>- DynamicReader r e ->- Eff es r-askLR c = askLRImpl (mapHandle c)--localLR ::- (e <: es) =>- DynamicReader r e ->- (r -> r) ->- Eff es a ->- Eff es a-localLR c f m = makeOp (localLRImpl (mapHandle c) f m)--runDynamicReader ::- r ->- (forall e. DynamicReader r e -> Eff (e :& es) a) ->- Eff es a-runDynamicReader r k =- runReader r $ \h -> do- useImplIn- k- DynamicReader- { askLRImpl = ask h,- localLRImpl = \f k' -> local h f (useImpl k')- }+module Bluefin.Internal.Examples where++import Bluefin.Internal+import Data.Proxy (Proxy (Proxy)) -- Fails to compile unless '(e <: es) => e <: (x :& es)' is incoherent -- (otherwise I guess it "commits to it too soon")
src/Bluefin/Internal/Pipes.hs view
@@ -14,7 +14,7 @@ returnEarly, useImpl, useImplIn,- withEarlyReturn,+ withReturnEarly, yieldCoroutine, (:&), type (<:),@@ -211,7 +211,7 @@ -- | ͘ Eff es r unfoldr next_ sInit p =- withEarlyReturn $ \break -> evalState sInit $ \ss -> forever $ do+ withReturnEarly $ \break -> evalState sInit $ \ss -> forever $ do s <- get ss useImpl (next_ s) >>= \case Left r -> returnEarly break r@@ -258,7 +258,7 @@ Pipe r r e -> -- | ͘ Eff es r-takeWhile' predicate p = withEarlyReturn $ \early -> forever $ do+takeWhile' predicate p = withReturnEarly $ \early -> forever $ do a <- await p if predicate a then yield p a
+ src/Bluefin/Internal/Vault.hs view
@@ -0,0 +1,37 @@+module Bluefin.Internal.Vault+ ( module Bluefin.Internal.Vault,+ Vault,+ Vault.empty,+ )+where++import Data.Kind (Type)+import Data.Vault.Strict (Vault)+import Data.Vault.Strict qualified as Vault+import GHC.Exts (Any)+import Unsafe.Coerce (unsafeCoerce)++-- Vault.Key doesn't have representational role for its "value"+-- argument. I think it should. We hack it.+--+-- https://github.com/HeinrichApfelmus/vault/issues/56+type Key :: Type -> Type+newtype Key a = MkKey (Vault.Key Any)++fromMine :: Key a -> Vault.Key a+fromMine (MkKey k) = unsafeCoerce k++toMine :: Vault.Key a -> Key a+toMine k = MkKey (unsafeCoerce k)++lookup :: Key a -> Vault -> Maybe a+lookup = Vault.lookup . fromMine++adjust :: (a -> a) -> Key a -> Vault -> Vault+adjust f = Vault.adjust f . fromMine++newKey :: IO (Key a)+newKey = fmap toMine Vault.newKey++insert :: Key a -> a -> Vault -> Vault+insert = Vault.insert . fromMine
test/Main.hs view
@@ -39,6 +39,7 @@ test_generalBracket io y test_streamConsumeReader y test_streamConsumeHandleReader y+ test_unliftIOReader io y (!?) :: [a] -> Int -> Maybe a xs !? i = runPureEff $@@ -90,9 +91,8 @@ (\y2 -> local re (const "local") (yield y2 ())) (\() -> assertEqual y "Reader local" "local" =<< ask re) --- This test confirms the buggy behavior reported in------ https://github.com/tomjaguarpaw/bluefin/issues/98+-- local run in one branch of a streamConsume should not affect ask in+-- the other branch. test_streamConsumeReader :: (e <: es) => SpecH e -> Eff es () test_streamConsumeReader spech = do runReader @Int 0 $ \r -> do@@ -102,23 +102,23 @@ let check i = assertEqual spech "Reader local" i =<< ask r check 0 s- check (-100) -- Should be 0+ check 0 s- check (-200) -- Should be 0+ check 0 local r (+ 1) $ do- check (-199) -- Should be 1+ check 1 s- check (-299) -- Should be 1+ check 1 local r (+ 1) $ do- check (-298) -- Should be 2+ check 2 s- check (-398) -- Should be 2- check (-299) -- Should be 1+ check 2+ check 1 s- check (-299) -- Should be 1- check (-200) -- Should be 0+ check 1+ check 0 s- check (-200) -- Should be 0+ check 0 ) ( \a -> do let p = await a@@ -133,9 +133,8 @@ forever p ) --- This test confirms the buggy behavior reported in------ https://github.com/tomjaguarpaw/bluefin/issues/98+-- localHandle run in one branch of a streamConsume should not affect+-- askHandle in the other branch. test_streamConsumeHandleReader :: (e <: es) => SpecH e -> Eff es () test_streamConsumeHandleReader spech = do runConstEffect @Int 0 $ \ce ->@@ -148,7 +147,7 @@ assertEqual spech "HandleReader local" i i' check 0 s- check (-100) -- Should be 0+ check 0 ) ( \a -> do let p = await a@@ -156,3 +155,23 @@ localHandle r (\(MkConstEffect i) -> MkConstEffect (subtract 100 i)) $ do forever p )++-- Reader should interact well with withEffToIO_+test_unliftIOReader :: (e1 <: es, e2 <: es) => IOE e1 -> SpecH e2 -> Eff es ()+test_unliftIOReader io spech = do+ let foo :: (Int -> IO ()) -> (forall r. Int -> IO r -> IO r) -> IO ()+ foo myYield mySetLocal = do+ myYield 0+ mySetLocal 1 $ do+ myYield 1+ mySetLocal 2 $ do+ myYield 2++ runReader @Int 0 $ \r -> do+ withEffToIO_ io $ \effToIO -> do+ foo+ ( \i -> effToIO $ do+ i' <- ask r+ assertEqual spech "myLocal" i i'+ )+ (\x -> effToIO . local r (const x) . effIO io)