Using unsafePerformIO safely?

53

Let’s refactor @Nycticorax’s example - if I’m reading it correctly:

connGetReplies :: Connection -> IO [Reply]
connGetReplies conn = go S.empty (SingleLine "previous of first")
  where
    go rest previous = do
      -- lazy pattern match to actually delay the receiving
      ~(r, rest') <- unsafeInterleaveIO $ 
        -- Force previous reply for correct order.
        previous `seq` connGetReply conn rest
      rs <- unsafeInterleaveIO (go rest' r)
      return (r:rs)

connGetReply ::  Connection -> S.ByteString -> IO (Reply, S.ByteString)
connGetReply conn@Conn{..} rest =
     do scanResult <- Scanner.scanWith readMore reply rest
        case scanResult of
          Scanner.Fail{}       -> CC.errConnClosed
          Scanner.More{}    -> error "Hedis: parseWith returned Partial"
          Scanner.Done rest' r -> do
            -- r is the same as 'head' of 'connPending'. Since we just
            -- received r, we remove it from the pending list.
            atomicModifyIORef' connPending $ \(_:rs) -> (rs, ())
            -- We now expect one less reply from Redis. We don't count to
            -- negative, which would otherwise occur during pubsub.
            atomicModifyIORef' connPendingCnt $ \n -> (max 0 (n-1), ())
            return (r, rest')

With the comments removed:

connGetReplies :: Connection -> IO [Reply]
connGetReplies conn = go S.empty (SingleLine "previous of first")
  where
    go rest previous = do
      ~(r, rest') <- unsafeInterleaveIO $ previous `seq` connGetReply conn rest
      rs <- unsafeInterleaveIO $ go rest' r
      return (r:rs)

…connGetReplies has an interesting resemblance to Data.Supply.newSupply:

{-# INLINE newSupply #-}
newSupply :: a -> (a -> a) -> IO (Supply a)
newSupply start next = gen =<< newIORef start
  where gen r = unsafeInterleaveIO
              $ do v  <- unsafeInterleaveIO (atomicModifyIORef r upd)
                   ls <- gen r
                   rs <- gen r
                   return (Node v ls rs)
        upd a = let b = next a in seq b (b, a)

in particular the dual use of unsafeInterleaveIO. Another similar definition is Control.Concurrent.getChanContents:

getChanContents :: Chan a -> IO [a]
getChanContents ch
  = unsafeInterleaveIO (do
        x  <- readChan ch
        xs <- getChanContents ch
        return (x:xs)
    )

Using getChanContents as the example, if unsafeInterleaveIO was removed:

getChanContents ch = do
        x  <- readChan ch
        xs <- getChanContents ch
        return (x:xs)

…the result (x:xs) would never be returned - it may as well be defined as:

getChanContents ch = sequence $ repeat $ readChan ch

At least one of two things would run out - memory (stack overflow or heap exhaustion) or patience!

Whether unsafeInterleaveIO can be avoided by using e.g. interatees is left as an exercise…