Conduit - Combining multiple Sources/Producers into one

左心房为你撑大大i 提交于 2019-12-11 02:48:31

问题


I'm reading from a file using sourceFile, but I also need to introduce randomness into the processing operation. The best approach I believe is to have a producer that is of the type

Producer m (StdGen, ByteString)

where StdGen is used to generate the random number.

I'm intending for the producer to perform the task of sourceFile, as well as producing a new seed to yield everytime it sends data downstream.

My problem is, there doesn't seem to be a source-combiner like zipSink for sinks. Reading through Conduit Overview, it seems to be suggesting that you can embed a Source inside a Conduit, but I'm failing to see how it is done in the example.

Can anyone provide an example of which you fuse two or more IO sources into one single Producer/Source?

EDIT :

An example:

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}

import System.Random (StdGen(..), split, newStdGen, randomR)
import ClassyPrelude.Conduit as Prelude
import Control.Monad.Trans.Resource (runResourceT, ResourceT(..))
import qualified Data.ByteString as BS

-- generate a infinite source of random number seeds
sourceStdGen :: MonadIO m => Source m StdGen
sourceStdGen = do
    g <- liftIO newStdGen
    loop g
    where loop gin = do
            let g' = fst (split gin)
            yield gin
            loop g'

-- combine the sources into one
sourceInput :: (MonadResource m, MonadIO m) => FilePath -> Source m (StdGen, ByteString)
sourceInput fp = getZipSource $ (,)
    <$> ZipSource sourceStdGen
    <*> ZipSource (sourceFile fp)

-- a simple conduit, which generates a random number from provide StdGen
-- and append the byte value to the provided ByteString
simpleConduit :: Conduit (StdGen, ByteString) (ResourceT IO) ByteString
simpleConduit = mapC process 

process :: (StdGen, ByteString) -> ByteString
process (g, bs) =
    let rnd = fst $ randomR (40,50) g
    in bs ++ pack [rnd]

main :: IO ()
main = do
    runResourceT $ sourceInput "test.txt" $$ simpleConduit =$ sinkFile "output.txt"

So this example takes what's in the input file and write it to the output file, as well as appending a random ASCII value between 40 and 50 to the end of the file. (Don't ask me why)


回答1:


You can use ZipSource for this. In your case, it might look something like:

sourceStdGens :: Source m StdGen
sourceBytes :: Source m ByteString
sourceBoth :: Source m (StdGen, ByteString)
sourceBoth = getZipSource $ (,)
    <$> ZipSource sourceStdGens
    <*> ZipSource sourceBytes



回答2:


You can do it in the IO monad then lift the result to a Producer.

do (i, newSeed) <- next currentSeed
   b <- generateByteStringFromRandomNumber i
   return (b, newSeed)

That IO action can be lifted into the appropriate conduit with a simple lift:

-- assuming the above action is named x and takes the current seed as an argument
-- the corresponding producer/source is:
lift $ x currentSeed


来源:https://stackoverflow.com/questions/23321983/conduit-combining-multiple-sources-producers-into-one

标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!