how could one implement a function in concurrent haskell that either returns 'a' successfully or due to timeout 'b'?
timed :: Int → IO a → b → IO (Either a b)
timed max act def = do
Best Regards,
Cetin Sert
Note: the signature of timed can be completely or slightly different.
Implementing your desired timed on top of System.Timeout.timeout is easy:
import System.Timeout (timeout)
timed :: Int -> IO a -> b -> IO (Either b a)
timed us act def = liftM (maybe (Left def) Right) (timeout us act)
By the way, the common implementation of timeout is closer to this: ($! = seq to try to force evaluation of the returned value in the thread rather than only returning a thunk):
import Control.Concurrent (forkIO, threadDelay, killThread)
import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
import System.IO (hPrint, stderr)
timeout :: Int -> IO a -> IO (Maybe a)
timeout us act = do
mvar <- newEmptyMVar
tid1 <- forkIO $ (putMVar mvar . Just $!) =<< act
tid2 <- forkIO $ threadDelay us >> putMVar mvar Nothing
res <- takeMVar mvar
killThread (maybe tid1 (const tid2) res) `catch` hPrint stderr
return res
The implementation of System.Timeout.timeout in the libraries is a little more complex, handling more exceptional cases.
import Control.Concurrent (forkIO, threadDelay, myThreadId, killThread)
import Control.Exception (Exception, handleJust, throwTo, bracket)
import Data.Typeable
import Data.Unique (Unique, newUnique)
data Timeout = Timeout Unique deriving Eq
timeoutTc :: TyCon
timeoutTc = mkTyCon "Timeout"
instance Typeable Timeout where { typeOf _ = mkTyConApp timeoutTc [] }
instance Show Timeout where
show _ = "<<timeout>>"
instance Exception Timeout
timeout n f
| n < 0 = fmap Just f
| n == 0 = return Nothing
| otherwise = do
pid <- myThreadId
ex <- fmap Timeout newUnique
handleJust (\e -> if e == ex then Just () else Nothing)
(\_ -> return Nothing)
(bracket (forkIO (threadDelay n >> throwTo pid ex))
(killThread)
(\_ -> fmap Just f))
Here's the first answer I could come up with. I needed this for a port scanner. o_O Forgot the admin password of my router and wanted to check which ports I had opened on our home server before that I could now repurpose and reuse ^ _ ^" ... This implementation should do the job for the time being.
module Control.Concurrent.Timed (timed) where
import Prelude hiding (take)
import System.IO
import Control.Monad
import System.Process
import System.Timeout
import Control.Concurrent
import System.Environment
timed :: Int → IO a → b → IO (Either b a)
timed max act def = do
w ← new
r ← new
t ← forkIO $ do
a ← act
r ≔ Right a
e ← em w
case e of
False → kill =<< take w
True → return ()
s ← forkIO $ do
(w ≔) =<< mine
wait max
e ← em r
case e of
True → do
kill t
r ≔ Left def
False → return ()
take r
timed_ :: Int → IO a → a → IO a
timed_ max act def = do
r ← timed max act def
return $ case r of
Right a → a
Left a → a
(≔) = putMVar
new = newEmptyMVar
wait = threadDelay
em = isEmptyMVar
kill = killThread
mine = myThreadId
take = takeMVar
or just use System.Timeout.timeout -__-"