Game entity modeling with netwire - haskell

I'm going to be writing a real-time game in Haskell using netwire and OpenGL. The basic idea is that each object will be represented by a wire, which will get some amount of data as input and output its state, and then I'll hook it all up into one big wire that gets the state of the GUI as input and outputs the world state, which I can then pass onto a renderer as well as some 'global' logic like collision detection.
One thing I'm not sure about is: how do I want to type the wires? Not all entities have the same input; the player is the only entity that can access the state of the key input, seeking missiles need the position of their target, etc.
One idea would be to have an ObjectInput type that gets passed to everything, but that seems bad to me since I could accidentally introduce dependencies I don't want.
On the other hand, I don't know if having a SeekerWire, a PlayerWire, an EnemyWire, etc., would be a good idea since they're almost 'identical' and so I'd have to duplicate functionality across them.
What should I do?

The inhibition monoid e is the type for inhibition exceptions. It's not something the wire produces, but takes about the same role as the e in Either e a. In other words, if you combine wires by <|>, then the output types must be equal.
Let's say your GUI events are passed to the wire through input and you have a continuous key-down event. One way to model this is the most straightforward:
keyDown :: (Monad m, Monoid e) => Key -> Wire e m GameState ()
This wire takes the current game state as input and produces a () if the key is held down. While the key is not pressed, it simply inhibits. Most applications don't really care about why a wire inhibits, so most wires inhibit with mempty.
A much more convenient way to express this event is by using a reader monad:
keyDown :: (Monoid e) => Key -> Wire e (Reader GameState) a a
What's really useful about this variant is that now you don't have to pass the game state as input. Instead this wire just acts like the identity wire when the even happens and inhibits when it doesn't:
quitScreen . keyDown Escape <|> mainGame
The idea is that when the escape key is pressed, then the event wire keyDown Escape vanishes temporarily, because it acts like the identity wire. So the whole wire acts like quitScreen assuming that it doesn't inhibit itself. Once the key is released, the event wire inhibits, so the composition with quitScreen inhibits, too. Thus the whole wire acts like mainGame.
If you want to limit the game state a wire can see, you can easily write a wire combinator for that:
trans :: (forall a. m' a -> m a) -> Wire e m' a b -> Wire e m a b
This allows you to apply withReaderT:
trans (withReaderT fullGameStateToPartialGameState)

There is a very simple and general solution to this. The key idea is that you never merge sources of different types. Instead, you only merge sources of the same type. The trick that makes this work is that you wrap the output of all your diverse sources in an algebraic data type.
I'm not really familiar with netwire, so if you don't mind I will use pipes as the example. What we want is a merge function that takes a list of sources and combines them into a single source that merges their outputs concurrently, finishing when they all complete. The key type signature is:
merge
:: (Proxy p)
=> [() -> Producer ProxyFast a IO r] -> () -> Producer p a IO ()
That just says that it takes a list of Producers of values of type a, and combines them into a single Producer of values of type a. Here's the implementation of merge, if you are curious and you want to follow along:
import Control.Concurrent
import Control.Concurrent.Chan
import Control.Monad
import Control.Proxy
fromNChan :: (Proxy p) => Int -> Chan (Maybe a) -> () -> Producer p a IO ()
fromNChan n0 chan () = runIdentityP $ loop n0 where
loop 0 = return ()
loop n = do
ma <- lift $ readChan chan
case ma of
Nothing -> loop (n - 1)
Just a -> do
respond a
loop n
toChan :: (Proxy p) => Chan ma -> () -> Consumer p ma IO r
toChan chan () = runIdentityP $ forever $ do
ma <- request ()
lift $ writeChan chan ma
merge
:: (Proxy p)
=> [() -> Producer ProxyFast a IO r] -> () -> Producer p a IO ()
merge producers () = runIdentityP $ do
chan <- lift newChan
lift $ forM_ producers $ \producer -> do
let producer' () = do
(producer >-> mapD Just) ()
respond Nothing
forkIO $ runProxy $ producer' >-> toChan chan
fromNChan (length producers) chan ()
Now, let's imagine that we have two sources of input. The first one generates the integers from 1 to 10 in one second intervals:
throttle :: (Proxy p) => Int -> () -> Pipe p a a IO r
throttle microseconds () = runIdentityP $ forever $ do
a <- request ()
respond a
lift $ threadDelay microseconds
source1 :: (Proxy p) => () -> Producer p Int IO ()
source1 = enumFromS 1 10 >-> throttle 1000000
The second source reads three Strings from user input:
source2 :: (Proxy p) => () -> Producer p String IO ()
source2 = getLineS >-> takeB_ 3
We want to combine these two sources, but their output types don't match, so we define an algebraic data type to unify their outputs into a single type:
data Merge = UserInput String | AutoInt Int deriving Show
Now we can combine them into a single list of identically typed producers by wrapping their outputs in our algebraic data type:
producers :: (Proxy p) => [() -> Producer p Merge IO ()]
producers =
[ source1 >-> mapD UserInput
, source2 >-> mapD AutoInt
]
And we can test it out really quickly:
>>> runProxy $ merge producers >-> printD
AutoInt 1
Test<Enter>
UserInput "Test"
AutoInt 2
AutoInt 3
AutoInt 4
AutoInt 5
Apple<Enter>
UserInput "Apple"
AutoInt 6
AutoInt 7
AutoInt 8
AutoInt 9
AutoInt 10
Banana<Enter>
UserInput "Banana"
>>>
Now you have a combined source. You can then write your game engine to just read from that source, pattern match on the input and then behave appropriately:
engine :: (Proxy p) => () -> Consumer p Merge IO ()
engine () = runIdentityP loop where
loop = do
m <- request ()
case m of
AutoInt n -> do
lift $ putStrLn $ "Generate unit wave #" ++ show n
loop
UserInput str -> case str of
"quit" -> return ()
_ -> loop
Let's try it:
>>> runProxy $ merge producers >-> engine
Generate unit wave #1
Generate unit wave #2
Generate unit wave #3
Test<Enter>
Generate unit wave #4
quit<Enter>
>>>
I imagine the same trick will work for netwire.

Elm has a library for Automatons which I believe is similar to what you are doing.
You could use a typeclass for each type of state you want something to have access to. Then implement each of those classes for the entire state of your game (Assuming you have 1 big fat object holding everything).
-- bfgo = Big fat game object
class HasUserInput bfgo where
mouseState :: bfgo -> MouseState
keyState :: bfgo -> KeyState
class HasPositionState bfgo where
positionState :: bfgo -> [Position] -- Use your data structure
Then when you create the functions for using the data, you simply specify the typeclasses those functions will be using.
{-#LANGUAGE RankNTypes #-}
data Player i = Player
{playerRun :: (HasUserInput i) => (i -> Player i)}
data Projectile i = Projectile
{projectileRun :: (HasPositionState i) => (i -> Projectile i)}

Related

Nested States in Haskell

I am trying to define a family of state machines with somewhat different kinds of states. In particular, the more "complex" state machines have states which are formed by combining the states of simpler state machines.
(This is similar to an object oriented setting where an object has several attributes which are also objects.)
Here is a simplified example of what I want to achieve.
data InnerState = MkInnerState { _innerVal :: Int }
data OuterState = MkOuterState { _outerTrigger :: Bool, _inner :: InnerState }
innerStateFoo :: Monad m => StateT InnerState m Int
innerStateFoo = do
i <- _innerVal <$> get
put $ MkInnerState (i + 1)
return i
outerStateFoo :: Monad m => StateT OuterState m Int
outerStateFoo = do
b <- _outerTrigger <$> get
if b
then
undefined
-- Here I want to "invoke" innerStateFoo
-- which should work/mutate things
-- "as expected" without
-- having to know about the outerState it
-- is wrapped in
else
return 666
More generally, I want a generalized framework where these nestings are more complex. Here is something I wish to know how to do.
class LegalState s
data StateLess
data StateWithTrigger where
StateWithTrigger :: LegalState s => Bool -- if this trigger is `True`, I want to use
-> s -- this state machine
-> StateWithTrigger
data CombinedState where
CombinedState :: LegalState s => [s] -- Here is a list of state machines.
-> CombinedState -- The combinedstate state machine runs each of them
instance LegalState StateLess
instance LegalState StateWithTrigger
instance LegalState CombinedState
liftToTrigger :: Monad m, LegalState s => StateT s m o -> StateT StateWithTrigger m o
liftToCombine :: Monad m, LegalState s => [StateT s m o] -> StateT CombinedState m o
For context, this is what I want to achieve with this machinery:
I want to design these things called "Stream Transformers", which are basically stateful functions: They consume a token, mutate their internal state and output something. Specifically, I am interested in a class of Stream Transformers where the output is a Boolean value; we will call these "monitors".
Now, I am trying to design combinators for these objects. Some of them are:
A pre combinator. Suppose that mon is a monitor. Then, pre mon is a monitor which always produces False after the first token is consumed and then mimicks the behaviour of mon as if the previous token is being inserted now. I would want to model the state of pre mon with StateWithTrigger in the example above since the new state is a boolean along with the original state.
An and combinator. Suppose that m1 and m2 are monitors. Then, m1 `and` m2 is a monitor which feeds the token to m1, and then to m2, and then produces True if both of the answers were true. I would want to model the state of m1 `and` m2 with CombinedState in the example above since the state of both monitors must be maintained.
For your first question, as Carl mentioned, zoom from lens does exactly what you want. Your code with lenses could be written like this:
{-# LANGUAGE TemplateHaskell #-}
import Control.Lens
import Control.Monad.State.Lazy
newtype InnerState = MkInnerState { _innerVal :: Int }
deriving (Eq, Ord, Read, Show)
data OuterState = MkOuterState
{ _outerTrigger :: Bool
, _inner :: InnerState
} deriving (Eq, Ord, Read, Show)
makeLenses ''InnerState
makeLenses ''OuterState
innerStateFoo :: Monad m => StateT InnerState m Int
innerStateFoo = do
i <- gets _innerVal
put $ MkInnerState (i + 1)
return i
outerStateFoo :: Monad m => StateT OuterState m Int
outerStateFoo = do
b <- gets _outerTrigger
if b
then zoom inner $ innerStateFoo
else pure 666
Edit: While we're at it, if you're already bringing in lens then innerStateFoo can be written like so:
innerStateFoo :: Monad m => StateT InnerState m Int
innerStateFoo = innerVal <<+= 1
For context, this is what I want to achieve with this machinery:
I want to design these things called "Stream Transformers", which are basically stateful functions: They consume a token, mutate their internal state and output something. Specifically, I am interested in a class of Stream Transformers where the output is a Boolean value; we will call these "monitors".
I think that what you want to achieve doesn't need very much machinery.
newtype StreamTransformer input output = StreamTransformer
{ runStreamTransformer :: input -> (output, StreamTransformer input output)
}
type Monitor input = StreamTransformer input Bool
pre :: Monitor input -> Monitor input
pre st = StreamTransformer $ \i ->
-- NB: the first output of the stream transformer vanishes.
-- Is that OK? Maybe this representation doesn't fit the spec?
let (_, st') = runStreamTransformer st i
in (False, st')
and :: Monitor input -> Monitor input -> Monitor input
and left right = StreamTransformer $ \i ->
let (bleft, mleft) = runStreamTransformer left i
(bright, mright) = runStreamTransformer right i
in (bleft && bright, mleft `and` mright)
This StreamTransformer is not necessarily stateful, but admits stateful ones. You don't need to (and IMO should not! in most cases!!) reach for typeclasses in order to define these (or indeed ever! :) but that's another topic).
notStateful :: StreamTransformer input ()
notStateful = StreamTransformer $ \_ -> ((), notStateful)
stateful :: s -> (input -> s -> (output, s)) -> StreamTransformer input output
stateful s k = StreamTransformer $ \input ->
let (output, s') = k input s
in (output, stateful s' k)
alternateBool :: Monitor anything
alternateBool = stateful True $ \_ s -> (s, not s)

Abstraction for monadic recursion with "unless"

I'm trying to work out if it's possible to write an abstraction for the following situation. Suppose I have a type a with function a -> m Bool e.g. MVar Bool and readMVar. To abstract this concept out I create a newtype wrapper for the type and its function:
newtype MPredicate m a = MPredicate (a,a -> m Bool)
I can define a fairly simple operation like so:
doUnless :: (Monad m) => Predicate m a -> m () -> m ()
doUnless (MPredicate (a,mg)) g = mg a >>= \b -> unless b g
main = do
b <- newMVar False
let mpred = MPredicate (b,readMVar)
doUnless mpred (print "foo")
In this case doUnless would print "foo". Aside: I'm not sure whether a type class might be more appropriate to use instead of a newtype.
Now take the code below, which outputs an incrementing number then waits a second and repeats. It does this until it receives a "turn off" instruction via the MVar.
foobar :: MVar Bool -> IO ()
foobar mvb = foobar' 0
where
foobar' :: Int -> IO ()
foobar' x = readMVar mvb >>= \b -> unless b $ do
let x' = x + 1
print x'
threadDelay 1000000
foobar' x'
goTillEnter :: MVar Bool -> IO ()
goTillEnter mv = do
_ <- getLine
_ <- takeMVar mv
putMVar mv True
main = do
mvb <- newMVar False
forkIO $ foobar mvb
goTillEnter mvb
Is it possible to refactor foobar so that it uses MPredicate and doUnless?
Ignoring the actual implementation of foobar' I can think of a simplistic way of doing something similar:
cycleUnless :: x -> (x -> x) -> MPredicate m a -> m ()
cycleUnless x g mp = let g' x' = doUnless mp (g' $ g x')
in g' $ g x
Aside: I feel like fix could be used to make the above neater, though I still have trouble working out how to use it
But cycleUnless won't work on foobar because the type of foobar' is actually Int -> IO () (from the use of print x').
I'd also like to take this abstraction further, so that it can work threading around a Monad. With stateful Monads it becomes even harder. E.g.
-- EDIT: Updated the below to show an example of how the code is used
{- ^^ some parent function which has the MVar ^^ -}
cycleST :: (forall s. ST s (STArray s Int Int)) -> IO ()
cycleST sta = readMVar mvb >>= \b -> unless b $ do
n <- readMVar someMVar
i <- readMVar someOtherMVar
let sta' = do
arr <- sta
x <- readArray arr n
writeArray arr n (x + i)
return arr
y = runSTArray sta'
print y
cycleST sta'
I have something similar to the above working with RankNTypes. Now there's the additional problem of trying to thread through the existential s, which is not likely to type check if threaded around through an abstraction the likes of cycleUnless.
Additionally, this is simplified to make the question easier to answer. I also use a set of semaphores built from MVar [MVar ()] similar to the skip channel example in the MVar module. If I can solve the above problem I plan to generalize the semaphores as well.
Ultimately this isn't some blocking problem. I have 3 components of the application operating in a cycle off the same MVar Bool but doing fairly different asynchronous tasks. In each one I have written a custom function that performs the appropriate cycle.
I'm trying to learn the "don't write large programs" approach. What I'd like to do is refactor chunks of code into their own mini libraries so that I'm not building a large program but assembling lots of small ones. But so far this particular abstraction is escaping me.
Any thoughts on how I might go about this are very much appreciated!
You want to cleanly combine a stateful action having side effects, a delay, and an independent stopping condition.
The iterative monad transformer from the free package can be useful in these cases.
This monad transformer lets you describe a (possibly nonending) computation as a series of discrete steps. And what's better, it let's you interleave "stepped" computations using mplus. The combined computation stops when any of the individual computations stops.
Some preliminary imports:
import Data.Bool
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Iter (delay,untilJust,IterT,retract,cutoff)
import Control.Concurrent
Your foobar function could be understood as a "sum" of three things:
A computation that does nothing but reading from the MVar at each step, and finishes when the Mvar is True.
untilTrue :: (MonadIO m) => MVar Bool -> IterT m ()
untilTrue = untilJust . liftM guard . liftIO . readMVar
An infinite computation that takes a delay at each step.
delays :: (MonadIO m) => Int -> IterT m a
delays = forever . delay . liftIO . threadDelay
An infinite computation that prints an increasing series of numbers.
foobar' :: (MonadIO m) => Int -> IterT m a
foobar' x = do
let x' = x + 1
liftIO (print x')
delay (foobar' x')
With this in place, we can write foobar as:
foobar :: (MonadIO m) => MVar Bool -> m ()
foobar v = retract (delays 1000000 `mplus` untilTrue v `mplus` foobar' 0)
The neat thing about this is that you can change or remove the "stopping condition" and the delay very easily.
Some clarifications:
The delay function is not a delay in IO, it just tells the iterative monad transformer to "put the argument in a separate step".
retract brings you back from the iterative monad transformer to the base monad. It's like saying "I don't care about the steps, just run the computation". You can combine retract with cutoff if you want to limit the maximum number of iterations.
untilJustconverts a value m (Maybe a) of the base monad into a IterT m a by retrying in each step until a Just is returned. Of course, this risks non-termination!
MPredicate is rather superfluous here; m Bool can be used instead. The monad-loops package contains plenty of control structures with m Bool conditions. whileM_ in particular is applicable here, although we need to include a State monad for the Int that we're threading around:
import Control.Monad.State
import Control.Monad.Loops
import Control.Applicative
foobar :: MVar Bool -> IO ()
foobar mvb = (`evalStateT` (0 :: Int)) $
whileM_ (not <$> lift (readMVar mvb)) $ do
modify (+1)
lift . print =<< get
lift $ threadDelay 1000000
Alternatively, we can use a monadic version of unless. For some reason monad-loops doesn't export such a function, so let's write it:
unlessM :: Monad m => m Bool -> m () -> m ()
unlessM mb action = do
b <- mb
unless b action
It's somewhat more convenient and more modular in a monadic setting, since we can always go from a pure Bool to m Bool, but not vice versa.
foobar :: MVar Bool -> IO ()
foobar mvb = go 0
where
go :: Int -> IO ()
go x = unlessM (readMVar mvb) $ do
let x' = x + 1
print x'
threadDelay 1000000
go x'
You mentioned fix; sometimes people indeed use it for ad-hoc monadic loops, for example:
printUntil0 :: IO ()
printUntil0 =
putStrLn "hello"
fix $ \loop -> do
n <- fmap read getLine :: IO Int
print n
when (n /= 0) loop
putStrLn "bye"
With some juggling it's possible to use fix with multi-argument functions. In the case of foobar:
foobar :: MVar Bool -> IO ()
foobar mvb = ($(0 :: Int)) $ fix $ \loop x -> do
unlessM (readMVar mvb) $ do
let x' = x + 1
print x'
threadDelay 1000000
loop x'
I'm not sure what's your MPredicate is doing.
First, instead of newtyping a tuple, it's probably better to use a normal algebric data type
data MPredicate a m = MPredicate a (a -> m Bool)
Second, the way you use it, MPredicate is equivalent to m Bool.
Haskell is lazzy, therefore there is no need to pass, a function and it's argument (even though
it's usefull with strict languages). Just pass the result, and the function will be called when needed.
I mean, instead of passing (x, f) around, just pass f x
Of course, if you are not trying to delay the evaluation and really need at some point, the argument or the function as well as the result, a tuple is fine.
Anyway, in the case your MPredicate is only there to delay the function evaluation, MPredicat reduces to m Bool and doUnless to unless.
Your first example is strictly equivalent :
main = do
b <- newMVar False
unless (readMVar b) (print "foo")
Now, if you want to loop a monad until a condition is reach (or equivalent) you should have a look at the monad-loop package. What you are looking it at is probably untilM_ or equivalent.

Getting input into Netwire programs

I'm getting started with Netwire version 5.
I have no problem writing all the wires I want to transform my inputs into my outputs.
Now the time has come to write the IO wrapper to tie in my real-world inputs, and I am a bit confused.
Am I supposed to create a custom session type for the s parameter of Wire s e m a b and embed my sensor values in there?
If so, I have these questions:
What's up with the Monoid s context of class (Monoid s, Real t) => HasTime t s | s -> t? What is it used for?
I was thinking of tacking on a Map String Double with my sensor readings, but how should my monoid crunch the dictionaries? Should it be left-biased? Right-biased? None of the above?
If not, what am I supposed to do? I want to end up with wires of the form Wire s InhibitionReason Identity () Double for some s, representing my input.
It's my understanding that I don't want or need to use the monadic m parameter of Wire for this purpose, allowing the wires themselves to be pure and confining the IO to the code that steps through the top-level wire(s). Is this incorrect?
The simplest way to put data into a Wire s e m a b is via the input a. It's possible, through the use of WPure or WGen to get data out of the state delta s or the underlying Monad m, but these take us further away from the main abstractions. The main abstractions are Arrow and Category, which only know about a b, and not about s e m.
Here's an example of a very simple program, providing input as the input a. double is the outermost wire of the program. repl is a small read-eval-print loop that calls stepWire to run the wire.
import FRP.Netwire
import Control.Wire.Core
import Prelude hiding (id, (.))
double :: Arrow a => a [x] [x]
double = arr (\xs -> xs ++ xs)
repl :: Wire (Timed Int ()) e IO String String -> IO ()
repl w = do
a <- getLine
(eb, w') <- stepWire w (Timed 1 ()) (Right a)
putStrLn . either (const "Inhibited") id $ eb
repl w'
main = repl double
Notice that we pass in the time difference to stepWire, not the total elapsed time. We can check that this is the correct thing to do by running a different top-level wire.
timeString :: (HasTime t s, Show t, Monad m) => Wire s e m a String
timeString = arr show . time
main = repl timeString
Which has the desired output:
a
1
b
2
c
3
I just solved this in an Arrow way, so this might be more composible. You can read my posts if you like. Kleisli Arrow in Netwire 5? and Console interactivity in Netwire?. The second post has a complete interactive program
First, you need this to lift Kleisli functions (That is, anything a -> m b):
mkKleisli :: (Monad m, Monoid e) => (a -> m b) -> Wire s e m a b
mkKleisli f = mkGen_ $ \a -> liftM Right $ f a
Then, assuming you want to get characters from terminal, you can lift hGetChar by doing this:
inputWire :: Wire s () IO () Char
inputWire = mkKleisli $ \_ -> hGetChar stdin
I haven't tested this runWire function (I just stripped code off from my previous posts), but it should run your wires:
runWire :: (Monad m) => Session m s -> Wire s e m () () -> m ()
runWire s w = do
(ds, s') <- stepSession s
-- | You don't really care about the () returned
(_, w') <- stepWire w ds (Right ())
runWire s' w'
You can compose the input wire wherever you like like any other Wires or Arrows. In my example, I did this (don't just copy, other parts of the program are different):
mainWire = proc _ -> do
c <- inputWire -< ()
q <- quitWire -< c
outputWire -< c
returnA -< q
Or, one-liner:
mainWire = inputWire >>> (quitWire &&& outputWire) >>> arr (\(q,_) -> q)

Generalizing a function to merge a set of Haskell pipes Producers

I am working with the Haskell pipes package.
I am trying to use pipes-concurrency to merge a list of Producers together.
What I want to arrive at is:
merge :: MonadIO m => [Producer a m ()] -> Producer a m ()
so given a producer s1 and another producer s2: r = merge [s1, s2]
which would give the behaviour:
s1 --1--1--1--|
s2 ---2---2---2|
r --12-1-21--2|
Following the code in the tutorial page I came up with:
mergeIO :: [Producer a IO ()] -> Producer a IO ()
mergeIO producers = do
(output, input) <- liftIO $ spawn Unbounded
_ <- liftIO $ mapM (fork output) producers
fromInput input
where
fork :: Output a -> Producer a IO () -> IO ()
fork output producer = void $ forkIO $ do runEffect $ producer >-> toOutput output
performGC
which works as expected.
However I am having difficulty generalizing things.
My attempt:
merge :: (MonadIO m) => [Producer a m ()] -> Producer a m ()
merge producers = do
(output, input) <- liftIO $ spawn Unbounded
_ <- liftIO $ mapM (fork output) producers
fromInput input
where
runEffectIO :: Monad m => Effect m r -> IO (m r)
runEffectIO e = do
x <- evaluate $ runEffect e
return x
fork output producer = forkIO $ do runEffectIO $ producer >-> toOutput output
performGC
Unfortunately this compiles but does not do all too much else. I am guessing that I am making a mess of runEffectIO. Other approaches to my current runEffectIO have yielded no better results.
The program:
main = do
let producer = merge [repeater 1 (100 * 1000), repeater 2 (150 * 1000)]
_ <- runEffect $ producer >-> taker 20
where repeater :: Int -> Int -> Producer Int IO r
repeater val delay = forever $ do
lift $ threadDelay delay
yield val
taker :: Int -> Consumer Int IO ()
taker 0 = return ()
taker n = do
val <- await
liftIO $ putStrLn $ "Taker " ++ show n ++ ": " ++ show val
taker $ n - 1
hits val <- await but does not get to liftIO $ putStrLn thus it produces no output. However it exits fine without hanging.
When I substitute in mergeIO for merge then the program runs I would expect outputting 20 lines.
While MonadIO is not sufficient for this operation, MonadBaseControl (from monad-control) is designed to allow embedding arbitrary transformer stacks inside the base monad. The companion package lifted-base provides a version of fork which will work for transformer stacks. I've put together an example of using it to solve your problem in the following Gist, though the main magic is:
import qualified Control.Concurrent.Lifted as L
fork :: (MonadBaseControl IO m, MonadIO m) => Output a -> Producer a m () -> m ThreadId
fork output producer = L.fork $ do
runEffect $ producer >-> toOutput output
liftIO performGC
Note that you should understand what happens to monadic states when treated this way: modifications to any mutable state performed in the child threads will be isolated to just those child threads. In other words, if you were using a StateT, each child thread would start off with the same state value that was in context when it was forked, but then you would have many different states that do not update each other.
There's an appendix in the Yesod book on monad-control, though frankly it's a bit dated. I'm just not aware of any more recent tutorials.
The problem seems to be your use of evaluate, which I assume it is the evaluate from Control.Exception.
You seem to be using it to "convert" a value inside the generic monad m into IO, but it doesn't really work that way. You are just obtaining the m value out of the Effect and then returning it inside IO without actually executing it. The following code doesn't print "foo":
evaluate (putStrLn "foo") >> return ""
Maybe your merge function could take as an additional parameter a function m a -> IO a so that merge knows how to bring the result of runEffect into IO.
Unfortunately, you can't fork a Producer with a MonadIO base monad (or any MonadIO computation for that matter). You need to specifically include the logic necessary to run all other monad transformers to get back an IO action before you can fork the computation.

How can I write a pipe that sends downstream a list of what it receives from upstream?

I'm having a hard time to write a pipe with this signature:
toOneBigList :: (Monad m, Proxy p) => () -> Pipe p a [a] m r
It should simply take all as from upstream and send them in a list downstream.
All my attempts look fundamentally broken.
Can anybody point me in the right direction?
There are two pipes-based solutions and I'll let you pick which one you prefer.
Note: It's not clear why you output the list on the downstream interface instead of just returning it directly as a result.
Conduit-style
The first one, which is very close to the conduit-based solution uses the upcoming pipes-pase, which is basically complete and just needs documentation. You can find the latest draft on Github.
Using pipes-parse, the solution is identical to the conduit solution that Petr gave:
import Control.Proxy
import Control.Proxy.Parse
combine
:: (Monad m, Proxy p)
=> () -> Pipe (StateP [Maybe a] p) (Maybe a) [a] m ()
combine () = loop []
where
loop as = do
ma <- draw
case ma of
Nothing -> respond (reverse as)
Just a -> loop (a:as)
draw is like conduit's await: it requests a value from either the leftovers buffer (that's the StateP part) or from upstream if the buffer is empty. Nothing indicates end of file.
You can wrap a pipe that does not have an end of file signal using the wrap function from pipes-parse, which has type:
wrap :: (Monad m, Proxy p) => p a' a b' b m r -> p a' a b' (Maybe b) m s
Classic Pipes Style
The second alternative is a bit simpler. If you want to fold a given pipe you can do so directly using WriterP:
import Control.Proxy
import Control.Proxy.Trans.Writer
foldIt
:: (Monad m, Proxy p) =>
(() -> Pipe p a b m ()) -> () -> Pipe p a [b] m ()
foldIt p () = runIdentityP $ do
r <- execWriterK (liftP . p >-> toListD >-> unitU) ()
respond r
That's a higher-level description of what is going on, but it requires passing in the pipe as an explicit argument. It's up to you which one you prefer.
By the way, this is why I was asking why you want to send a single value downstream. The above is much simpler if you return the folded list:
foldIt p = execWriterK (liftP . p >-> toListD)
The liftP might not even be necessary if p is completely polymorphic in its proxy type. I only include it as a precaution.
Bonus Solution
The reason pipes-parse does not provide the toOneBigList is that it's always a pipes anti-pattern to group the results into a list. pipes has several nice features that make it possible to never have to group the input into a list, even if you are trying to yield multiple lists. For example, using respond composition you can have a proxy yield the subset of the stream it would have traversed and then inject a handler that uses that subset:
example :: (Monad m, Proxy p) => () -> Pipe p a (() -> Pipe p a a m ()) m r
example () = runIdentityP $ forever $ do
respond $ \() -> runIdentityP $ replicateM_ 3 $ request () >>= respond
printIt :: (Proxy p, Show a) => () -> Pipe p a a IO r
printIt () = runIdentityP $ do
lift $ putStrLn "Here we go!"
printD ()
useIt :: (Proxy p, Show a) => () -> Pipe p a a IO r
useIt = example />/ (\p -> (p >-> printIt) ())
Here's an example of how to use it:
>>> runProxy $ enumFromToS 1 10 >-> useIt
Here we go!
1
2
3
Here we go!
4
5
6
Here we go!
7
8
9
Here we go!
10
This means you never need to bring a single element into memory even when you need to group elements.
I'll give only a partial answer, perhaps somebody else will have a better one.
As far as I know, standard pipes have no mechanism of detecting when the other part of the pipeline terminates. The first pipe that terminates produces the final result of the pipe-line and all the others are just dropped. So if you have a pipe that consumes input forever (to eventually produce a list), it will have no chance acting and producing output when its upstream finishes. (This is intentional so that both up- and down-stream parts are dual to each other.) Perhaps this is solved in some library building on top of pipes.
The situation is different with conduit. It has consume function that combines all inputs into a list and returns (not outputs) it. Writing a function like the one you need, that outputs the list at the end, is not difficult:
import Data.Conduit
combine :: (Monad m) => Conduit a m [a]
combine = loop []
where
loop xs = await >>= maybe (yield $ reverse xs) (loop . (: xs))

Resources