Create a function from a conduit Sink, which can be partially added to. See: http://stackoverflow.com/a/40154951/369198

SinkFunc.hs

module SinkFunc where

import Control.Monad.IO.Class
import Control.Monad.Catch (MonadMask, bracket)
import Data.Conduit
import Data.IORef
import qualified Data.Conduit.Internal as CI
import Data.Void

withSinkFunc :: (MonadIO m, MonadMask m)
             => ConduitM i Void m ()
             -> ((i -> m ()) -> m a)
             -> m a
withSinkFunc (CI.ConduitM sinkF) inner =
    bracket makeRef closeRef (inner . toFunc)
  where
    makeRef = liftIO $ newIORef $ CI.injectLeftovers $ sinkF CI.Done

    closeRef ref = do
        p <- liftIO $ readIORef ref
        CI.runPipe $ return () `CI.pipe` p

    toFunc ref x = do
        p0 <- liftIO $ readIORef ref
        let go1 (CI.HaveOutput _ _ o) = absurd o
            go1 (CI.NeedInput p _) = go2 $ p x
            go1 (CI.Done ()) = return $ CI.Done () -- could consider throwing an exception
            go1 (CI.PipeM mp) = mp >>= go1
            go1 (CI.Leftover _ l) = absurd l

            go2 (CI.HaveOutput _ _ o) = absurd o
            go2 p@CI.NeedInput{} = return p
            go2 p@CI.Done{} = return p
            go2 (CI.PipeM mp) = mp >>= go2
            go2 (CI.Leftover _ l) = absurd l

        p1 <- go1 p0
        liftIO $ writeIORef ref p1