Misunderstanding ArrowLoop when used with Netwire

Question

Following the lead of the excellent answer in this post, I'm trying to get a working example of ArrowLoop that doesn't use arrow notation. I'm uncomfortable using arrow notation until I fully understand how arrows work under the hood. That being said, I've constructed a small program that based on my (limited) understanding of Arrows should work. However, it ends up terminating with the dreaded <<loop>> exception:

module Main where

import Control.Wire
import FRP.Netwire

farr :: SimpleWire (Int, Float) (String, Float)
farr = let
  fn :: Int -> Float -> ((String, Float), SimpleWire (Int, Float) (String, Float))
  fn i f = (("f+i: " ++ (show (fromIntegral i + f)), f + 0.1), loopFn)

  loopFn :: SimpleWire (Int, Float) (String, Float)
  loopFn = mkSFN $ \(i, f) -> fn i f
  in
   mkSFN $ \(i, _) -> fn i 0.0

main :: IO ()
main = do
  let sess = clockSession_ :: Session IO (Timed NominalDiffTime ())
  (ts, sess2) <- stepSession sess

  let wire = loop farr
      (Right s, wire2) = runIdentity $ stepWire wire ts (Right 0)

  putStrLn ("s: " ++ s)

  (ts2, _) <- stepSession sess2
  let (Right s2, _) = runIdentity $ stepWire wire2 ts (Right 1)

  putStrLn ("s2: " ++ s2)

My intuition tells me that the <<loop>> exception usually comes when you don't supply the initial value to the loop. Haven't I done that with the line containing fn i 0.0? The output disagrees:

$ ./test
s: f+i: 0.0
test.exe: <<loop>>

Does anyone know what I'm doing wrong?

Answer 1

The main point of confusion seemed to be the integral relationship between ArrowLoop and mfix. For the uninitiated, fix is a function that finds the fixed point of a given function:

fix :: (a -> a) -> a
fix f = let x = f x in x

mfix is the monadic extension of this function, whose type signature is, unsurprisingly:

mfix :: (a -> m a) -> m a

So what does this have to do with ArrowLoop? Well, the ArrowLoop instance for Netwire runs mfix on the second argument of the passed wire. To put it another way, consider the type signature for loop:

loop :: a (b, d) (c, d) -> a b c

In Netwire, the instance of ArrowLoop is:

instance MonadFix m => ArrowLoop (Wire s e m)

This means that the loop function's type when used with wires is:

loop :: MonadFix m => Wire s e m (b, d) (c, d) -> Wire s e m b c

Since loop does not take an initial argument of type d, this means that there is no way to initialize any sort of conventional "looping" over the wire. The only way to get a value out of it is to keep applying the output as the input until it finds a termination condition, which is analogous to the way fix works. The wire that gets passed as an argument to loop never actually steps more than once, since stepWire is applied to the same wire over and over with different inputs. Only when the wire actually produces a fixed value, does the function step and produce another wire (which behaves the same way as the first).

For completeness, here is code for my original intuition for how loop was supposed to work, which I have named semiLoop:

semiLoop :: (Monad m, Monoid s, Monoid e) => c -> Wire s e m (a, c) (b, c) -> Wire s e m a b
semiLoop initialValue loopWire = let
  runLoop :: (Monad m, Monoid s, Monoid e) =>
             Wire s e m (a, c) (b, c) -> s -> a -> c -> m (Either e b, Wire s e m a b)
  runLoop wire ts ipt x = do
    (result, nextWire) <- stepWire wire ts (Right (ipt, x))
    case result of
      Left i -> return (Left i, mkEmpty)
      Right (value, nextX) ->
        return (Right value, mkGen $ \ts' ipt' -> runLoop nextWire ts' ipt' nextX)
  in
   mkGen $ \ts input -> runLoop loopWire ts input initialValue

Edit

After the wonderful answer provided by Petr, the delay combinator is essential to preventing the loop combinator from diverging. delay simply creates a single-value buffer between the laziness of using the next value in the mfix portion of the loop described above. An identical definition of semiLoop above is therefore:

semiLoop :: (MonadFix m, Monoid s, Monoid e) =>
            c -> Wire s e m (a, c) (b, c) -> Wire s e m a b
semiLoop initialValue loopWire = loop $ second (delay initialValue) >>> loopWire