So I wrote my own implementation of StateT because I couldn't get transformers to compile correctly in Haste. I think wanted to get the javascript setInterval working inside my state monad. Here is the ffi call to setInterval.
jsInterval :: Int -> IO () -> IO Int
jsInterval = ffi "(function(t,f){window.setInterval(f,t);})"
I couldn't think of anyway to get the result of m back after it is passed to jsInterval. So I tried to use IORefs.
interval :: Int -> StateT s IO () -> StateT s IO Int
interval i m = StateT $ \s -> do
ref <- newIORef Nothing
id_ <- jsInterval i $ do
(_, s') <- runStateT m s
writeIORef ref (Just s')
s' <- readIORef ref
return (id_, s')
This didn't work because it kept the original state. The read happened before the write. So I wrote a function that would poll in a loop until the IORef was written but this just hung forever.
interval :: Int -> StateT s IO () -> StateT s IO Int
interval i m = StateT $ \s -> do
ref <- newIORef Nothing
id_ <- jsInterval i $ do
(_, s') <- runStateT m s
writeIORef ref (Just s')
s' <- go ref
return (id_, s')
where
go ref = do
s <- readIORef ref
case s of
Nothing -> go ref
Just s' -> return s'
Is it possible to implement this function? I tried writing an instance of MonadEvent for StateT but that was also unsuccessful.
The IO action you are passing to your FFI'ed jsInterval is just a plain IO action. If you implement that action using runStateT you are just running a little 'local' StateT. It's unrelated to the enclosing code.
This is a generic problem with callbacks and monad stacks - callbacks (in the sense that the IO() parameter to jsInterval is a callback) have a fixed monad chosen in their definition and they have no way to generalise to other monadic effects you might be using elsewhere.
Since callbacks - in general - can be called at any time, including multiple times at once, in different threads, after the calling function has completed and its state has been destroyed - you can see that this is hard problem to solve in general.
The pragmatic answer is, as you have tried, to just use an IORef; create the IORef in the enclosing action and let the callback modify it. You can still write the callback in StateT style if you wish - just extract the state from the IORef and pass it to runStateT. Your code doesn't do this, you are just referencing the parameter s from the top-level : you need to use the IORef, something like this:
id_ <- jsInterval i $ do
current_s <- readIORef ref
(_, new_s) <- runStateT m current_s
writeIORef ref (new_s)
You can't really use Maybe unless you are prepared to teach the action m how to cope with a Maybe - it need to deal with the Nothing, so perhaps you want it to have the type StateT (Maybe s) IO () ?
A second logic problem (?) with your code is that certainly the s returned by interval will not have been changed yet - the setInterval code can't possibly have been triggered until javascript goes back into its idle loop.
The general problem of passing callbacks has been discussed a few times over the years, see:
https://mail.haskell.org/pipermail/haskell-cafe/2007-July/028501.html
http://andersk.mit.edu/haskell/monad-peel/
http://blog.sigfpe.com/2011/10/quick-and-dirty-reinversion-of-control.html
etc.
Related
I'm writing some code (around card-playing strategies) that uses State and recursion together. Perhaps this part doesn't need to actually (it already feels clumsy to me, even as a relative beginner), but there are other parts that probably do so my general question stands...
My initial naive implementation is entirely deterministic (the choice of bid is simply the first option provided by the function validBids):
bidOnRound :: (DealerRules d) => d -> NumCards -> State ([Player], PlayerBids) ()
bidOnRound dealerRules cardsThisRound = do
(players, bidsSoFar) <- get
unless (List.null players) $ do
let options = validBids dealerRules cardsThisRound bidsSoFar
let newBid = List.head $ Set.toList options
let p : ps = players
put (ps, bidsSoFar ++ [(p, newBid)])
bidOnRound dealerRules cardsThisRound
And I call it from:
playGame :: (DealerRules d, ScorerRules s) => d -> s -> StateT Results IO ()
...
let (_, bidResults) = execState (bidOnRound dealerRules cardsThisRound) (NonEmpty.toList players, [])
Now I'm aware that I need to bring randomness into this and several other parts of the code. Not wanting to litter IO everywhere, nor pass round random seeds manually all the time, I feel I should be using MonadRandom or something. A library I'm using uses it to good effect. Is this a wise choice?
Here's what I tried:
bidOnRound :: (DealerRules d, RandomGen g) => d -> NumCards -> RandT g (State ([Player], PlayerBids)) ()
bidOnRound dealerRules cardsThisRound = do
(players, bidsSoFar) <- get
unless (List.null players) $ do
let options = Set.toList $ validBids dealerRules cardsThisRound bidsSoFar
rnd <- getRandomR (0 :: Int, len options - 1)
let newBid = options List.!! rnd
let p : ps = players
put (ps, bidsSoFar ++ [(p, newBid)])
bidOnRound dealerRules cardsThisRound
but I'm uncomfortable already, plus can't work out how to call this, e.g. using evalRand in combination with execState etc. The more I read on MonadRandom, RandGen and mtl vs others, the less sure I am of what I'm doing...
How should I neatly combine Randomness and State and how do I call these properly?
Thanks!
EDIT: for reference, full current source on Github.
Well how about an example to help you out. Since you didn't post a full working code snippet I'll just replace a lot of your operations and show how the monads can be evaluated:
import Control.Monad.Trans.State
import Control.Monad.Random
import System.Random.TF
bidOnRound :: (RandomGen g) => Int -> RandT g (State ([Int], Int)) ()
bidOnRound i =
do rand <- getRandomR (10,20)
s <- lift $ get
lift $ put ([], i + rand + snd s)
main :: IO ()
main =
do g <- newTFGen
print $ flip execState ([],1000) $ evalRandT (bidOnRound 100) g
The thing to note here is you "unwrap" the outer monad first. So if you have RandT (StateT Reader ...) ... then you run RandT (ex via evalRandT or similar) then the state then the reader. Secondly, you must lift from the outer monad to use operations on the inner monad. This might seem clumsy and that is because it is horribly clumsy.
The best developers I know - those whose code I enjoy looking at and working with - extract monad operations and provide an API with all the primitives complete so I don't need to think about the structure of the monad while I'm thinking about the structure of the logic I'm writing.
In this case (it will be slightly contrived since I wrote the above without any application domain, rhyme or reason) you could write:
type MyMonad a = RandT TFGen (State ([Int],Int)) a
runMyMonad :: MyMonad () -> IO Int
runMyMonad f =
do g <- newTFGen
pure $ snd $ flip execState ([],1000) $ evalRandT f g
With the Monad defined as a simple alias and execution operation the basic functions are easier:
flipCoin :: MyMonad Int
flipCoin = getRandomR (10,20)
getBaseValue :: MyMonad Int
getBaseValue = snd <$> lift get
setBaseValue :: Int -> MyMonad ()
setBaseValue v = lift $ state $ \s -> ((),(fst s, v))
With that leg-work out of the way, which is usually a minor part of making a real application, the domain specific logic is easier to write and certainly easier to read:
bidOnRound2 :: Int -> MyMonad ()
bidOnRound2 i =
do rand <- flipCoin
old <- getBaseValue
setBaseValue (i + rand + old)
main2 :: IO ()
main2 = print =<< runMyMonad (bidOnRound2 100)
Starting from a previous question here:
Reactive Banana: how to use values from a remote API and merge them in the event stream
I have a bit different problem now: How can I use the Behaviour output as input for an IO operation and finally display the IO operation's result?
Below is the code from the previous answer changed with a second output:
import System.Random
type RemoteValue = Int
-- generate a random value within [0, 10)
getRemoteApiValue :: IO RemoteValue
getRemoteApiValue = (`mod` 10) <$> randomIO
getAnotherRemoteApiValue :: AppState -> IO RemoteValue
getAnotherRemoteApiValue state = (`mod` 10) <$> randomIO + count state
data AppState = AppState { count :: Int } deriving Show
transformState :: RemoteValue -> AppState -> AppState
transformState v (AppState x) = AppState $ x + v
main :: IO ()
main = start $ do
f <- frame [text := "AppState"]
myButton <- button f [text := "Go"]
output <- staticText f []
output2 <- staticText f []
set f [layout := minsize (sz 300 200)
$ margin 10
$ column 5 [widget myButton, widget output, widget output2]]
let networkDescription :: forall t. Frameworks t => Moment t ()
networkDescription = do
ebt <- event0 myButton command
remoteValueB <- fromPoll getRemoteApiValue
myRemoteValue <- changes remoteValueB
let
events = transformState <$> remoteValueB <# ebt
coreOfTheApp :: Behavior t AppState
coreOfTheApp = accumB (AppState 0) events
sink output [text :== show <$> coreOfTheApp]
sink output2 [text :== show <$> reactimate ( getAnotherRemoteApiValue <#> coreOfTheApp)]
network <- compile networkDescription
actuate network
As you can see what I am trying to do it is using the new state of the application -> getAnotherRemoteApiValue -> show. But it doesn't work.
Is actually possible doing that?
UPDATE
Based on the Erik Allik and Heinrich Apfelmus below answers I have the current code situation - that works :) :
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import System.Random
import Graphics.UI.WX hiding (Event, newEvent)
import Reactive.Banana
import Reactive.Banana.WX
data AppState = AppState { count :: Int } deriving Show
initialState :: AppState
initialState = AppState 0
transformState :: RemoteValue -> AppState -> AppState
transformState v (AppState x) = AppState $ x + v
type RemoteValue = Int
main :: IO ()
main = start $ do
f <- frame [text := "AppState"]
myButton <- button f [text := "Go"]
output1 <- staticText f []
output2 <- staticText f []
set f [layout := minsize (sz 300 200)
$ margin 10
$ column 5 [widget myButton, widget output1, widget output2]]
let networkDescription :: forall t. Frameworks t => Moment t ()
networkDescription = do
ebt <- event0 myButton command
remoteValue1B <- fromPoll getRemoteApiValue
let remoteValue1E = remoteValue1B <# ebt
appStateE = accumE initialState $ transformState <$> remoteValue1E
appStateB = stepper initialState appStateE
mapIO' :: (a -> IO b) -> Event t a -> Moment t (Event t b)
mapIO' ioFunc e1 = do
(e2, handler) <- newEvent
reactimate $ (\a -> ioFunc a >>= handler) <$> e1
return e2
remoteValue2E <- mapIO' getAnotherRemoteApiValue appStateE
let remoteValue2B = stepper Nothing $ Just <$> remoteValue2E
sink output1 [text :== show <$> appStateB]
sink output2 [text :== show <$> remoteValue2B]
network <- compile networkDescription
actuate network
getRemoteApiValue :: IO RemoteValue
getRemoteApiValue = do
putStrLn "getRemoteApiValue"
(`mod` 10) <$> randomIO
getAnotherRemoteApiValue :: AppState -> IO RemoteValue
getAnotherRemoteApiValue state = do
putStrLn $ "getAnotherRemoteApiValue: state = " ++ show state
return $ count state
The fundamental problem is a conceptual one: FRP Events and Behaviors can only be combined in a pure way. In principle, it is not possible to have a function of type, say
mapIO' :: (a -> IO b) -> Event a -> Event b
because the order in which the corresponding IO actions are to be executed is undefined.
In practice, it may sometimes be useful to perform IO while combining Events and Behaviors. The execute combinator can do this, as #ErikAllik indicates. Depending on the nature of getAnotherRemoteApiValue, this may be the right thing to do, in particular if this is function is idempotent, or does a quick lookup from location in RAM.
However, if the computation is more involved, then it is probably better to use reactimate to perform the IO computation. Using newEvent to create an AddHandler, we can give an implementation of the mapIO' function:
mapIO' :: (a -> IO b) -> Event a -> MomentIO (Event b)
mapIO' f e1 = do
(e2, handler) <- newEvent
reactimate $ (\a -> f a >>= handler) <$> e1
return e2
The key difference to the pure combinator
fmap :: (a -> b) -> Event a -> Event b
is that the latter guarantees that the input and result events occur simultaneously, while the former gives absolutely no guarantee about when the result event occurs in relation to other events in the network.
Note that execute also guarantees that input and result are have simultaneous occurrences, but places informal restrictions on the IO allowed.
With this trick of combining reactimate with newEvent a similar combinator can be written for Behaviors in a similar fashion. Keep in mind that the toolbox from Reactive.Banana.Frameworks is only appropriate if you are dealing with IO actions whose precise order will necessarily be undefined.
(To keep this answer current, I have used the type signatures from the upcoming reactive-banana 1.0. In version 0.9, the type signature for mapIO' is
mapIO' :: Frameworks t => (a -> IO b) -> Event t a -> Moment t (Event t b)
)
TL;DR: scroll down to the ANSWER: section for a solution along with an explanation.
First of all
getAnotherRemoteApiValue state = (`mod` 10) <$> randomIO + count state
is invalid (i.e. does not typecheck) for reasons completely unrelated to FRP or reactive-banana: you cannot add an Int to an IO Int — just as you can't apply mod 10 to an IO Int directly, which is exactly why, in the answer to your original question, I used <$> (which is another name for fmap from Functor).
I strongly recommend you look up and understand the purpose/meaning of <$>, along with <*> and some other Functor and Applicative type class methods — FRP (at least the way it is designed in reactive-banana) builds heavily upon Functors and Applicatives (and sometimes Monads, Arrows and possibly some other more novel foundation), hence if you don't completely understand those, you won't ever become proficient with FRP.
Secondly, I'm not sure why you're using coreOfTheApp for sink output2 ... — the coreOfTheApp value is related to the other API value.
Thirdly, how should the other API value be displayed? Or, more specifically, when should it be displayed? Your first API value is displayed when the button is clicked but there's no button for the second one — do you want the same button to trigger the API call and display update? Do you want another button? Or do you want it to be polled every n unit of time and simply auto-updated in the UI?
Lastly, reactimate is meant for converting a Behavior into an IO action, which is not what you want, because you already have the show helper and don't need to setText or smth on the static label. In other words, what you need for the second API value is the same as before, except you need to pass something from the app state along with the request to the external API, but aside from that difference, you can still just keep showing the (other) API value using show as normal.
ANSWER:
As to how to convert getAnotherRemoteApiValue :: AppState -> IO RemoteValue into an Event t Int similar to the original remoteValueE:
I first tried to go via IORefs and using changes+reactimate', but that quickly turned out to a dead end (besides being ugly and overly complicated): output2 was always updated one FRP "cycle" too late, so it was always one "version" behind in the UI.
I then, with the help of Oliver Charles (ocharles) on #haskell-game on FreeNode, turned to execute:
execute :: Event t (FrameworksMoment a) -> Moment t (Event t a)
which I still don't fully grasp yet, but it works:
let x = fmap (\s -> FrameworksMoment $ liftIO $ getAnotherRemoteApiValue s)
(appStateB <# ebt)
remoteValue2E <- execute x
so the same button would trigger both actions. But the problem with that quickly turned out to be the same as with the IORef based solution — since the same button would trigger a pair of events, and one event inside that pair depended on the other, the contents of output2 was still one version behind.
I then realised the events relatede to output2 need to be triggered after any events related to output1. However, it's impossible to go from Behavior t a -> Event t a; in other words, once you have a behavior, you can't (easily?) obtain an event from that (except with changes, but changes is tied to reactimate/reactimate', which is not useful here).
I finally noticed that I was essentially "throwing away" an intermediate Event at this line:
appStateB = accumB initialState $ transformState <$> remoteValue1E
by replacing it with
appStateE = accumE initialState $ transformState <$> remoteValue1E
appStateB = stepper initialState -- there seems to be no way to eliminate the initialState duplication but that's fine
so I still had the exact same appStateB, which is used as previously, but I could then also rely on appStateE to reliably trigger further events that rely on the AppState:
let x = fmap (\s -> FrameworksMoment $ liftIO $ getAnotherRemoteApiValue s)
appStateE
remoteValue2E <- execute x
The final sink output2 line looks like:
sink output2 [text :== show <$> remoteValue2B]
All of the code can be seen at http://lpaste.net/142202, with debug output still enabled.
Note that the (\s -> FrameworkMoment $ liftIO $ getAnotherRemoteApiValue s) lambda cannot be converted to point-free style for reasons related to RankN types. I was told this problem will go away in reactive-banana 1.0 because there will be no FrameworkMoment helper type.
I'm making several API calls that are encapsulated in a type alias:
type ConnectT a = EitherT String (RWST ConnectReader ConnectWriter ConnectState IO) a
Here's a simplified version of a function which connects to two separate APIs:
connectBoth :: ConnectT ()
connectBoth = do
a <- connectAPI SomeAPI someFunction
b <- connectAPI OtherAPI otherFunction
connectAPI OtherAPI (b `sendTo` a)
The final call in connectBoth is very time sensitive (and the transactions are of a financial nature). I figure a and b could be evaluated in parallel, and with lazy IO I should be able to do this:
b <- a `par` connectAPI OtherAPI otherFunction
The documentation for par says that it Indicates that it may be beneficial to evaluate the first argument in parallel with the second.
Does this work with IO?
Can I get any more guaranteed than "it may be beneficial?"
Or if I want greater guarantees will I need to use an MVar and liftIO . forkIO?
If I evaluate a first, I think I can use eitherT to check if a succeeded. But if I evaluate both at the same time I get confused. Here is the situation:
If only a failed, I will retry a, if that fails I will run a function that manually reverses b
If only b failed, I will retry b, write to the log in RWS and return left
if both fail write to the log in RWS and return left
if both succeed process c (which is not as time sensitive as a or b)
But if I evaluate both in parallel, then how can I identify which one failed? If I use eitherT immediately after a then a will evaluate first. If I use it after b then I won't be able to tell which one failed.
Is there a way I can evaluate the IO calls in parallel but respond differently depending on which one (if any) fails? Or am I left with a choice of parallelism vs failure mitigation?
The solution you are looking for will use forkIO and MVars.
par
par is for multiprocessor parallelism, it helps evaluate terms in parallel. It doesn't help with IO. If you do
do
a <- (someProcess :: IO a)
...
By the time you reach ... everything from the IO action has happened (if we ignore evil lazy IO) to a point that a can be determined entirely by ordinary evaluation. This means that by the time you do b <- someOtherProcess, all of someProcess is already done. It's too late to do anything in parallel.
EitherT
You can explicitly examine the Either e a result of an EitherT e m a. runEitherT :: EitherT e m a -> m (Either e a) makes the success or failure explicit in the underlying monad. We can lift that right back into EitherT to make a computation that always succeeds (sometimes with an error) from one that sometimes fails.
import Control.Monad.Trans.Class
examine :: (MonadTrans t, Monad m) => EitherT e m a -> t m (Either e a)
examine = lift . runEitherT
forkIO
The simplest solution for doing two things in IO is forkIO. It starts another lightweight thread that you can forget about.
If you run a value with your transformer stack, there will be four pieces of data when you are done. The state ConnectState, the written ConnectWriter log, whether the computation was successful, and, depending on whether or not it was successful, either the value or the error.
EitherT String (RWST ConnectReader ConnectWriter ConnectState IO) a
^ ^ ^ ^ ^
If we write out the structure of this, it looks like
(RWST ConnectReader ConnectWriter ConnectState IO) (Either String a)
^ ^ ^ ^ ^
ConnectReader -> ConnectState -> IO (Either String a, ConnectState, ConnectWriter)
^ ^ ^ ^ ^
All four of those pieces of information end up in the result of the IO action. If you fork your stack, you need to decide what to do with all of them when you join the results back together. You have already decided that you want to explicitly handle the Either String a. The ConnectWriters can probably be combined together with <>. You will need to decide what to do with ConnectState.
We'll make a fork that returns all four of these pieces of data by shoving them into an MVar.
import Control.Concurrent
import Control.Concurrent.MVar
import Control.Monad.IO.Class
forkConnectT :: ConnectT a -> ConnectT (MVar (Either String a, ConnectState, ConnectWriter))
forkConnectT cta = do
result <- liftIO newEmptyMVar
r <- lift ask
s <- lift get
liftIO $ forkIO $ do
state <- runRWST (runEitherT cta) r s
putMVar result state
return result
Later, when we want the result, we can try and see if it is ready. We'll handle the Either for success and failure explicitly, while handling the state and writer behind the scenes.
import Data.Traversable
tryJoinConnectT :: MVar (Either String a, ConnectState, ConnectWriter) -> ConnectT (Maybe (Either String a))
tryJoinConnectT result = liftIO (tryTakeMVar result) >>= traverse reintegrate
Behind the scenes we reintegrate the ConnectWriter by telling this ConnectT to write what was accumulated in the other thread. You will need to decide what to do to combine the two states.
reintegrate :: (a, ConnectState, ConnectWriter) -> ConnectT a
reintegrate (a, s, w) = do
-- Whatever needs to be done with the state.
-- stateHere <- lift get
lift $ tell w
return a
If we want to wait until the result is ready, we can block reading the MVar. This offers less opportunity for handling errors such as timeouts.
joinConnectT :: MVar (Either String a, ConnectState, ConnectWriter) -> ConnectT (Either String a)
joinConnectT result = liftIO (takeMVar result) >>= reintegrate
Example
Putting it all together, we can fork a task in parallel, do something in this thread explicitly examining the success or failure, join with the result from the other thread, and reason about what to do next with explicit Eithers representing success or failure from each process.
connectBoth :: ConnectT ()
connectBoth = do
bVar <- forkConnectT $ connectAPI OtherAPI otherFunction
a <- examine $ connectAPI SomeAPI someFunction
b <- joinConnectT bVar
...
Going farther
If you are paranoid, you will also want to handle exceptions (some of which can be handled by forkFinally) and asynchronous exceptions. You will need to decide whether to bundle these exceptions into your stack or treat IO like it can always throw exceptions.
Consider using async instead of forkIO and MVars.
monad-control (which you already have dependencies on via either) provides mechanisms for building up, one transformer at a time, the type that represents the state of a monad transformer stack. We wrote this by hand as (Either String a, ConnectState, ConnectWriter). If you are going to grow your transformer stack, you might want to get this from MonadTransControl instead. You can restore the state from the forked thread(see MonadBaseControl section) in the parent to inspect it. You will still need to decide how to deal with the data from the two states..
I'm trying to work out if it's possible to write an abstraction for the following situation. Suppose I have a type a with function a -> m Bool e.g. MVar Bool and readMVar. To abstract this concept out I create a newtype wrapper for the type and its function:
newtype MPredicate m a = MPredicate (a,a -> m Bool)
I can define a fairly simple operation like so:
doUnless :: (Monad m) => Predicate m a -> m () -> m ()
doUnless (MPredicate (a,mg)) g = mg a >>= \b -> unless b g
main = do
b <- newMVar False
let mpred = MPredicate (b,readMVar)
doUnless mpred (print "foo")
In this case doUnless would print "foo". Aside: I'm not sure whether a type class might be more appropriate to use instead of a newtype.
Now take the code below, which outputs an incrementing number then waits a second and repeats. It does this until it receives a "turn off" instruction via the MVar.
foobar :: MVar Bool -> IO ()
foobar mvb = foobar' 0
where
foobar' :: Int -> IO ()
foobar' x = readMVar mvb >>= \b -> unless b $ do
let x' = x + 1
print x'
threadDelay 1000000
foobar' x'
goTillEnter :: MVar Bool -> IO ()
goTillEnter mv = do
_ <- getLine
_ <- takeMVar mv
putMVar mv True
main = do
mvb <- newMVar False
forkIO $ foobar mvb
goTillEnter mvb
Is it possible to refactor foobar so that it uses MPredicate and doUnless?
Ignoring the actual implementation of foobar' I can think of a simplistic way of doing something similar:
cycleUnless :: x -> (x -> x) -> MPredicate m a -> m ()
cycleUnless x g mp = let g' x' = doUnless mp (g' $ g x')
in g' $ g x
Aside: I feel like fix could be used to make the above neater, though I still have trouble working out how to use it
But cycleUnless won't work on foobar because the type of foobar' is actually Int -> IO () (from the use of print x').
I'd also like to take this abstraction further, so that it can work threading around a Monad. With stateful Monads it becomes even harder. E.g.
-- EDIT: Updated the below to show an example of how the code is used
{- ^^ some parent function which has the MVar ^^ -}
cycleST :: (forall s. ST s (STArray s Int Int)) -> IO ()
cycleST sta = readMVar mvb >>= \b -> unless b $ do
n <- readMVar someMVar
i <- readMVar someOtherMVar
let sta' = do
arr <- sta
x <- readArray arr n
writeArray arr n (x + i)
return arr
y = runSTArray sta'
print y
cycleST sta'
I have something similar to the above working with RankNTypes. Now there's the additional problem of trying to thread through the existential s, which is not likely to type check if threaded around through an abstraction the likes of cycleUnless.
Additionally, this is simplified to make the question easier to answer. I also use a set of semaphores built from MVar [MVar ()] similar to the skip channel example in the MVar module. If I can solve the above problem I plan to generalize the semaphores as well.
Ultimately this isn't some blocking problem. I have 3 components of the application operating in a cycle off the same MVar Bool but doing fairly different asynchronous tasks. In each one I have written a custom function that performs the appropriate cycle.
I'm trying to learn the "don't write large programs" approach. What I'd like to do is refactor chunks of code into their own mini libraries so that I'm not building a large program but assembling lots of small ones. But so far this particular abstraction is escaping me.
Any thoughts on how I might go about this are very much appreciated!
You want to cleanly combine a stateful action having side effects, a delay, and an independent stopping condition.
The iterative monad transformer from the free package can be useful in these cases.
This monad transformer lets you describe a (possibly nonending) computation as a series of discrete steps. And what's better, it let's you interleave "stepped" computations using mplus. The combined computation stops when any of the individual computations stops.
Some preliminary imports:
import Data.Bool
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Iter (delay,untilJust,IterT,retract,cutoff)
import Control.Concurrent
Your foobar function could be understood as a "sum" of three things:
A computation that does nothing but reading from the MVar at each step, and finishes when the Mvar is True.
untilTrue :: (MonadIO m) => MVar Bool -> IterT m ()
untilTrue = untilJust . liftM guard . liftIO . readMVar
An infinite computation that takes a delay at each step.
delays :: (MonadIO m) => Int -> IterT m a
delays = forever . delay . liftIO . threadDelay
An infinite computation that prints an increasing series of numbers.
foobar' :: (MonadIO m) => Int -> IterT m a
foobar' x = do
let x' = x + 1
liftIO (print x')
delay (foobar' x')
With this in place, we can write foobar as:
foobar :: (MonadIO m) => MVar Bool -> m ()
foobar v = retract (delays 1000000 `mplus` untilTrue v `mplus` foobar' 0)
The neat thing about this is that you can change or remove the "stopping condition" and the delay very easily.
Some clarifications:
The delay function is not a delay in IO, it just tells the iterative monad transformer to "put the argument in a separate step".
retract brings you back from the iterative monad transformer to the base monad. It's like saying "I don't care about the steps, just run the computation". You can combine retract with cutoff if you want to limit the maximum number of iterations.
untilJustconverts a value m (Maybe a) of the base monad into a IterT m a by retrying in each step until a Just is returned. Of course, this risks non-termination!
MPredicate is rather superfluous here; m Bool can be used instead. The monad-loops package contains plenty of control structures with m Bool conditions. whileM_ in particular is applicable here, although we need to include a State monad for the Int that we're threading around:
import Control.Monad.State
import Control.Monad.Loops
import Control.Applicative
foobar :: MVar Bool -> IO ()
foobar mvb = (`evalStateT` (0 :: Int)) $
whileM_ (not <$> lift (readMVar mvb)) $ do
modify (+1)
lift . print =<< get
lift $ threadDelay 1000000
Alternatively, we can use a monadic version of unless. For some reason monad-loops doesn't export such a function, so let's write it:
unlessM :: Monad m => m Bool -> m () -> m ()
unlessM mb action = do
b <- mb
unless b action
It's somewhat more convenient and more modular in a monadic setting, since we can always go from a pure Bool to m Bool, but not vice versa.
foobar :: MVar Bool -> IO ()
foobar mvb = go 0
where
go :: Int -> IO ()
go x = unlessM (readMVar mvb) $ do
let x' = x + 1
print x'
threadDelay 1000000
go x'
You mentioned fix; sometimes people indeed use it for ad-hoc monadic loops, for example:
printUntil0 :: IO ()
printUntil0 =
putStrLn "hello"
fix $ \loop -> do
n <- fmap read getLine :: IO Int
print n
when (n /= 0) loop
putStrLn "bye"
With some juggling it's possible to use fix with multi-argument functions. In the case of foobar:
foobar :: MVar Bool -> IO ()
foobar mvb = ($(0 :: Int)) $ fix $ \loop x -> do
unlessM (readMVar mvb) $ do
let x' = x + 1
print x'
threadDelay 1000000
loop x'
I'm not sure what's your MPredicate is doing.
First, instead of newtyping a tuple, it's probably better to use a normal algebric data type
data MPredicate a m = MPredicate a (a -> m Bool)
Second, the way you use it, MPredicate is equivalent to m Bool.
Haskell is lazzy, therefore there is no need to pass, a function and it's argument (even though
it's usefull with strict languages). Just pass the result, and the function will be called when needed.
I mean, instead of passing (x, f) around, just pass f x
Of course, if you are not trying to delay the evaluation and really need at some point, the argument or the function as well as the result, a tuple is fine.
Anyway, in the case your MPredicate is only there to delay the function evaluation, MPredicat reduces to m Bool and doUnless to unless.
Your first example is strictly equivalent :
main = do
b <- newMVar False
unless (readMVar b) (print "foo")
Now, if you want to loop a monad until a condition is reach (or equivalent) you should have a look at the monad-loop package. What you are looking it at is probably untilM_ or equivalent.
Assume we have an IO action such as
lookupStuff :: InputType -> IO OutputType
which could be something simple such as DNS lookup, or some web-service call against a time-invariant data.
Let's assume that:
The operation never throws any exception and/or never diverges
If it wasn't for the IO monad, the function would be pure, i.e. the result is always the same for equal input parameters
The action is reentrant, i.e. it can be called from multiple threads at the same time safely.
The lookupStuff operation is quite (time-)expensive.
The problem I'm facing is how to properly (and w/o using any unsafe*IO* cheat) implement a reentrant cache, that can be called from multiple threads, and coalesces multiple queries for the same input-parameters into a single request.
I guess I'm after something similiar as GHC's blackhole-concept for pure computations but in the IO "calculation" context.
What is the idiomatic Haskell/GHC solution for the stated problem?
Yeah, basically reimplement the logic. Although it seems similar to what GHC is already doing, that's GHC's choice. Haskell can be implemented on VMs that work very differently, so in that sense it isn't already done for you.
But yeah, just use an MVar (Map InputType OutputType) or even an IORef (Map InputType OutputType) (make sure to modify with atomicModifyIORef), and just store the cache in there. If this imperative solution seems wrong, it's the "if not for the IO, this function would be pure" constraint. If it were just an arbitrary IO action, then the idea that you would have to keep state in order to know what to execute or not seems perfectly natural. The problem is that Haskell does not have a type for "pure IO" (which, if it depends on a database, it is just behaving pure under certain conditions, which is not the same as being a hereditarily pure).
import qualified Data.Map as Map
import Control.Concurrent.MVar
-- takes an IO function and returns a cached version
cache :: (Ord a) => (a -> IO b) -> IO (a -> IO b)
cache f = do
r <- newMVar Map.empty
return $ \x -> do
cacheMap <- takeMVar r
case Map.lookup x cacheMap of
Just y -> do
putMVar r cacheMap
return y
Nothing -> do
y <- f x
putMVar (Map.insert x y cacheMap)
return y
Yeah it's ugly on the inside. But on the outside, look at that! It's just like the type of a pure memoization function, except for it has IO stained all over it.
Here's some code implementing more or less what I was after in my original question:
import Control.Concurrent
import Control.Exception
import Data.Either
import Data.Map (Map)
import qualified Data.Map as Map
import Prelude hiding (catch)
-- |Memoizing wrapper for 'IO' actions
memoizeIO :: Ord a => (a -> IO b) -> IO (a -> IO b)
memoizeIO action = do
cache <- newMVar Map.empty
return $ memolup cache action
where
-- Lookup helper
memolup :: Ord a => MVar (Map a (Async b)) -> (a -> IO b) -> a -> IO b
memolup cache action' args = wait' =<< modifyMVar cache lup
where
lup tab = case Map.lookup args tab of
Just ares' ->
return (tab, ares')
Nothing -> do
ares' <- async $ action' args
return (Map.insert args ares' tab, ares')
The code above builds upon Simon Marlow's Async abstraction as described in Tutorial: Parallel and Concurrent Programming in Haskell:
-- |Opaque type representing asynchronous results.
data Async a = Async ThreadId (MVar (Either SomeException a))
-- |Construct 'Async' result. Can be waited on with 'wait'.
async :: IO a -> IO (Async a)
async io = do
var <- newEmptyMVar
tid <- forkIO ((do r <- io; putMVar var (Right r))
`catch` \e -> putMVar var (Left e))
return $ Async tid var
-- |Extract value from asynchronous result. May block if result is not
-- available yet. Exceptions are returned as 'Left' values.
wait :: Async a -> IO (Either SomeException a)
wait (Async _ m) = readMVar m
-- |Version of 'wait' that raises exception.
wait' :: Async a -> IO a
wait' a = either throw return =<< wait a
-- |Cancels asynchronous computation if not yet completed (non-blocking).
cancel :: Async a -> IO ()
cancel (Async t _) = throwTo t ThreadKilled