Trying to write netwire combiner similar to multicast

Hey, I am trying to write a netwire combiner similar to multicast. The only difference is that when one of the wires inihibts, I want to remove it from the list. So this is my attempt: manager :: (Monad m) => [Wire e m a b] -> Wire e m [a] [b] manager ws' = mkGen $ \dt xs' -> do res <- mapM (\(w,x) -> stepWire w dt x) $ zip ws' xs' let filt (Left a, b) = Just (a, b) filt _ = Nothing resx = mapMaybe filt res return (Left $ (fmap fst) resx,manager (fmap snd resx)) ghc gives this compiler error: BreakoutImproved.hs:90:62: Couldn't match type `e' with `[e]' `e' is a rigid type variable bound by the type signature for manager :: Monad m => [Wire e m a b] -> Wire e m [a] [b] at BreakoutImproved.hs:85:1 Expected type: [(e, Wire [e] m a b)] Actual type: [(e, Wire e m a b)] In the second argument of `fmap', namely `resx' In the first argument of `manager', namely `(fmap snd resx)' Now this, I do not get. Why does manager expect an argument of type [(e, Wire [e] m a b)]. The type signature clearly says [(e, Wire e m a b)] (which is what it is getting). Thanks! Nathan

Nathan Hüsken
I am trying to write a netwire combiner similar to multicast. The only difference is that when one of the wires inihibts, I want to remove it from the list.
So this is my attempt:
manager :: (Monad m) => [Wire e m a b] -> Wire e m [a] [b] manager ws' = mkGen $ \dt xs' -> do res <- mapM (\(w,x) -> stepWire w dt x) $ zip ws' xs' let filt (Left a, b) = Just (a, b) filt _ = Nothing resx = mapMaybe filt res return (Left $ (fmap fst) resx,manager (fmap snd resx))
Notice that Left means inhibition. You seem to be filtering out produced results and trying to keep only the inhibition values, which of course does not make much sense and triggers the type error you are seeing. Also your interface seems very unsafe to me. I suggest the following interface instead: shrinking :: (Monad m) => [Wire e m a b] -> Wire e m a [b] Then normally 'a' could be something like Map K A. Greets, Ertugrul -- Not to be or to be and (not to be or to be and (not to be or to be and (not to be or to be and ... that is the list monad.

On 11/05/2012 05:29 PM, Ertugrul Söylemez wrote:
Nathan Hüsken
wrote: I am trying to write a netwire combiner similar to multicast. The only difference is that when one of the wires inihibts, I want to remove it from the list.
So this is my attempt:
manager :: (Monad m) => [Wire e m a b] -> Wire e m [a] [b] manager ws' = mkGen $ \dt xs' -> do res <- mapM (\(w,x) -> stepWire w dt x) $ zip ws' xs' let filt (Left a, b) = Just (a, b) filt _ = Nothing resx = mapMaybe filt res return (Left $ (fmap fst) resx,manager (fmap snd resx))
Notice that Left means inhibition (...).
I was sure right meant inhibition ... thanks!
Also your interface seems very unsafe to me. I suggest the following interface instead:
shrinking :: (Monad m) => [Wire e m a b] -> Wire e m a [b]
Then normally 'a' could be something like Map K A.
That would mean, the individual wires have to know there own id?!? Mmmh, I will try to keep this bookkeeping out of the wires with this interface: shrinking :: (Monad m) => [Wire e m a b] -> Wire e m (Map Int a) (Int,b) shrinking will assign the ids to the wires and returns them with the result. I will see where this gets me ... :). Regards, Nathan

Nathan Hüsken
Also your interface seems very unsafe to me. I suggest the following interface instead:
shrinking :: (Monad m) => [Wire e m a b] -> Wire e m a [b]
Then normally 'a' could be something like Map K A.
That would mean, the individual wires have to know there own id?!? Mmmh, I will try to keep this bookkeeping out of the wires with this interface:
shrinking :: (Monad m) => [Wire e m a b] -> Wire e m (Map Int a) (Int,b)
shrinking will assign the ids to the wires and returns them with the result. I will see where this gets me ... :).
The problem with such an interface is the inflexibility. Notice that removing a subwire will change the numbering of all subsequent wires. The interface I suggested follows this basic idea: shrinking :: (Monad m) => [(a' -> a, Wire e m a b)] -> Wire e m a' b The reasoning is that this way you disconnect the individual values from the positions in the subwire list. This will also make writing the combinator a bit simpler. If you will here is an interesting alternative: data Subwire e m a b = forall a'. Subwire (a -> a') (Wire e m a' b) shrinking :: (Monad m) => [Subwire e m a b] -> Wire e m a b It doesn't buy you much except for some minor additional type safety, the cleaner type signature and the opportunity to use a crazy type system extension. =) By the way, you can find this style all throughout the Netwire library. See for example 'context' and 'require'. You may also find that the various context combinators from Control.Wire.Trans.Combine could fit your need, although they do not multicast. Final note: I renamed your 'manager' combinator to 'shrinking' to save you from future name clashes, because I have planned to write a more general manager combinator. Greets, Ertugrul -- Not to be or to be and (not to be or to be and (not to be or to be and (not to be or to be and ... that is the list monad.

On 11/06/2012 02:44 AM, Ertugrul Söylemez wrote:
Nathan Hüsken
wrote: Also your interface seems very unsafe to me. I suggest the following interface instead:
shrinking :: (Monad m) => [Wire e m a b] -> Wire e m a [b]
Then normally 'a' could be something like Map K A.
That would mean, the individual wires have to know there own id?!? Mmmh, I will try to keep this bookkeeping out of the wires with this interface:
shrinking :: (Monad m) => [Wire e m a b] -> Wire e m (Map Int a) (Int,b)
shrinking will assign the ids to the wires and returns them with the result. I will see where this gets me ... :).
The problem with such an interface is the inflexibility. Notice that removing a subwire will change the numbering of all subsequent wires. The interface I suggested follows this basic idea:
shrinking :: (Monad m) => [(a' -> a, Wire e m a b)] -> Wire e m a' b
That should be ".. -> Wire e m a' [b]", correct?
The reasoning is that this way you disconnect the individual values from the positions in the subwire list. This will also make writing the combinator a bit simpler. If you will here is an interesting alternative:
data Subwire e m a b = forall a'. Subwire (a -> a') (Wire e m a' b)
shrinking :: (Monad m) => [Subwire e m a b] -> Wire e m a b
Ohh, the scary forall keyword :). Here it does nothing but hide the a' type from the type signature, is that correct? Thanks! Nathan

Nathan Hüsken
The problem with such an interface is the inflexibility. Notice that removing a subwire will change the numbering of all subsequent wires. The interface I suggested follows this basic idea:
shrinking :: (Monad m) => [(a' -> a, Wire e m a b)] -> Wire e m a' b
That should be ".. -> Wire e m a' [b]", correct?
Yes, of course.
The reasoning is that this way you disconnect the individual values from the positions in the subwire list. This will also make writing the combinator a bit simpler. If you will here is an interesting alternative:
data Subwire e m a b = forall a'. Subwire (a -> a') (Wire e m a' b)
shrinking :: (Monad m) => [Subwire e m a b] -> Wire e m a b
Ohh, the scary forall keyword :). Here it does nothing but hide the a' type from the type signature, is that correct?
It also localizes error messages to where your subwire is defined. Greets, Ertugrul -- Not to be or to be and (not to be or to be and (not to be or to be and (not to be or to be and ... that is the list monad.
participants (2)
-
Ertugrul Söylemez
-
Nathan Hüsken