For my logdl tool, I wanted to add an option to wait for the server to appear and disappear. That should be easy: make a request in a loop until the server starts (or stops) replying.
Waiting until the server appears
I can use httpNoBody request manager to make an HTTP request, and if it fails, an HttpException is thrown and catch can catch it. Thus the HTTP check looks like this:
This IO Bool action returns an IO False if the request was successful and an IO True otherwise — to run the action while it returns True. Now I need a loop, a simple one could have this signature: while :: Bool -> (), however this action is inside IO, so I implemented a monadic version:
12345
-- | Repeats the monadic action @m@ while it returns @True@.whileM::Monadm=>mBool->m()whileMm=dob<-mwhenb$whileMm
This is a very simple implementation indeed! Now it’s trivial to have the core of the wait function: whileM isHTTPError (the rest of my waitForAppearance function is preparing the request and it’s in a ReaderT monad).
Printing a message only once
For an improvement, I want to print a message that the program is waiting, and it should happen only once. How to do that?!
whileM could be extended to keep track of the current iteration count, but that is modifying the function (imagine the function is in a library that we can’t easily change; in fact, there are multiple monadic loop functions in the monad-loops library) and I wanted to avoid that if possible.
Well, I’m back to our favorite standard monads and monad transformers! Updating state is the job for State, or, more precisely, for StateT x IO because I need to do IO as well. Does it mean that I need another function like whileM that knows how to work with a StateT? No need for that since whileM already works with any Monad and StateT is a Monad.
So my first approach was to get the is-first-fail flag inside the catch block (where I need it), thus the whole computation after whileM would be of type StateT Bool IO Bool (i.e., a state that contains the is-first-fail flag (the first Bool), can encompass computations in IO, and returns a value of type Bool), and to get an IO () out of it, I need to run the state (here with evalStateT because I don’t care about the final state):
123456789101112
waitForAppearance'::Manager->Request->IO()waitForAppearance'managerrequest=flipevalStateTTrue.whileM$(liftIO$httpNoBodyrequestmanager$>False)`catch`(\(_::HttpException)->do-- get the flag (initial state is `True` two lines above)…firstFail<-get-- …and reset it so that it's not triggered anymoreputFalseliftIO$dowhenfirstFail$putStrLn"Waiting for server…"threadDelay1_000_000pureTrue)
This works in theory… but not in practice:
123456789101112
•Couldn'tmatchexpectedtype‘StateTBoolIOBool’withactualtype‘IOBool’•Inthesecondargumentof‘($)’,namely‘(liftIO$httpNoBodyrequestmanager$>False)`catch`(\(_::HttpException)->dofirstFail<-getputFalseliftIO$dowhenfirstFail$putStrLn"Waiting for server…"........)’
The snag here is that catch :: IO a -> (e -> IO a) -> IO a (the type is slightly simplified), so it must return an IO value. Our StateT Bool IO is a more specific type than IO, and there is no way to use it here. If we had a function like catch' :: MonadIO m => m a -> (e -> m a) -> m a and replaced catch with catch' in the code above, it would compile just fine.
I came up with a twist: leave the check in IO, but wrap it in a StateT. In this case, I can get the flag outside and use it inside the “pure” IO; it looks like this:
12345678910
waitForAppearance'::Manager->Request->IO()waitForAppearance'managerrequest=flipevalStateTTrue.whileM$dofirstFail<-getputFalseliftIO$(httpNoBodyrequestmanager$>False)`catch`(\(_::HttpException)->dowhenfirstFail$putStrLn"Waiting for server…"threadDelay1_000_000pureTrue)