I have a custom type
type GI a = StateT GenState IO a
where GenState is a state I keep for Generating Random Trees of some kind.
When generating my trees, termination is not guaranteed in a reasonable amount of time. That's why I thought I might terminate the calculation and restart it over and over again with a timeout until a result is given.
So my question is how to write a function of the form
tryGeneration :: GI a -> GI a
tryGeneraton action = ...
where action is the calculation to try in some microseconds and if it runs out of time begin the action from the start.
Please keep in mind that I'm quite new to Monad Transformers and I cannot say that i fully understand them yet.
I tried to use lift with System.Timeout.timeout and did not succeed
EDIT: thank you all for your suggestions. I followed them, and got it done in the IO monad.
tryGenerationTime :: Int -> GenState -> GI a -> IO (a, GenState)
tryGenerationTime time state action = do
(_, s') <- -- change the random state to not generate the same thing over and over
res <- timeout time (runStateT action s')
case res of
Nothing -> tryGenerationTime time s' action
Just r -> return r
timeItT :: Int -> GI a -> GI a
timeItT time action = do
state <- get
(x, s') <- lift $ tryGenerationTime time state action
put s'
return x
Any suggestion to improving this code is welcome. I just wanted to get it done fast, since that wasn't the solution to my generation problem and I needed to set a limit to the tree height to succeed.
I suspect what you actually want is more like
tryGeneration :: GI a -> IO a
tryGeneraton action = ...
in such a way that all of your "build a tree" actions have timeout-based retries.
The key thing to understand is that "attempt to do X; if you aren't done in n milliseconds, start over" is IO's job; IO is where you have access to things like time. (Of course there are wrappers you could and should use when you only need part of what IO has to offer.)
This is fine; you have access to IO in GI, you probably just have to lift it.
That said, there's not enough information here to say exactly how to do what you want, and I'm more familiar with free-monad effect systems than mtl transformers anyway...
Related
I am a senior C/C++/Java/Assembler programmer and I have been always fascinated by the pure functional programming paradigm. From time to time, I try to implement something useful with it, e.g., a small tool, but often I quickly reach a point where I realize that I (and my tool, too) would be much faster in a non-pure language. It's probably because I have much more experience with imperative programming languages with thousands of idoms, patterns and typical solution approaches in my head.
Here is one of those situations. I have encountered it several times and I hope you guys can help me.
Let's assume I write a tool to simulate communication networks. One important task is the generation of network packets. The generation is quite complex, consisting of dozens of functions and configuration parameters, but at the end there is one master function and because I find it useful I always write down the signature:
generatePackets :: Configuration -> [Packet]
However, after a while I notice that it would be great if the packet generation would have some kind of random behavior deep down in one of the many sub-functions of the generation process. Since I need a random number generator for that (and I also need it at some other places in the code), this means to manually change dozens of signatures to something like
f :: Configuration -> RNGState [Packet]
with
type RNGState = State StdGen
I understand the "mathematical" necessity (no states) behind this. My question is on a higher (?) level: How would an experienced Haskell programmer have approached this situation? What kind of design pattern or work flow would have avoided the extra work later?
I have never worked with an experienced Haskell programmer. Maybe you will tell me that you never write signatures because you have to change them too often afterwards, or that you give all your functions a state monad, "just in case" :)
One approach that I've been fairly successful with is using a monad transformer stack. This lets you both add new effects when needed and also track the effects required by particular functions.
Here's a really simple example.
import Control.Monad.State
import Control.Monad.Reader
data Config = Config { v1 :: Int, v2 :: Int }
-- the type of the entire program describes all the effects that it can do
type Program = StateT Int (ReaderT Config IO) ()
runProgram program config startState =
runReaderT (runStateT program startState) config
-- doesn't use configuration values. doesn't do IO
step1 :: MonadState Int m => m ()
step1 = get >>= \x -> put (x+1)
-- can use configuration and change state, but can't do IO
step2 :: (MonadReader Config m, MonadState Int m) => m ()
step2 = do
x <- asks v1
y <- get
put (x+y)
-- can use configuration and do IO, but won't touch our internal state
step3 :: (MonadReader Config m, MonadIO m) => m ()
step3 = do
x <- asks v2
liftIO $ putStrLn ("the value of v2 is " ++ show x)
program :: Program
program = step1 >> step2 >> step3
main :: IO ()
main = do
let config = Config { v1 = 42, v2 = 123 }
startState = 17
result <- runProgram program config startState
return ()
Now if we want to add another effect:
step4 :: MonadWriter String m => m()
step4 = tell "done!"
program :: Program
program = step1 >> step2 >> step3 >> step4
Just adjust Program and runProgram
type Program = StateT Int (ReaderT Config (WriterT String IO)) ()
runProgram program config startState =
runWriterT $ runReaderT (runStateT program startState) config
To summarize, this approach lets us decompose a program in a way that tracks effects but also allows adding new effects as needed without a huge amount of refactoring.
edit:
It's come to my attention that I didn't answer the question about what to do for code that's already written. In many cases, it's not too difficult to change pure code into this style:
computation :: Double -> Double -> Double
computation x y = x + y
becomes
computation :: Monad m => Double -> Double -> m Double
computation x y = return (x + y)
This function will now work for any monad, but doesn't have access to any extra effects. Specifically, if we add another monad transformer to Program, then computation will still work.
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.
Is there any way to start two hint interpreters and at runtime & subsequently assign smaller computations to either one or the other? When I invoke hint for a small expression (e.g. typed into a website) then, - without reliable testing -, it seems to me as if the time to start/load hint is approximately one second. If the instance is already started that second would be shaved.
The hint seems to have no function where I can start it and keep it nicely pending for later use.
(Auto)Plugins would be a further option of course but I think that is more suitable for modules and less elegant for smaller computations.
The GHC api, which hint is implemented in terms of (the various plugin packages are, too), does not support concurrent use.
You can leave hint running, though. It's an instance of MonadIO.
interpreterLoop :: (MonadIO m, Typeable) a => Chan ((MVar a, String)) -> InterpreterT m ()
interpreterLoop ch = do
(mvar, command) <- liftIO $ readChan ch
a <- interpret command $ argTypeWitness mvar
liftIO $ putMVar mvar a
interpreterLoop ch
where
argTypeWitness :: MVar a -> a
argTypeWitness = undefined -- this value is only used for type checking, never evaluated
runInLoop :: Typeable a => Chan ((MVar a, String)) -> String -> IO a
runInLoop ch command = do
mvar <- newEmptyMVar
writeChan ch (mvar, command)
takeMVar mvar
(I didn't test this, so I may have missed a detail or two, but the basic idea will work.)
I want to compose operations that may fail, but there is a way to roll back.
For example - an external call to book a hotel room, and an external call to charge a credit card. Both of those calls may fail such as no rooms left, invalid credit card. Both have ways to roll back - cancel hotel room, cancel credit charge.
Is there a name for this type of (not real) atomic. Whenever i search for haskell transaction, I get STM.
Is there an abstraction, a way to compose them, or a library in haskell or any other language?
I feel you could write a monad Atomic T which will track these operations and roll them back if there is an exception.
Edit:
These operations may be IO operations. If the operations were only memory operations, as the two answers suggest, STM would suffice.
For example booking hotels would via HTTP requests. Database operations such as inserting records via socket communication.
In the real world, for irreversible operations there is a grace period before the operation will be done - e.g. credit cards payments and hotel bookings may be settled at the end of the day, and therefore it is fine to cancel before then.
This is exactly the purpose of STM. Actions are composed so that they succeed or fail together, automatically.
Very similar to your hotel room problem is the bank transaction example in Simon Peyton-Jones's chapter in "Beautiful Code": http://research.microsoft.com/en-us/um/people/simonpj/papers/stm/beautiful.pdf
If you need to resort to making your own monad, it will look something like this:
import Control.Exception (onException, throwIO)
newtype Rollbackable a = Rollbackable (IO (IO (), a))
runRollbackable :: Rollbackable a -> IO a
runRollbackable (Rollbackable m) = fmap snd m
-- you might want this to catch exceptions and return IO (Either SomeException a) instead
instance Monad Rollbackable where
return x = Rollbackable $ return (return (), x)
Rollbackable m >>= f
= do (rollback, x) <- m
Rollbackable (f x `onException` rollback)
(You will probably want Functor and Applicative instances also, but they're trivial.)
You would define your rollbackable primitive actions in this way:
rollbackableChargeCreditCard :: CardNumber -> CurrencyAmount -> Rollbackable CCTransactionRef
rollbackableChargeCreditCard ccno amount = Rollbackable
$ do ref <- ioChargeCreditCard ccno amount
return (ioUnchargeCreditCard ref, ref)
ioChargeCreditCard :: CardNumber -> CurrencyAmount -> IO CCTransactionRef
-- use throwIO on failure
ioUnchargeCreditCard :: CCTransactionRef -> IO ()
-- these both just do ordinary i/o
Then run them like so:
runRollbackable
$ do price <- rollbackableReserveRoom roomRequirements when
paymentRef <- rollbackableChargeCreditCard ccno price
-- etc
If your computations could be done only with TVar like things then STM is perfect.
If you need a side effect (like "charge Bob $100") and if there is a error later issue a retraction (like "refund Bob $100") then you need, drumroll please: Control.Exceptions.bracketOnError
bracketOnError
:: IO a -- ^ computation to run first (\"acquire resource\")
-> (a -> IO b) -- ^ computation to run last (\"release resource\")
-> (a -> IO c) -- ^ computation to run in-between
-> IO c -- returns the value from the in-between computation
Like Control.Exception.bracket, but only performs the final action if there was an
exception raised by the in-between computation.
Thus I could imagine using this like:
let safe'charge'Bob = bracketOnError (charge'Bob) (\a -> refund'Bob)
safe'charge'Bob $ \a -> do
rest'of'transaction
which'may'throw'error
Make sure you understand where to use the Control.Exception.mask operation if you are in a multi-threaded program and try things like this.
And I should emphasize that you can and should read the Source Code to Control.Exception and Control.Exception.Base to see how this is done in GHC.
You really can do this with the clever application of STM. The key is to separate out the IO parts. I assume the trouble is that a transaction might appear to succeed initially, and fail only later on. (If you can recognize failure right away, or soon after, things are simpler):
main = do
r <- reserveHotel
c <- chargeCreditCard
let room = newTVar r
card = newTVar c
transFailure = newEmptyTMVar
rollback <- forkIO $ do
a <- atomically $ takeTMVar transFailure --blocks until we put something here
case a of
Left "No Room" -> allFullRollback
Right "Card declined" -> badCardRollback
failure <- listenForFailure -- A hypothetical IO action that blocks, waiting for
-- a failure message or an "all clear"
case failures of
"No Room" -> atomically $ putTMVar (Left "No Room")
"Card Declined" -> atomically $ putTMVar (Right "Card declined")
_ -> return ()
Now, there's nothing here that MVars couldn't handle: all we're doing is forking a thread to wait and see if we need to fix things. But you'll presumably be doing some other stuff with your card charges and hotel reservations...
Sometimes I want to run a maximum amount of IO actions in parallel at once for network-activity, etc. I whipped up a small concurrent thread function which works well with https://gist.github.com/810920, but this isn't really a pool as all IO actions must finish before others can start.
The type of what I'm looking for would be something like:
runPool :: Int -> [IO a] -> IO [a]
and should be able to operate on finite and infinite lists.
The pipes package looks like it would be able to achieve this quite well, but I feel there is probably a similar solution to the gist I have provided just using mvars, etc, from the haskell-platform.
Has anyone encountered an idiomatic solution without any heavy dependencies?
You need a thread pool, if you want something short, you could get inspiration from Control.ThreadPool (from the control-engine package which also provide more general functions), for instance threadPoolIO is just :
threadPoolIO :: Int -> (a -> IO b) -> IO (Chan a, Chan b)
threadPoolIO nr mutator = do
input <- newChan
output <- newChan
forM_ [1..nr] $
\_ -> forkIO (forever $ do
i <- readChan input
o <- mutator i
writeChan output o)
return (input, output)
It use two Chan for communication with the outside but that's usually what you want, it really help writing code that don't mess up.
If you absolutely want to wrap it up in a function of your type you can encapsulate the communication too :
runPool :: Int -> [IO a] -> IO [a]
runPool n as = do
(input, output) <- threadPoolIO n (id)
forM_ as $ writeChan input
sequence (repeat (length as) $ readChan output)
This won't keep the order of your actions, is that a problem (it's easy to correct by transmitting the index of the action or just using an array instead to store the responses) ?
Note : the n threads will stay alive forever with this simplistic version, adding a "killAll" returned action to threadPoolIO would resolve this problem handily if you intend to create and trash several of those pool in a long running application (if not, given the weight of threads in Haskell, it's probably not worth the bother).
Note that this function works on finite lists only, that's because IO is normally strict so you can't start to process elements of IO [a] before the whole list is produced, if you really want that you'll have either to use lazy IO with unsafeInterleaveIO (maybe not the best idea) or completely change your model and use something like conduits to stream your results.