Related
I'm using a state transformer to randomly sample a dataset at every point of a 2D recursive walk, which outputs a list of 2D grids of samples that together succeed a condition. I'd like to pull from the results lazily, but my approach instead exhausts the whole dataset at every point before I can pull the first result.
To be concrete, consider this program:
import Control.Monad ( sequence, liftM2 )
import Data.Functor.Identity
import Control.Monad.State.Lazy ( StateT(..), State(..), runState )
walk :: Int -> Int -> [State Int [Int]]
walk _ 0 = [return [0]]
walk 0 _ = [return [0]]
walk x y =
let st :: [State Int Int]
st = [StateT (\s -> Identity (s, s + 1)), undefined]
unst :: [State Int Int] -- degenerate state tf
unst = [return 1, undefined]
in map (\m_z -> do
z <- m_z
fmap concat $ sequence [
liftM2 (zipWith (\x y -> x + y + z)) a b -- for 1D: map (+z) <$> a
| a <- walk x (y - 1) -- depth
, b <- walk (x - 1) y -- breadth -- comment out for 1D
]
) st -- vs. unst
main :: IO ()
main = do
std <- getStdGen
putStrLn $ show $ head $ fst $ (`runState` 0) $ head $ walk 2 2
The program walks the rectangular grid from (x, y) to (0, 0) and sums all the results, including the value of one of the lists of State monads: either the non-trivial transformers st that read and advance their state, or the trivial transformers unst. Of interest is whether the algorithm explores past the heads of st and unst.
In the code as presented, it throws undefined. I chalked this up to a misdesign of my order of chaining the transformations, and in particular, a problem with the state handling, as using unst instead (i.e. decoupling the result from state transitions) does produce a result. However, I then found that a 1D recursion also preserves laziness even with the state transformer (remove the breadth step b <- walk... and swap the liftM2 block for fmap).
If we trace (show (x, y)), we also see that it does walk the whole grid before triggering:
$ cabal run
Build profile: -w ghc-8.6.5 -O1
...
(2,2)
(2,1)
(1,2)
(1,1)
(1,1)
sandbox: Prelude.undefined
I suspect that my use of sequence is at fault here, but as the choice of monad and the dimensionality of the walk affect its success, I can't say broadly that sequenceing the transformations is the source of strictness by itself.
What's causing the difference in strictness between 1D and 2D recursion here, and how can I achieve the laziness I want?
Consider the following simplified example:
import Control.Monad.State.Lazy
st :: [State Int Int]
st = [state (\s -> (s, s + 1)), undefined]
action1d = do
a <- sequence st
return $ map (2*) a
action2d = do
a <- sequence st
b <- sequence st
return $ zipWith (+) a b
main :: IO ()
main = do
print $ head $ evalState action1d 0
print $ head $ evalState action2d 0
Here, in both the 1D and 2D calculations, the head of the result depends explicitly only on the heads of the inputs (just head a for the 1D action and both head a and head b for the 2D action). However, in the 2D calculation, there's an implicit dependency of b (even just its head) on the current state, and that state depends on the evaluation of the entirety of a, not just its head.
You have a similar dependency in your example, though it's obscured by the use of lists of state actions.
Let's say we wanted to run the action walk22_head = head $ walk 2 2 manually and inspect the first integer in the resulting list:
main = print $ head $ evalState walk22_head
Writing the elements of the state action list st explicitly:
st1, st2 :: State Int Int
st1 = state (\s -> (s, s+1))
st2 = undefined
we can write walk22_head as:
walk22_head = do
z <- st1
a <- walk21_head
b <- walk12_head
return $ zipWith (\x y -> x + y + z) a b
Note that this depends only on the defined state action st1 and the heads of walk 2 1 and walk 1 2. Those heads, in turn, can be written:
walk21_head = do
z <- st1
a <- return [0] -- walk20_head
b <- walk11_head
return $ zipWith (\x y -> x + y + z) a b
walk12_head = do
z <- st1
a <- walk11_head
b <- return [0] -- walk02_head
return $ zipWith (\x y -> x + y + z) a b
Again, these depend only on the defined state action st1 and the head of walk 1 1.
Now, let's try to write down a definition of walk11_head:
walk11_head = do
z <- st1
a <- return [0]
b <- return [0]
return $ zipWith (\x y -> x + y + z) a b
This depends only on the defined state action st1, so with these definitions in place, if we run main, we get a defined answer:
> main
10
But these definitions aren't accurate! In each of walk 1 2 and walk 2 1, the head action is a sequence of actions, starting with the action that invokes walk11_head, but continuing with actions based on walk11_tail. So, more accurate definitions would be:
walk21_head = do
z <- st1
a <- return [0] -- walk20_head
b <- walk11_head
_ <- walk11_tail -- side effect of the sequennce
return $ zipWith (\x y -> x + y + z) a b
walk12_head = do
z <- st1
a <- walk11_head
b <- return [0] -- walk02_head
_ <- walk11_tail -- side effect of the sequence
return $ zipWith (\x y -> x + y + z) a b
with:
walk11_tail = do
z <- undefined
a <- return [0]
b <- return [0]
return [zipWith (\x y -> x + y + z) a b]
With these definitions in place, there's no problem running walk12_head and walk21_head in isolation:
> head $ evalState walk12_head 0
1
> head $ evalState walk21_head 0
1
The state side effects here are not needed to calculate the answer and so never invoked. But, it's not possible to run them both in sequence:
> head $ evalState (walk12_head >> walk21_head) 0
*** Exception: Prelude.undefined
CallStack (from HasCallStack):
error, called at libraries/base/GHC/Err.hs:78:14 in base:GHC.Err
undefined, called at Lazy2D_2.hs:41:8 in main:Main
Therefore, trying to run main fails for the same reason:
> main
*** Exception: Prelude.undefined
CallStack (from HasCallStack):
error, called at libraries/base/GHC/Err.hs:78:14 in base:GHC.Err
undefined, called at Lazy2D_2.hs:41:8 in main:Main
because, in calculating walk22_head, even the very beginning of walk21_head's calculation depends on the state side effect walk11_tail initiated by walk12_head.
Your original walk definition behaves the same way as these mockups:
> head $ evalState (head $ walk 1 2) 0
1
> head $ evalState (head $ walk 2 1) 0
1
> head $ evalState (head (walk 1 2) >> head (walk 2 1)) 0
*** Exception: Prelude.undefined
CallStack (from HasCallStack):
error, called at libraries/base/GHC/Err.hs:78:14 in base:GHC.Err
undefined, called at Lazy2D_0.hs:15:49 in main:Main
> head $ evalState (head (walk 2 2)) 0
*** Exception: Prelude.undefined
CallStack (from HasCallStack):
error, called at libraries/base/GHC/Err.hs:78:14 in base:GHC.Err
undefined, called at Lazy2D_0.hs:15:49 in main:Main
It's hard to say how to fix this. Your toy example was excellent for the purposes of illustrating the problem, but it's not clear how the state is used in your "real" problem and if head $ walk 2 1 really has a state dependency on the sequence of walk 1 1 actions induced by head $ walk 1 2.
The accepted answer by K.A. Buhr is right: while getting the head of one step in each direction is fine (try walk with either x < 2 or y < 2) the combination of the implicit >>= in liftM2, the sequence in the value of a and the state dependency in the value of b makes b depend on all side effects of a. As he also pointed out, a working solution depends on what dependencies are actually wanted.
I'll share a solution for my particular case: each walk call depends on the state of the caller at least, and perhaps some other states, based on a pre-order traversal of the grid and alternatives in st. In addition, as the question suggests, I want to try to make a full result before testing any unneeded alternatives in st. This is a little difficult to explain visually, but here's the best I could do: the left shows the variable number of st alternatives at each coordinate (which is what I have in my actual use case) and the right shows a [rather messy] map of the desired dependency order of the state: we see it traverses x-y first in a 3D DFS, with "x" as depth (fastest axis), "y" as breadth (middle axis), then finally alternatives as the slowest axis (shown in dashed lines with open circles).
The central issue in the original implementation came from sequencing lists of state transitions to accommodate the non-recursive return type. Let's replace the list type altogether with a type that's recursive in the monad parameter, so the caller can better control the dependency order:
data ML m a = MCons a (MML m a) | MNil -- recursive monadic list
newtype MML m a = MML (m (ML m a)) -- base case wrapper
An example of [1, 2]:
MCons 1 (MML (return (MCons 2 (MML (return MNil)))))
Functor and Monoid behaviors are used often, so here's the relevant implementations:
instance Functor m => Functor (ML m) where
fmap f (MCons a m) = MCons (f a) (MML $ (fmap f) <$> coerce m)
fmap _ MNil = MNil
instance Monad m => Semigroup (MML m a) where
(MML l) <> (MML r) = MML $ l >>= mapper where
mapper (MCons la lm) = return $ MCons la (lm <> (MML r))
mapper MNil = r
instance Monad m => Monoid (MML m a) where
mempty = MML (pure MNil)
There are two critical operations: combining steps in two different axes, and combining lists from different alternatives at the same coordinate. Respectively:
Based on the diagram, we want to get a single full result from the x step first, then a full result from the y step. Each step returns a list of results from all combinations of viable alternatives from inner coordinates, so we take a Cartesian product over both lists, also biased in one direction (in this case y fastest). First we define a "concatenation" that applies a base case wrapper MML at the end of a bare list ML:
nest :: Functor m => MML m a -> ML m a -> ML m a
nest ma (MCons a mb) = MCons a (MML $ nest ma <$> coerce mb)
then a Cartesian product:
prodML :: Monad m => (a -> a -> a) -> ML m a -> ML m a -> ML m a
prodML f x (MCons ya ym) = (MML $ prodML f x <$> coerce ym) `nest` ((f ya) <$> x)
prodML _ MNil _ = MNil
We want to smash the lists from different alternatives into one list and we don't care that this introduces dependencies between alternatives. This is where we use mconcat from the Monoid instance.
All in all, it looks like this:
walk :: Int -> Int -> MML (State Int) Int
-- base cases
walk _ 0 = MML $ return $ MCons 1 (MML $ return MNil)
walk 0 _ = walk 0 0
walk x y =
let st :: [State Int Int]
st = [StateT (\s -> Identity (s, s + 1)), undefined]
xstep = coerce $ walk (x-1) y
ystep = coerce $ walk x (y-1)
-- point 2: smash lists with mconcat
in mconcat $ map (\mz -> MML $ do
z <- mz
-- point 1: product over results
liftM2 ((fmap (z+) .) . prodML (+)) xstep ystep
) st
headML (MCons a _) = a
headML _ = undefined
main :: IO ()
main = putStrLn $ show $ headML $ fst $ (`runState` 0) $ (\(MML m) -> m) $ walk 2 2
Note the result have changed with the semantics. It doesn't matter to me since my goal only needed to pull random numbers from state, and whatever dependency order is needed can be controlled with the right shepherding of list elements into the final result.
(I'll also warn that without memoization or attention to strictness, this implementation is very inefficient for large x and y.)
I'm writing a program to allocate pizzas to people; each person will get one pizza, ideally of their favorite type, unless stock has run out, in which case they are given their next favorite type recursively.
My approach is to compute a ((User, Pizza), Int) for the amount a person would like said pizza, sort those, and recurse through using a state monad to keep inventory counts.
The program is written and type checks:
allocatePizzasImpl :: [((User, Pizza), Int)]
-> State [(Pizza, Int)] [(User, Pizza)]
allocatePizzasImpl [] = return []
allocatePizzasImpl ((user, (flavor, _)):ranks) =
do inventory <- get
-- this line is never hit
put $ updateWith inventory (\i -> if i <= 0
then Nothing
else Just $ i - 1) flavor
next <- allocatePizzasImpl $ filter ((/= user) . fst) ranks
return $ (user, flavor) : next
and I have a helper function to extract the result:
allocatePizzas :: [Pizza]
-> [((User, Pizza), Int)]
-> [(User, Pizza)]
allocatePizzas pizzas rank = fst
. runState (allocatePizzasImpl rank)
$ buildQuotas pizzas
but the line indicated by -- this line is never hit is... never hit by any GHCI breakpoints; furthermore, if I break on the return call, GHCI says inventory isn't in scope.
When run, the result is assigning the same pizza (with one inventory count) to all users. Something is going wrong, but I have absolutely no idea how to proceed. I'm new to Haskell, so any comments on style would be appreciated as well =)
Thanks!
PS: For completeness, updateWith is defined as:
updateWith :: (Eq a, Eq b)
=> [(a, b)] -- inventory
-> (b -> Maybe b) -- update function; Nothing removes it
-> a -- key to update
-> [(a, b)]
updateWith set update key =
case lookup key set of
Just b -> replace set
(unwrapPair (key, update b))
(fromMaybe 0 $ elemIndex (key, b) set)
Nothing -> set
where replace :: [a] -> Maybe a -> Int -> [a]
replace [] _ _ = []
replace (_:xs) (Just val) 0 = val:xs
replace (_:xs) Nothing 0 = xs
replace (x:xs) val i = x : (replace xs val $ i - 1)
unwrapPair :: Monad m => (a, m b) -> m (a, b)
unwrapPair (a, mb) = do b <- mb
return (a, b)
I think your function replace is broken:
replace (_:xs) (Just val) 0 = val:xs
This doesn't pay any attention to the value it's replacing. Wasn't your intention to replace just the pair corresponding to key?
I think you want
updateWith [] e k = []
updateWith ((k', v):kvs) e k
| k' == k = case e v of
Just v' -> (k, v'):kvs
Nothing -> kvs
| otherwise = (k', v) : updateWith kvs e k
The issue (ignoring other conceptual things mentioned by the commenters) turned out to be using fst to extract the result from the State would for some reason not cause the State to actually be computed. Running the result through seq fixed it.
I'd be interested in knowing why this is the case, though!
Edit: As Daniel Wagner pointed out in the comments, I wasn't actually using inventory, which turned out to be the real bug. Marking this as accepted.
I had just written a piece of Haskell code where in order to debug my code I put in a bunch of print statements in my code (so, my most important function returned IO t, when it just needed to return t) and I saw that this function, on a successful run, would take up a lot of memory (roughly 1.2GB). Once I saw that the program was working fine, I removed all the print statements from the function and ran it, only to realize that it was giving me this error:
Stack space overflow: current size 8388608 bytes.
Use `+RTS -Ksize -RTS' to increase it.
Even though it was the same exact piece of code, for some reason the print statements made it ignore stack space overflow. Can anyone enlighten me as to why this happens?
I know I haven't provided my code which might make it harder to answer this question, but I've hacked a bunch of things together and it doesn't look very pretty so I doubt it would be useful and I am fairly certain that the only difference is the print statements.
EDIT:
Since people really wanted to see the code here is the relevant part:
linkCallers :: ([Int], Int, Int, I.IntDisjointSet, IntMap Int) -> ([Int], Int, Int, I.IntDisjointSet, IntMap Int)
linkCallers ([], x, y, us, im) = ([], x, y, us, im)
linkCallers ((a:b:r), x, y, us, im) = if a == b
then (r, x, y+1, us, im)
else if sameRep
then (r, x+1, y+1, us, im)
else (r, x+1, y+1, us', im')
where
ar = fst $ I.lookup a us
br = fst $ I.lookup b us
sameRep = case ar of
Nothing -> False
_ -> ar == br
as' = ar >>= flip lookup im
bs' = br >>= flip lookup im
totalSize = do
asize <- as'
bsize <- bs'
return $ asize + bsize
maxSize = (convertMaybe as') + (convertMaybe bs')
us' = I.union a b $ I.insert a $ I.insert b $ us
newRep = fromJust $ fst $ I.lookup a us'
newRep' = fromJust $ fst $ I.lookup b us'
im'' = case ar of
Nothing -> case br of
Nothing -> im
Just bk -> delete bk im
Just ak -> delete ak $ case br of
Nothing -> im
Just bk -> delete bk im
im' = case totalSize of
Nothing -> insert newRep maxSize im''
Just t -> insert newRep t im''
startLinkingAux' (c,x,y,us,im) = let t#(_,x',_,us',im') = linkCallers (c,x,y,us,im) in
case (fst $ I.lookup primeMinister us') >>= flip lookup im' >>= return . (>=990000) of
Just True -> x'
_ -> startLinkingAux' t
startLinkingAux' used to look something like this:
startLinkingAux' (c,x,y,us,im) = do
print (c,x,y,us,im)
let t#(_,x',_,us',im') = linkCallers (c,x,y,us,im) in
case (fst $ I.lookup primeMinister us') >>= flip lookup im' >>= return . (>=990000) of
Just True -> return x'
_ -> startLinkingAux' t
There could be a memory leak in one of the arguments. Probably the first thing I'd try would be to ask the author of disjoint-set to add a RFData instance for IntDisjointSet (or do it yourself, looking at the source code, it'd fairly easy). Then try calling force on all values returned by linkCallers to see if it helps.
Second, you're not using disjoint-set right. The main idea of the algorithm is that lookups compress paths in the set. This is what gives it it's great performance! So every time you make a lookup, you should replace your old set with a new one. But this makes using a disjoint set quite clumsy in a functional language. It'd suggest to use the State monad for this and use it internally in linkCallers, as one big do block instead of where, just passing the starting set and extracting the final one. And define functions like
insertS :: (MonadState IntDisjointSet m) => Int -> m ()
insertS x = modify (insert x)
lookupS :: (MonadState IntDisjointSet m) => Int -> m (Maybe Int)
lookupS x = state (lookup x)
-- etc
to use inside State. (Perhaps they'd be a good contribution to the library as well as this will be probably a common problem.)
Finally, there are lot of small improvements that can make the code more readable:
Many times you're applying a single function to two values. I'd suggest to define something like
onPair :: (a -> b) -> (a, a) -> (b, b)
onPair f (x, y) = (f x, f y)
-- and use it like:
(ar, br) = onPair (fst . flip I.lookup us) (a, b)
Also using Applicative functions can make things shorter:
sameRep = fromMaybe False $ (==) <$> ar <*> br
totalSize = (+) <$> as' <*> bs'
then also
im'' = maybe id delete ar . maybe id delete br $ im
im' = insert newRep (fromJust maxSize totalSize) im''
Hope it helps.
So I have a Tic Tac Toe board, in the form of nested tuples, like so:
type Row = (Field, Field, Field)
type Board = (Row, Row, Row)
data Field = X | O | B
deriving (Eq, Ord)
Where B stands for empty. I need to take a player, a given board state, and then generate a list of all possible board states after the next move.
moves :: Player -> Board -> [Board]
However, I just can't figure it out. My initial thought is that I need to iterate through every field, to check whether or not it is empty, and then add a new Board to the list or do nothing. However, I see no way to iterate through all the fields. Even if I manually check every field with if statement or guards, how do I move onto the next field to check it, regardless of whether I end up with a possible move or not?
If I convert the board format into a list I could do it, but I feel like that defeats the purpose of this problem. There's got to be a better solution that doesn't require restructuring Board.
You're not going to be able to iterate through the fields of a tuple -- tuples aren't intended for that. A list of lists is probably a more natural representation for this problem.
That said, you can implement this function with the board representation you're using by following the types. A move on a Board is a move on either the first, second, or third row. A move on a row is the placement of the player on either the first, second, or third field. The difficulty with your representation is that there's no simple way to map over a tuple, since tuples are generally heterogeneous. So instead, one thing you can do is write yourself a generic way to apply a function to a location in a tuple. Here's one way to do that (if the Monad stuff confuses you, mentally substitute "list of foo" everywhere you see m foo and you'll be okay):
mReplace1 :: Monad m => (a -> m d) -> (a,b,c) -> m (d,b,c)
mReplace1 f (a,b,c) = f a >>= \d -> return (d,b,c)
mReplace2 :: Monad m => (b -> m d) -> (a,b,c) -> m (a,d,c)
mReplace2 f (a,b,c) = f b >>= \d -> return (a,d,c)
mReplace3 :: Monad m => (c -> m d) -> (a,b,c) -> m (a,b,d)
mReplace3 f (a,b,c) = f c >>= \d -> return (a,b,d)
These functions provide a way to apply a function to the first, second, and third slots in a tuple, respectively. They're wrapped in a monad so that we can have a function that returns a list of possibilities for the slot, and automatically convert that to a list of possibilities for the tuple as a whole.
With these, we can write the overall function just by stringing these calls together.
moves p board = mReplace1 rowMoves board ++
mReplace2 rowMoves board ++
mReplace3 rowMoves board
where rowMoves row = mReplace1 fieldMoves row ++
mReplace2 fieldMoves row ++
mReplace3 fieldMoves row
fieldMoves B = [p]
fieldMoves _ = []
That is: the moves for a board are all the possibilities for a move in row 1, plus all the possibilities for row 2, plust all the possibilities for row 3. For a given row, the possible moves are all the moves for slot 1, plus all the moves for slot 2, plus all the moves for slot 3. For a given slot, if there's already an X or an O there, then there are no possible moves; otherwise there's one possible move (placing the player in that slot).
Here's a simple solution that I've used before
import qualified Data.Map as Map
data Piece = O | X deriving (Eq,Ord)
type Position = (Int,Int)
type Board = Map.Map Position Piece
positions = [(i,j) | i <- [0,1,2], j <- [0,1,2]]
spaces board = map (\pos -> Map.notMember pos board) positions
moves player board = map (\pos -> Map.insert pos player board) (spaces board)
As other people have stated, tuples is not a very good idea for this approach, since there is no way to traverse them.
You said you needed tuples, so there you go, I'm almost sure it works, test it.
First your code how I would've done it
import Control.Monad (msum)
import Control.Applicative ((<*>), pure)
data Player = P1 | P2 deriving (Eq, Show)
data Field = X | O | B deriving (Eq, Show)
type Board = ((Field,Field,Field)
,(Field,Field,Field)
,(Field,Field,Field))
symbolToPlayer :: Field -> Player
symbolToPlayer X = P1
symbolToPlayer O = P2
checkThree :: (Field,Field,Field) -> Maybe Player
checkThree (a,b,c)
| a == b && a == c = Just $ symbolToPlayer a
| otherwise = Nothing
winHorizontal :: Board -> Maybe Player
winHorizontal (r1, r2, r3) = msum $ map checkThree [r1, r2, r3]
winVertical :: Board -> Maybe Player
winVertical ((a,b,c), (d,e,f), (g,h,i)) =
msum $ map checkThree [(a,d,g), (b,e,h), (c,f,i)]
winDiagonal :: Board -> Maybe Player
winDiagonal ((a,_,c), (_,e,_), (g,_,i)) =
msum $ map checkThree [(a,e,i), (c,e,g)]
hasWinner :: Board -> Maybe Player
hasWinner b = msum $ [winHorizontal, winVertical, winHorizontal] <*> pure b
This is the part of nextStates function
boardBlanks :: Board -> Int
boardBlanks (r1,r2,r3) = rowBlanks r1 + rowBlanks r2 + rowBlanks r3
rowBlanks :: (Field, Field, Field) -> Int
rowBlanks (a,b,c) = foldr hack 0 [a,b,c]
where hack B c = 1 + c
hack _ c = c
changeBoard :: Field -> Int -> Board -> Board
changeBoard f i (a,b,c)
| hack [a] > i = (changeRow f (i - hack []) a, b, c)
| hack [a,b] > i = (a, changeRow f (i - hack [a]) b, c)
| hack [a,b,c] > i= (a, b, changeRow f (i - hack [a,b]) c)
where
hack ls = sum $ map rowBlanks ls
changeRow f 0 row =
case row of
(B,a,b) -> (f,a,b)
(a,B,b) -> (a,f,b)
(a,b,B) -> (a,b,f)
otherwise -> row
changeRow f 1 row =
case row of
(B,B,a) -> (B,f,a)
(a,B,B) -> (a,B,f)
otherwise -> row
changeRow f 2 row =
case row of
(B,B,B) -> (B,B,f)
otherwise -> row
nextStates :: Board -> [Board]
nextStates b = os ++ xs
where
os = foldr (hack O) [] . zip [0..] $ replicate (boardBlanks b) b
xs = foldr (hack X) [] . zip [0..] $ replicate (boardBlanks b) b
hack f (i,a) ls = changeBoard f i a : ls
I am using enumerator-0.4.10, and I need to distribute processing of
different parts of the incoming stream to different iteratees (I am
parsing a huge XML file, and different sub-trees have different
processing logic). Only a single iteratee will be active at a time
since the sub-trees don't intersect.
I wrote a simple example that filters the stream and passes the result
to one iteratee; please see below. However, with multiple nested
iteratees it seems to me that I can no longer use an enumeratee. Do I
need to write my own multi-enumeratee that holds multiple inner
iteratees? Any better ideas?
Here is my (beginner's) code for a single nested iteratee:
module Main ( main ) where
import qualified Data.Enumerator as E ( Enumeratee, Step(..), Stream(..),
checkDone, checkDoneEx, continue, enumList, joinI, run_, yield )
import Data.Enumerator ( ($$), (>>==) )
import qualified Data.Enumerator.List as EL ( consume )
-- cribbed from EL.concatMap
concatMapAccum :: Monad m => (s -> ao -> (s, [ai])) -> s ->
E.Enumeratee ao ai m b
concatMapAccum f s0 = E.checkDone (E.continue . step s0)
where
step _ k E.EOF = E.yield (E.Continue k) E.EOF
step s k (E.Chunks xs) = loop s k xs
loop s k [] = E.continue (step s k)
loop s k (x:xs) = case f s x of
(s', ais) -> k (E.Chunks $ ais) >>==
E.checkDoneEx (E.Chunks xs) (\k' -> loop s' k' xs)
passFromTo :: Monad m => ((a -> Bool), (a -> Bool)) -> Bool -> E.Enumeratee a a m b
passFromTo (from, to) pass0 =
concatMapAccum updatePass pass0
where
updatePass pass el = case (pass, from el, to el) of
(True, _, to_el) -> (not to_el, [el])
(False, True, _) -> (True, [el])
(False, False, _) -> (False, [])
main :: IO()
main = do
E.run_ (E.enumList 3 [1..20] $$
E.joinI $ passFromTo ((\e -> e == 3 || e == 13), (\e -> e == 7 || e == 17)) False $$
EL.consume) >>= print
$ ./dist/build/StatefulEnumeratee/StatefulEnumeratee
[3,4,5,6,7,13,14,15,16,17]
Yes, you need an enumeratee that passes the stream to multiple iteratees, like Data.Iteratee.sequence_ and Data.Iteratee.Parallel.psequence_ from iteratee-0.8.6. sequence_ takes a list of iteratees to run simultaneously, and handles each input chunk by mapM across that list. psequence_ takes similar arguments, but runs each input iteratee in a separate forkIO thread.
There has been some discussion on haskell-cafe and the iteratee mailing lists about these over the past year, eg: http://www.haskell.org/pipermail/haskell-cafe/2011-January/088319.html The main thing to be careful about is handling errors from the inner iteratees: in your application, if one inner iteratee fails do you want to terminate all iteratees or just that one, and [how] do you want to propagate those errors.