[Haskell-cafe] Sending messages up-and-down the iteratee-enumerator chain [Was: iterIO-0.1]

[oleg at okmij.org]

Sorry, this is just a simple answer to one question:

> However, I still have two questions.  First, the Iter type in your
> message seems more like your first iteratee implementation, which is
> the approach iterIO and enumerator now take.  I wonder if it's
> possible to implement something like Tell your current, CPS-based
> iteratee.  Part of the reason I didn't take a CPS-based approach for
> Iter was that I couldn't get the upward control requests to work.
> (Also I wanted pure iteratees, which reduced the gain from CPS.)

Here are the differences from the file UpDown.hs (along the lines of
IterateeMCPS.hs)

newtype IterCPS ee ie a =   -- non-monadic answer-type
  IterCPS{runIter :: forall r. 
	    (a -> r) -> 
	    ((Stream ie -> IterCPS ee ie a) -> r) ->
	    (ee (IterCPS ee ie) a -> r) ->
	    r}

instance Bindable ee => Monad (IterCPS ee ie) where
    return x = IterCPS $ \ kd _ _ -> kd x
    IterCPS m >>= f = IterCPS $ \kd kc ke -> 
      let m_done x = runIter (f x) kd kc ke
          m_cont g = kc (\s -> g s >>= f)
          m_iexc e = ke (comp e f)
      in m m_done m_cont m_iexc

-- The simplest iteratee, which doesn't do anything but asks for trouble
ierr :: Sum2 Err c => IterCPS c ie a
ierr = IterCPS $ \_ _ ke -> ke . inj2 $ Err (\_ -> ierr)


-- A small iteratee: asks for little and accepts little
-- Return the current element
iehead :: (Sum2 Err c, Bindable c) => IterCPS c EOF Char
iehead = IterCPS $ \_ kc _ -> kc step
 where
 step (Chunk a)  = return a
 step (SExc EOF) = ierr


-- Ask for the current position
itell :: (Sum2 Tell c, Bindable c) => IterCPS c ie Int
itell = IterCPS $ \_ _ ke -> ke . inj2 $ Tell return


-- check to see if the current character is 'a' and it occurs at pos 2 (1-based)
ietell :: (Sum2 Err c, Sum2 Tell c, Bindable c) => IterCPS c EOF Bool
ietell = IterCPS $ \_ kc _ -> kc step
 where
 step (Chunk 'a') = itell >>= return . (== 2)
 step (Chunk _)   = return False
 step (SExc EOF)  = ierr


-- Like iehead, but accept the Flush message
ieflush :: (Sum2 Err c, Bindable c) => IterCPS c (Either EOF Flush) Char
ieflush = IterCPS $ \_ kc _ -> kc step
 where
 step (Chunk a)  = return a
 step (SExc x) | Just EOF   <- prj x = ierr
 step (SExc x) | Just Flush <- prj x = ieflush


-- Enumerators and enumeratees
-- Enumerators, in contrast, are explicit in what requests they may
-- satisfy, but implicit in what they may send on the stream.

-- Simple typical enumerator
-- The iteratee must at least accept EOF
-- The iteratee may return Err, but no other requests

en_str :: Sum EOF ie => String -> IterCPS Err ie x -> IterCPS Err ie x
en_str str i = runIter i kd kc ke
 where
 kd = return
 kc k = case str of
	"" -> k eof
	(h:t) -> en_str t $ k (Chunk h)
 ke x | Just (Err _) <- prj2 x = ierr


-- A typical enumeratee
-- It keeps the track of positions
-- It is explicit in requests it accepts: only Tell and Err.
-- It is polymorphic in the in-stream messages

en_pos :: Int -> IterCPS (E2 Err Tell) ie x -> IterCPS Err ie x
en_pos n i = runIter i kd kc ke
 where
 kd = return
 kc k = IterCPS $ \_ kc _ -> kc (\s -> en_pos (n+1) (k s))
 ke x | Just (Err _)  <- prj2 x = ierr
 ke x | Just (Tell k) <- prj2 x = en_pos n (k n)


irun :: Sum EOF ie => IterCPS Err ie x -> x
irun i = runIter i kd kc ke
 where
 kd x = x
 kc k = irun $ k eof
 ke _ = error "Iter error"


The rest of the code, including the tests, are the same.