RecursiveStateMachine.hs

#!/usr/bin/env stack

newtype Machine i o = Machine { runMachine :: i -> IO (o, Machine i o) }

fibM :: Machine () Int
fibM = go 1 1 where
  go :: Int -> Int -> Machine () Int
  go i j = Machine $ \() -> do
    putStrLn $ "machineA: " ++ show (i,j)
    return $ (,) (i+j) $ go j (i+j)

listM :: Machine String String
listM = go "[]" where
  go :: String -> Machine String String
  go s = Machine $ \ch -> do
    putStrLn $ "machineB: " ++ s
    return $ (,) s $ go (ch ++ ":" ++ s)

fibListM :: Machine () ()
fibListM = go 0 fibM listM where
  go :: Int -> Machine () Int -> Machine String String -> Machine () ()
  go n mA mB = Machine $ \() -> do
    (fibN, mA') <- runMachine mA ()
    (s, mB') <- runMachine mB (show fibN)
    putStrLn $ show n ++ ": " ++ s
    return $ (,) () $ go (n+1) mA' mB'
    
main = do
  fibListM <- snd <$> runMachine fibListM ()
  fibListM <- snd <$> runMachine fibListM ()
  fibListM <- snd <$> runMachine fibListM ()
  fibListM <- snd <$> runMachine fibListM ()
  fibListM <- snd <$> runMachine fibListM ()
  fibListM <- snd <$> runMachine fibListM ()
  fibListM <- snd <$> runMachine fibListM ()
  fibListM <- snd <$> runMachine fibListM ()
  fibListM <- snd <$> runMachine fibListM ()
  fibListM <- snd <$> runMachine fibListM ()
  fibListM <- snd <$> runMachine fibListM ()
  fibListM <- snd <$> runMachine fibListM ()

  putStrLn "finished"