Conduit Broadcast

Question

Il y a quelques jours, j'ai posé la question suivante pregunta . Maintenant, j'ai besoin d'une version pure et monofilaire de cette fonction :

Pour répéter, j'ai besoin d'une fonction qui envoie chaque valeur reçue à chaque puits et collecte leurs résultats. La signature de type de la fonction doit être quelque chose comme ceci :

broadcast :: [Sink a m b] -> Sink a m [b]

Meilleur Sven

---

P.S. Ce n'est pas sequence J'ai essayé :

> C.sourceList [1..100] $$ sequence [C.fold (+) 0, C.fold (+) 0]
[5050, 0]

résultat attendu :

[5050, 5050]

---

P.P.S. zipSinks donne le résultat souhaité, mais il ne fonctionne qu'avec des tuples :

> C.sourceList [1..100] $$ C.zipSinks (C.fold (+) 0) (C.fold (+) 0)
(5050, 5050)

Answer 1

En fait, tout ce que nous devons faire est de réimplémenter sequence mais avec zipSinks au lieu de l'opération de séquençage initiale :

import Data.Conduit as C
import Data.Conduit.List as C
import Data.Conduit.Util as C

fromPairs
    :: (Functor f)
    => f [a]                        -- ^ an empty list to start with
    -> (f a -> f [a] -> f (a, [a])) -- ^ a combining function
    -> [f a]                        -- ^ input list
    -> f [a]                        -- ^ combined list
fromPairs empty comb = g
  where
    g []     = empty
    g (x:xs) = uncurry (:) `fmap` (x `comb` g xs)

Créer maintenant broadcast c'est juste appliquer fromPairs a zipSinks :

broadcast :: (Monad m) => [Sink a m b] -> Sink a m [b]
broadcast = fromPairs (return []) zipSinks

Et nous pouvons faire quelque chose comme

main = C.sourceList [1..100] $$ broadcast [C.fold (+) 0, C.fold (*) 1]

---

Mise à jour : On peut voir que fromPairs semble juste sequenceA et ainsi nous pouvons pousser l'idée encore plus loin. Définissons un foncteur applicatif de zippage sur les conduits similaire à ZipList :

import Control.Applicative
import Control.Monad
import Data.Conduit
import Data.Conduit.Util
import Data.Traversable (Traversable(..), sequenceA)

newtype ZipSink i m r = ZipSink { getZipSink :: Sink i m r }

instance Monad m => Functor (ZipSink i m) where
    fmap f (ZipSink x) = ZipSink (liftM f x)
instance Monad m => Applicative (ZipSink i m) where
    pure  = ZipSink . return
    (ZipSink f) <*> (ZipSink x) =
         ZipSink $ liftM (uncurry ($)) $ zipSinks f x

Puis broadcast devient aussi simple que

broadcast :: (Traversable f, Monad m) => f (Sink i m r) -> Sink i m (f r)
broadcast = getZipSink . sequenceA . fmap ZipSink