diff --git a/library/Potoki/Core/Consume.hs b/library/Potoki/Core/Consume.hs
--- a/library/Potoki/Core/Consume.hs
+++ b/library/Potoki/Core/Consume.hs
@@ -17,44 +17,51 @@
 instance Profunctor Consume where
   {-# INLINE dimap #-}
   dimap inputMapping outputMapping (Consume consume) =
-    Consume (\ fetch -> fmap outputMapping (consume (fmap inputMapping fetch)))
+    Consume (\ fetch -> fmap outputMapping (consume $ fmap inputMapping fetch))
 
 instance Choice Consume where
+  right' :: Consume a b -> Consume (Either c a) (Either c b)
   right' (Consume rightConsumeIO) =
-    Consume $ \ (Fetch eitherFetchIO) -> do
-      fetchedLeftMaybeRef <- newIORef Nothing
-      consumedRight <- 
-        rightConsumeIO $ Fetch $ \ nil just -> join $ eitherFetchIO (return nil) $ \ case
-          Right !fetchedRight -> return (just fetchedRight)
-          Left !fetchedLeft -> writeIORef fetchedLeftMaybeRef (Just fetchedLeft) >> return nil
-      fetchedLeftMaybe <- readIORef fetchedLeftMaybeRef
-      case fetchedLeftMaybe of
-        Nothing -> return (Right consumedRight)
-        Just fetchedLeft -> return (Left fetchedLeft)
+     Consume $ \ (Fetch eitherFetchIO) -> do
+       fetchedLeftMaybeRef <- newIORef Nothing
+       consumedRight <-
+         rightConsumeIO $ Fetch $ do
+           eitherFetch <- eitherFetchIO
+           case eitherFetch of
+             Nothing      -> return Nothing
+             Just element -> case element of
+               Right fetchedRight -> return $ Just fetchedRight
+               Left  fetchedLeft  -> do
+                 writeIORef fetchedLeftMaybeRef $ Just fetchedLeft
+                 return Nothing
+       fetchedLeftMaybe <- readIORef fetchedLeftMaybeRef
+       case fetchedLeftMaybe of
+         Nothing          -> return $ Right consumedRight
+         Just fetchedLeft -> return $ Left fetchedLeft 
 
 instance Functor (Consume input) where
   fmap = rmap
 
 instance Applicative (Consume a) where
-  pure x = Consume $ \_ -> pure x
+  pure x = Consume $ \ _ -> pure x
 
   Consume leftConsumeIO <*> Consume rightConsumeIO =
-    Consume $ \fetch -> leftConsumeIO fetch <*> rightConsumeIO fetch
+    Consume $ \ fetch -> leftConsumeIO fetch <*> rightConsumeIO fetch
 
 instance Monad (Consume a) where
-  Consume leftConsumeIO >>= toRightConsumeIO = Consume $ \fetch -> do
+  Consume leftConsumeIO >>= toRightConsumeIO = Consume $ \ fetch -> do
     Consume rightConsumeIO <- toRightConsumeIO <$> leftConsumeIO fetch
     rightConsumeIO fetch
 
 instance MonadIO (Consume a) where
-  liftIO a = Consume $ \_ -> a
+  liftIO a = Consume $ \ _ -> a
 
 apConcurrently :: Consume a (b -> c) -> Consume a b -> Consume a c
 apConcurrently (Consume leftConsumeIO) (Consume rightConsumeIO) =
   Consume $ \ fetch -> do
     (leftFetch, rightFetch) <- A.duplicate fetch
     rightOutputVar <- newEmptyMVar
-    forkIO $ do
+    _ <- forkIO $ do
       !rightOutput <- rightConsumeIO rightFetch
       putMVar rightOutputVar rightOutput
     !leftOutput <- leftConsumeIO leftFetch
@@ -65,27 +72,27 @@
 list :: Consume input [input]
 list =
   Consume $ \ (Fetch fetchIO) ->
-  let
-    build !acc =
-      join
-        (fetchIO
-          (pure (acc []))
-          (\ !element -> build (acc . (:) element)))
-    in build id
+    let 
+      build !acc = do
+        fetch <- fetchIO
+        case fetch of
+          Nothing       -> pure $ acc []
+          Just !element -> build $ acc . (:) element
+     in build id
 
 {-# INLINE sum #-}
 sum :: Num num => Consume num num
 sum =
   Consume $ \ (Fetch fetchIO) ->
-  let
-    build !acc =
-      join
-        (fetchIO
-          (pure acc)
-          (\ !element -> build (element + acc)))
-    in build 0
+    let
+      build !acc = do
+        fetch <- fetchIO
+        case fetch of
+          Nothing       -> pure acc
+          Just !element -> build $ element + acc
+     in build 0
 
 {-# INLINABLE transform #-}
 transform :: Transform input output -> Consume output sinkOutput -> Consume input sinkOutput
 transform (Transform transformAcquire) (Consume sink) =
-  Consume (\ fetch -> B.acquire (fmap ($ fetch) transformAcquire) sink)
+  Consume $ \ fetch -> B.acquire (fmap ($ fetch) transformAcquire) sink
diff --git a/library/Potoki/Core/Fetch.hs b/library/Potoki/Core/Fetch.hs
--- a/library/Potoki/Core/Fetch.hs
+++ b/library/Potoki/Core/Fetch.hs
@@ -10,7 +10,6 @@
   rightCachingLeft,
   eitherFetchingRight,
   signaling,
-  ioMaybe,
   ioFetch,
 )
 where
@@ -23,26 +22,26 @@
 
 instance Applicative Fetch where
   pure x =
-    Fetch (\ nil just -> pure (just x))
-  (<*>) (Fetch leftFn) (Fetch rightFn) =
-    Fetch (\ nil just ->
-      join (leftFn (pure nil) (\ leftElement ->
-        rightFn nil (\ rightElement -> just (leftElement rightElement)))))
+    Fetch (pure (Just x))
+  (<*>) (Fetch leftIO) (Fetch rightIO) =
+    Fetch ((<*>) <$> leftIO <*> rightIO)
 
 instance Monad Fetch where
   return =
     pure
-  (>>=) (Fetch leftFn) rightK =
-    Fetch (\ nil just ->
-      join (leftFn (pure nil) (\ leftElement ->
-        case rightK leftElement of
-          Fetch rightFn -> rightFn nil just)))
+  (>>=) (Fetch leftIO) rightFetch =
+    Fetch $ do
+      leftFetching <- leftIO
+      case leftFetching of
+        Nothing -> return Nothing
+        Just leftElement -> case rightFetch leftElement of
+          Fetch rightIO -> rightIO
 
 instance Alternative Fetch where
   empty =
-    Fetch (\ nil just -> pure nil)
-  (<|>) (Fetch leftSignal) (Fetch rightSignal) =
-    Fetch (\ nil just -> join (leftSignal (rightSignal nil just) (pure . just)))
+    Fetch (pure Nothing)
+  (<|>) (Fetch leftIO) (Fetch rightIO) =
+    Fetch ((<|>) <$> leftIO <*> rightIO)
 
 instance MonadPlus Fetch where
   mzero =
@@ -50,6 +49,10 @@
   mplus =
     (<|>)
 
+instance MonadIO Fetch where
+  liftIO io =
+    Fetch (fmap Just io)
+
 {-# INLINABLE duplicate #-}
 duplicate :: Fetch element -> IO (Fetch element, Fetch element)
 duplicate (Fetch fetchIO) =
@@ -60,96 +63,102 @@
     notEndVar <- newTVarIO True
     let
       newFetch ownBuffer mirrorBuffer =
-        Fetch
-          (\ nil just -> do
-            join
-              (atomically
-                (mplus
-                  (do
-                    element <- readTQueue ownBuffer
-                    return (return (just element)))
-                  (do
-                    notEnd <- readTVar notEndVar
-                    if notEnd
-                      then do
-                        notFetching <- readTVar notFetchingVar
-                        guard notFetching
-                        writeTVar notFetchingVar False
-                        return
-                          (join
-                            (fetchIO
-                              (do
-                                atomically
-                                  (do
-                                    writeTVar notEndVar False
-                                    writeTVar notFetchingVar True)
-                                return nil)
-                              (\ !element -> do
-                                atomically
-                                  (do
-                                    writeTQueue mirrorBuffer element
-                                    writeTVar notFetchingVar True)
-                                return (just element))))
-                      else return (return nil)))))
+        Fetch $ do
+          fetch <- fetchIO
+          join $
+            atomically
+             (mplus
+                (do
+                   element <- readTQueue ownBuffer
+                   return $ return (Just element)
+                )
+                (do
+                   notEnd <- readTVar notEndVar
+                   if notEnd
+                     then do
+                       notFetching <- readTVar notFetchingVar
+                       guard notFetching
+                       writeTVar notFetchingVar False
+                       return $ case fetch of
+                         Nothing      -> do
+                           atomically
+                             (do
+                                writeTVar notEndVar False
+                                writeTVar notFetchingVar True
+                             )
+                           return Nothing
+                         Just !element -> do
+                           atomically
+                             (do
+                                writeTQueue mirrorBuffer element
+                                writeTVar notFetchingVar True
+                             )
+                           return $ Just element
+                     else return $ return Nothing
+                )
+             )
       leftFetch =
         newFetch leftBuffer rightBuffer
       rightFetch =
         newFetch rightBuffer leftBuffer
-      in return (leftFetch, rightFetch)
+     in return (leftFetch, rightFetch)
 
 {-# INLINABLE maybeRef #-}
 maybeRef :: IORef (Maybe a) -> Fetch a
 maybeRef refElem =
-  Fetch $ \nil just -> do
-    elem <- readIORef refElem
-    case elem of
-      Nothing -> return nil
-      Just e  -> do
+  Fetch $ do
+    elemVal <- readIORef refElem
+    case elemVal of
+      Nothing      -> return Nothing
+      Just element -> do
         writeIORef refElem Nothing
-        return $ just e
+        return $ Just element
 
 {-# INLINABLE list #-}
 list :: IORef [element] -> Fetch element
 list unsentListRef =
-  Fetch $ \nil just -> do
+  Fetch $ do
     refList <- readIORef unsentListRef
     case refList of
-      (!head) : tail -> do
-        writeIORef unsentListRef tail
-        return $ just head
+      (!headVal) : (!tailVal) -> do
+        writeIORef unsentListRef tailVal
+        return $ Just headVal
       _              -> do
         writeIORef unsentListRef []
-        return nil
+        return Nothing
 
 {-# INLINABLE firstCachingSecond #-}
 firstCachingSecond :: IORef b -> Fetch (a, b) -> Fetch a
 firstCachingSecond cacheRef (Fetch bothFetchIO) =
-  Fetch $ \ nil just ->
-  join $
-  bothFetchIO
-    (return nil)
-    (\ (!first, !second) -> do
-      writeIORef cacheRef second
-      return (just first))
+  Fetch $ do
+    bothFetch <- bothFetchIO
+    case bothFetch of
+      Nothing                -> return Nothing
+      Just (!firstVal, !secondVal) -> do
+        writeIORef cacheRef secondVal
+        return $ Just firstVal
 
 {-# INLINABLE bothFetchingFirst #-}
 bothFetchingFirst :: IORef b -> Fetch a -> Fetch (a, b)
 bothFetchingFirst cacheRef (Fetch firstFetchIO) =
-  Fetch $ \ nil just ->
-  join $
-  firstFetchIO
-    (return nil)
-    (\ !firstFetched -> do
-      secondCached <- readIORef cacheRef
-      return (just (firstFetched, secondCached)))
+  Fetch $ do
+    firstFetch <- firstFetchIO
+    case firstFetch of
+      Nothing            -> return Nothing
+      Just !firstFetched -> do
+        secondCached <- readIORef cacheRef
+        return $ Just (firstFetched, secondCached)
 
 {-# INLINABLE rightHandlingLeft #-}
 rightHandlingLeft :: (left -> IO ()) -> Fetch (Either left right) -> Fetch right
-rightHandlingLeft handle (Fetch eitherFetchIO) =
-  Fetch $ \ nil just ->
-  join $ eitherFetchIO (return nil) $ \ case
-    Right !rightInput -> return (just rightInput)
-    Left !leftInput -> handle leftInput $> nil
+rightHandlingLeft left2IO (Fetch eitherFetchIO) =
+  Fetch $ do
+    eitherFetch <- eitherFetchIO
+    case eitherFetch of
+      Nothing    -> return Nothing
+      Just input -> case input of
+        Right rightInput -> return $ Just rightInput
+        Left  leftInput  -> left2IO leftInput $> Nothing
 
 {-# INLINABLE rightCachingLeft #-}
 rightCachingLeft :: IORef (Maybe left) -> Fetch (Either left right) -> Fetch right
@@ -159,26 +168,26 @@
 {-# INLINABLE eitherFetchingRight #-}
 eitherFetchingRight :: IORef (Maybe left) -> Fetch right -> Fetch (Either left right)
 eitherFetchingRight cacheRef (Fetch rightFetchIO) =
-  Fetch $ \ nil just ->
-  join $ rightFetchIO (return nil) $ \ right ->
-  atomicModifyIORef' cacheRef $ \ case
-    Nothing -> (Nothing, just (Right right))
-    Just left -> (Nothing, just (Left left))
+  Fetch $ do
+    rightFetch <- rightFetchIO
+    case rightFetch of
+      Nothing -> return Nothing
+      Just r  -> atomicModifyIORef' cacheRef $ \ case
+        Nothing -> (Nothing, Just $ Right r)
+        Just l  -> (Nothing, Just $ Left  l)
 
 {-# INLINABLE signaling #-}
 signaling :: IO () -> IO () -> Fetch a -> Fetch a
-signaling signalEnd signalElement (Fetch io) =
-  Fetch $ \ nil just ->
-  join (io (signalEnd $> nil) (\ element -> signalElement >> return (just element)))
-
-{-# INLINE ioMaybe #-}
-ioMaybe :: IO (Maybe a) -> Fetch a
-ioMaybe io =
-  Fetch $ \nil just -> maybe nil just <$> io
+signaling signalEnd signalElement (Fetch fetchIO) =
+  Fetch $ do
+    fetch <- fetchIO
+    case fetch of
+      Nothing      -> signalEnd $> Nothing
+      Just element -> signalElement >> return (Just element)
 
 {-# INLINABLE ioFetch #-}
 ioFetch :: IO (Fetch a) -> Fetch a
-ioFetch io =
-  Fetch $ \ nil just -> do
-    Fetch fetchIO <- io
-    fetchIO nil just
+ioFetch fetchIO =
+  Fetch $ do
+    Fetch fetch <- fetchIO
+    fetch
diff --git a/library/Potoki/Core/IO.hs b/library/Potoki/Core/IO.hs
--- a/library/Potoki/Core/IO.hs
+++ b/library/Potoki/Core/IO.hs
@@ -8,36 +8,43 @@
 
 
 produceAndConsume :: Produce input -> Consume input output -> IO output
-produceAndConsume (Produce produceManaged) (Consume consume) =
-  C.acquire produceManaged consume
+produceAndConsume (Produce produceAcquire) (Consume consumeFunc) =
+  C.acquire produceAcquire consumeFunc
 
 produceAndTransformAndConsume :: Produce input -> Transform input anotherInput -> Consume anotherInput output -> IO output
-produceAndTransformAndConsume (Produce produceManaged) (Transform transformManaged) (Consume consume) =
-  C.acquire (($) <$> transformManaged <*> produceManaged) consume
+produceAndTransformAndConsume (Produce produceAcquire) (Transform transformAcquire) (Consume consumeFunc) =
+  C.acquire (($) <$> transformAcquire <*> produceAcquire) consumeFunc
 
 produce :: Produce input -> forall x. IO x -> (input -> IO x) -> IO x
-produce (Produce produceManaged) stop emit =
-  C.acquire produceManaged $ \ (Fetch fetchIO) -> 
-  fix (\ loop -> join (fetchIO stop (\ element -> emit element >> loop)))
+produce (Produce produceAcquire) stop emit =
+  C.acquire produceAcquire $ \ (Fetch fetchIO) ->
+    fix $ \ doLoop -> do
+      fetch <- fetchIO
+      case fetch of
+        Nothing      -> stop
+        Just element -> emit element >> doLoop
 
-consume :: (forall x. x -> (input -> x) -> IO x) -> Consume input output -> IO output
-consume fetch (Consume consume) =
-  consume (Fetch fetch)
+consume :: IO (Maybe input) -> Consume input output -> IO output
+consume fetchIO (Consume consumeFunc) =
+  consumeFunc $ Fetch fetchIO
 
 {-| Fetch all the elements running the provided handler on them -}
 fetchAndHandleAll :: Fetch element -> IO () -> (element -> IO ()) -> IO ()
 fetchAndHandleAll (Fetch fetchIO) onEnd onElement =
-  fix (\ loop -> join (fetchIO onEnd (\ element -> onElement element >> loop)))
+  fix $ \ doLoop -> do
+    fetch <- fetchIO
+    case fetch of
+      Nothing      -> onEnd
+      Just element -> onElement element >> doLoop
 
 {-| Fetch and handle just one element -}
 fetchAndHandle :: Fetch element -> IO a -> (element -> IO a) -> IO a
 fetchAndHandle (Fetch fetchIO) onEnd onElement =
-  join (fetchIO onEnd onElement)
-
-{-| Fetch just one element -}
-fetch :: Fetch element -> IO (Maybe element)
-fetch (Fetch fetchIO) =
-  fetchIO Nothing Just
+  do
+    fetch <- fetchIO
+    case fetch of
+      Nothing      -> onEnd
+      Just element -> onElement element
 
 transformList :: Transform a b -> [a] -> IO [b]
 transformList transform inputList =
diff --git a/library/Potoki/Core/Prelude.hs b/library/Potoki/Core/Prelude.hs
--- a/library/Potoki/Core/Prelude.hs
+++ b/library/Potoki/Core/Prelude.hs
@@ -32,10 +32,11 @@
 import Data.Ix as Exports
 import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')
 import Data.Maybe as Exports
-import Data.Monoid as Exports
+import Data.Monoid as Exports hiding (Last(..), (<>), First(..))
 import Data.Ord as Exports
 import Data.Proxy as Exports
 import Data.Ratio as Exports
+import Data.Semigroup as Exports
 import Data.STRef as Exports
 import Data.String as Exports
 import Data.Traversable as Exports
diff --git a/library/Potoki/Core/Produce.hs b/library/Potoki/Core/Produce.hs
--- a/library/Potoki/Core/Produce.hs
+++ b/library/Potoki/Core/Produce.hs
@@ -9,7 +9,6 @@
 import Potoki.Core.Prelude
 import Potoki.Core.Types
 import qualified Potoki.Core.Fetch as A
-import qualified Acquire.IO as B
 
 
 deriving instance Functor Produce
@@ -39,17 +38,21 @@
             Produce (Acquire io2) ->
               A.ioFetch $ do
                 join (readIORef release2Ref)
-                (fetch2, release2) <- io2
-                writeIORef release2Ref release2
-                return fetch2
+                (fetch2', release2') <- io2
+                writeIORef release2Ref release2'
+                return fetch2'
         release3 =
           join (readIORef release2Ref) >> release1
         in return (fetch1 >>= fetch2, release3)
 
+instance MonadIO Produce where
+  liftIO io =
+    Produce (return (liftIO io))
+
 {-# INLINABLE list #-}
 list :: [input] -> Produce input
-list list =
-  Produce (liftIO (A.list <$> newIORef list))
+list inputList =
+  Produce $ liftIO (A.list <$> newIORef inputList)
 
 {-# INLINE transform #-}
 transform :: Transform input output -> Produce input -> Produce output
@@ -57,4 +60,4 @@
   Produce $ do
     fetch <- produceAcquire
     newFetch <- transformAcquire
-    return (newFetch fetch)
+    return $ newFetch fetch
diff --git a/library/Potoki/Core/Transform.hs b/library/Potoki/Core/Transform.hs
--- a/library/Potoki/Core/Transform.hs
+++ b/library/Potoki/Core/Transform.hs
@@ -12,48 +12,47 @@
 import Potoki.Core.Prelude hiding (take)
 import Potoki.Core.Types
 import qualified Potoki.Core.Fetch as A
-import qualified Potoki.Core.Consume as C
-import qualified Potoki.Core.Produce as D
-import qualified Potoki.Core.IO as E
 
 
 instance Category Transform where
   id =
     Transform (return id)
-  (.) (Transform left) (Transform right) =
-    Transform ((.) <$> left <*> right)
+  (.) (Transform leftVal) (Transform rightVal) =
+    Transform ((.) <$> leftVal <*> rightVal)
 
 instance Profunctor Transform where
-  dimap inputMapping outputMapping (Transform managed) =
+  dimap inputMapping outputMapping (Transform acquire) =
     Transform $ do
-      newFetch <- managed
-      return $ \ oldFetch -> fmap outputMapping (newFetch (fmap inputMapping oldFetch))
+      newFetch <- acquire
+      return $ \ oldFetch -> fmap outputMapping (newFetch $ fmap inputMapping oldFetch)
 
 instance Choice Transform where
-  right' (Transform rightTransformManaged) =
+  right' :: Transform a b -> Transform (Either c a) (Either c b)
+  right' (Transform rightTransformAcquire) =
     Transform $ do
-      rightInFetchToOutFetch <- rightTransformManaged
-      fetchedLeftMaybeRef <- liftIO (newIORef Nothing)
+      rightInFetchToOutFetch <- rightTransformAcquire
+      fetchedLeftMaybeRef <- liftIO $ newIORef Nothing
       return $ \ inFetch ->
         let
-          Fetch rightFetchIO = rightInFetchToOutFetch (A.rightHandlingLeft (writeIORef fetchedLeftMaybeRef . Just) inFetch)
-          in Fetch $ \ stop yield -> do
-            join $ rightFetchIO
-              (do
-                fetchedLeftMaybe <- readIORef fetchedLeftMaybeRef
-                case fetchedLeftMaybe of
-                  Just fetchedLeft -> do
-                    writeIORef fetchedLeftMaybeRef Nothing
-                    return (yield (Left fetchedLeft))
-                  Nothing -> return stop)
-              (\ right -> return (yield (Right right)))
+          Fetch rightFetchIO = rightInFetchToOutFetch $ A.rightHandlingLeft (writeIORef fetchedLeftMaybeRef . Just) inFetch
+         in Fetch $ do
+           rightFetch <- rightFetchIO
+           case rightFetch of
+             Nothing    -> do
+               fetchedLeftMaybe <- readIORef fetchedLeftMaybeRef
+               case fetchedLeftMaybe of
+                 Nothing          -> return Nothing
+                 Just fetchedLeft -> do
+                   writeIORef fetchedLeftMaybeRef Nothing
+                   return $ Just (Left fetchedLeft)
+             Just element -> return $ Just (Right element)
 
 instance Strong Transform where
-  first' (Transform firstTransformManaged) =
+  first' (Transform firstTransformAcquire) =
     Transform $ do
-      cacheRef <- liftIO (newIORef undefined)
-      firstInFetchToOutFetch <- firstTransformManaged
-      return (A.bothFetchingFirst cacheRef . firstInFetchToOutFetch . A.firstCachingSecond cacheRef)
+      cacheRef <- liftIO $ newIORef undefined
+      firstInFetchToOutFetch <- firstTransformAcquire
+      return $ A.bothFetchingFirst cacheRef . firstInFetchToOutFetch . A.firstCachingSecond cacheRef
 
 instance Arrow Transform where
   arr fn =
@@ -69,55 +68,63 @@
 consume :: Consume input output -> Transform input output
 consume (Consume runFetch) =
   Transform $ do
-    stoppedRef <- liftIO (newIORef False)
-    return $ \ (Fetch fetch) -> Fetch $ \ stop yield -> do
+    stoppedRef <- liftIO $ newIORef False
+    return $ \ (Fetch inputIO) -> Fetch $ do
       stopped <- readIORef stoppedRef
       if stopped
         then do
           writeIORef stoppedRef False
-          return stop
+          return Nothing
         else do
           emittedRef <- newIORef False
-          output <-
-            runFetch $ Fetch $ \ inputNil inputJust ->
-            join
-              (fetch
-                (do
-                  writeIORef stoppedRef True
-                  return inputNil)
-                (\ !input -> do
-                  writeIORef emittedRef True
-                  return (inputJust input)))
-          stopped <- readIORef stoppedRef
-          if stopped
+          output <- runFetch $ Fetch $ do
+            input <- inputIO
+            case input of
+              Nothing     -> do
+                writeIORef stoppedRef True
+                return Nothing
+              Just element -> do
+                writeIORef emittedRef True
+                return $ Just element
+          checkStopped <- readIORef stoppedRef
+          if checkStopped
             then do
               emitted <- readIORef emittedRef
               if emitted
-                then return (yield output)
+                then return $ Just output
                 else do
                   writeIORef stoppedRef False
-                  return stop
-            else return (yield output)
+                  return Nothing
+            else return $ Just output
 
 {-# INLINABLE produce #-}
 produce :: (input -> Produce output) -> Transform input output
 produce inputToProduce =
   Transform $ do
-    stateRef <- liftIO (newIORef Nothing)
-    return $ \ (Fetch inputFetchIO) -> Fetch $ \ nil just -> fix $ \ loop -> do
+    stateRef <- liftIO $ newIORef Nothing
+    return $ \ (Fetch inputFetchIO) -> Fetch $ fix $ \ doLoop -> do
       state <- readIORef stateRef
       case state of
         Just (Fetch outputFetchIO, kill) ->
-          join $ outputFetchIO
-            (kill >> writeIORef stateRef Nothing >> loop)
-            (return . just)
+          do
+            outputFetchResult <- outputFetchIO
+            case outputFetchResult of
+              Just x -> return (Just x)
+              Nothing -> do
+                kill
+                writeIORef stateRef Nothing
+                doLoop
         Nothing ->
-          join $ inputFetchIO (return nil) $ \ !input -> do
-            case inputToProduce input of
-              Produce (Acquire produceIO) -> do
-                fetchAndKill <- produceIO
-                writeIORef stateRef (Just fetchAndKill)
-                loop
+          do
+            inputFetchResult <- inputFetchIO
+            case inputFetchResult of
+              Just input -> do
+                case inputToProduce input of
+                  Produce (Acquire produceIO) -> do
+                    fetchAndKill <- produceIO
+                    writeIORef stateRef (Just fetchAndKill)
+                    doLoop
+              Nothing -> return Nothing
 
 {-# INLINE mapFetch #-}
 mapFetch :: (Fetch a -> Fetch b) -> Transform a b
@@ -130,18 +137,21 @@
 {-# INLINE executeIO #-}
 executeIO :: Transform (IO a) a
 executeIO =
-  mapFetch $ \ (Fetch fetchIO) -> Fetch $ \ stop yield ->
-  join (fetchIO (return stop) (fmap yield))
+  mapFetch $ \ (Fetch fetchIO) -> Fetch (fetchIO >>= sequence)
 
 {-# INLINE take #-}
 take :: Int -> Transform input input
-take amount =
-  Transform $ do
-    countRef <- liftIO (newIORef amount)
-    return $ \ (Fetch fetchIO) -> Fetch $ \ stop yield -> do
-      count <- readIORef countRef
-      if count > 0
-        then do
-          writeIORef countRef $! pred count
-          fetchIO stop yield
-        else return stop
+take amount
+  | amount <= 0 =
+    Transform $ return $ \ _ -> Fetch $ return Nothing
+  | otherwise   =
+    Transform $ do
+      countRef <- liftIO $ newIORef amount
+      return $ \ (Fetch fetchIO) -> Fetch $ do
+        count <- readIORef countRef
+        if count > 0
+          then do
+            modifyIORef countRef pred
+            fetchIO
+          else
+            return Nothing
diff --git a/library/Potoki/Core/Types.hs b/library/Potoki/Core/Types.hs
--- a/library/Potoki/Core/Types.hs
+++ b/library/Potoki/Core/Types.hs
@@ -5,13 +5,10 @@
 
 
 {-|
-Passive producer of elements with support for early termination.
+Passive producer of elements.
 -}
 newtype Fetch element =
-  {-|
-  Something close to a Church encoding of @IO (Maybe element)@.
-  -}
-  Fetch (forall x. x -> (element -> x) -> IO x)
+  Fetch (IO (Maybe element))
 
 {-|
 Passive producer of elements with support for early termination
diff --git a/potoki-core.cabal b/potoki-core.cabal
--- a/potoki-core.cabal
+++ b/potoki-core.cabal
@@ -1,7 +1,7 @@
 name:
   potoki-core
 version:
-  0.10
+  0.11
 synopsis:
   Low-level components of "potoki"
 description:
diff --git a/tests/Main.hs b/tests/Main.hs
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -38,13 +38,35 @@
   ]
 
 transformProduce =
-  testCase "Produce" $ do
-    let list = [1, 2, 3] :: [Int]
-    result <- C.produceAndTransformAndConsume
-      (E.list list)
-      (A.produce (E.list . \ n -> flip replicate n n))
-      (D.list)
-    assertEqual "" [1, 2, 2, 3, 3, 3] result
+  testGroup "Produce" $ 
+  [
+    testCase "1" $ do
+      let
+        list = [1, 2, 3] :: [Int]
+      result <- C.produceAndTransformAndConsume
+        (E.list list)
+        (A.produce (E.list . \ n -> flip replicate n n))
+        (D.list)
+      assertEqual "" [1, 2, 2, 3, 3, 3] result
+  ,
+    testCase "2" $ do
+      let
+        list = [1, 2, 3] :: [Int]
+      result <- C.produceAndTransformAndConsume
+        (E.list list)
+        (A.produce (E.list . \ n -> [(n, n)]))
+        (D.list)
+      assertEqual "" [(1, 1), (2, 2), (3, 3)] result
+  ,
+    testCase "3" $ do
+      let
+        list = [1, 2, 3] :: [Int]
+      result <- C.produceAndTransformAndConsume
+        (E.list list)
+        (A.produce (E.list . \ n -> [n, n]))
+        (D.list)
+      assertEqual "" [1, 1, 2, 2, 3, 3] result
+  ]
 
 transformChoice =
   testGroup "Choice" $
