CODEWITHSUNDEEP
haskell
user1518183
user1518183

Reputation: 4771

Idiomatic stateful loop in Haskell

Is there an idiomatic way to express following code in Haskell?

main :: IO ()
main = loop initState1 initState2 initState3

loop :: State1 -> State2 -> State3 -> IO ()
loop s1 s2 s3 = do
  s1' <- runService1 s1
  s2' <- runService2 s2
  s3' <- runService3 s3
  loop s1' s2' s3'

This code is very verbose so I probably doing something weird.

Upvotes: 8

Views: 522

Answers (3)

danidiaz
danidiaz

Reputation: 27771

This solution is not more succinct, but solves an infelicity of the original formulation: the "unfolding" of each process is commingled with the "zipping together" of all processes. It would be nice if we could define each process independently, and combine them later as we saw fit.

We need the following auxiliary type:

newtype Iter = Iter (IO Iter)

unfoldIter :: (s -> IO s) -> s -> Iter
unfoldIter f s = Iter (unfoldIter f <$> f s)

runIter :: Iter -> IO ()
runIter (Iter action) = action >>= runIter

doNothingIter :: Iter
doNothingIter = unfoldIter return ()

zipIter :: Iter -> Iter -> Iter
zipIter (Iter action1) (Iter action2) =
    Iter (zipIter <$> action1 <*> action2)

instance Monoid Iter where
    mempty = doNothingIter
    mappend = zipIter

Then loop becomes:

loop :: State1 -> State2 -> State3 -> IO ()
loop s1 s2 s3 = 
    runIter $ unfoldIter runService1 s1
           <> unfoldIter runService2 s2
           <> unfoldIter runService3 s3

If we don't want to define our own auxiliary type, we could use a streaming library that provided a "zipping" operation, like for example streaming does.

Upvotes: 1

leftaroundabout
leftaroundabout

Reputation: 120711

I practice, you probably want to shove that state in a suitable state monad. The lens library makes it easy to access that:

{-# LANGUAGE TemplateHaskell    #-}
import Control.Lens.TH
import Control.Monad.Trans.State

data AllState = AllState { _s₀ :: State0, _s₁ :: State1, _s₂ :: State2 }
makeLenses ''AllState

loop :: StateT AllState IO ()
loop = do
   s₀ <~ runService0 <$> use s₀
   s₁ <~ runService1 <$> use s₁
   s₂ <~ runService2 <$> use s₂
   loop

main = evalStateT loop $ AllState initState0 initState1 initState2

As such, this doesn't buy you very much over your original code, but it becomes much more convenient if you also give the runService actions a suitable state-monad type:

runService0 :: StateT State0 IO ()
runService1 :: StateT State1 IO ()
runService2 :: StateT State2 IO ()

...then you can simply use the zoom mechanism:

loop :: StateT AllState IO ()
loop = do
   zoom s₀ runService0
   zoom s₁ runService1
   zoom s₂ runService2
   loop

or as Gurkenglas suggests

loop = forever $ do
   zoom s₀ runService0
   zoom s₁ runService1
   zoom s₂ runService2

Upvotes: 6

Gurkenglas
Gurkenglas

Reputation: 2317

main = fix (zipWithM ($) >=>)
  [runService1, runService2, runService3]
  [initState1 , initState2 , initState3 ]

Compare fix . (>>=) :: IO a -> IO b, which is forever.

Edit: This only works if State1 = State2 = State3. If not, data-fix allows:

main = fix (traverse unFix >=>)
  [ana runService1 initState1, ana runService2 initState2, ana runService3 initState3]

Upvotes: 8

Related Questions