История изменений
Исправление qnikst, (текущая версия) :
в принципе твой вариант на STM тоже хорошо ложится:
newtype TimedTask a = TT { unTT :: (UTCTime, a)}
instance Ord a where
compare = compare `on` (fst . unTT)
-- подойдет любая очередь приоритетов
class Heap where
deleteMin :: Heap a -> Heap a
findMin :: Ord a => Heap a -> Maybe a
insert :: Ord a => a -> Heap a -> Heap a
worker first storage mdelay = do
ctime <- getCurrentTime
maybe (newTVarIO False) (registerDelay) mdelay
ret <- atomically $
(do
(tm,task) <- takeTMVar first
if tm < ctime
then do
Foldable.forM_ (putTMVar first) =<< findMin <$> readTVar storage
modifyTVar storage deleteMin
return $ Right task
else return $ Left (tm `diffTime` ctime))
`orElse` (readTVar delay >>= flip unless retry)
case ret of
Right task -> do
run task
addAgain task
worker first loop Nothing
Left d -> worker fist storage (Just {- тут тип нужно привести -} d)
и создавай сколько нужно воркеров, добавление задачи будет так:
addTask first storage d t = do
c <- getCurrectTime
let c' = c `addTime` d --на память не помню но в UTCTime все методы нужные есть
atomically $ do
f@(t, _) <- readTMVar first
if t < c'
then modifyTVar storage (insert (d,t))
else do
modifyTVar storage (insert f)
swapTMVar first (d,t)
я почти сплю так что с десяток очепяток тут есть, но смысл такой.
Исправление qnikst, :
в принципе твой вариант на STM тоже хорошо ложится:
newtype TimedTask a = TT { unTT :: (UTCTime, a)}
instance Ord a where
compare = compare `on` (fst . unTT)
-- подойдет любая очередь приоритетов
class Heap where
deleteMin :: Heap a -> Heap a
findMin :: Ord a => Heap a -> Maybe a
insert :: Ord a => a -> Heap a -> Heap a
worker first storage mdelay = do
ctime <- getCurrentTime
maybe (newTVarIO False) (registerDelay) mdelay
ret <- atomically $
(do
(tm,task) <- takeTMVar first
if tm < ctime
then do
Foldable.forM_ (putTMVar fist) =<< findMin <$> readTVar storage
modifyTVar storage deleteMin
return $ Right task
else return $ Left (tm `diffTime` ctime))
`orElse` (readTVar delay >>= flip unless retry)
case ret of
Right task -> do
run task
addAgain task
worker first loop Nothing
Left d -> worker fist storage (Just {- тут тип нужно привести -} d)
и создавай сколько нужно воркеров, добавление задачи будет так:
addTask first storage d t = do
c <- getCurrectTime
let c' = c `addTime` d --на память не помню но в UTCTime все методы нужные есть
atomically $ do
f@(t, _) <- readTMVar first
if t < c'
then modifyTVar storage (insert (d,t))
else do
modifyTVar storage (insert f)
swapTMVar first (d,t)
я почти сплю так что с десяток очепяток тут есть, но смысл такой.
Исправление qnikst, :
в принципе твой вариант на STM тоже хорошо ложится:
newtype TimedTask a = TT { unTT :: (UTCTime, a)}
instance Ord a where
compare = compare `on` (fst . unTT)
-- подойдет любая очередь приоритетов
class Heap where
deleteMin :: Heap a -> Heap a
findMin :: Ord a => Heap a -> a
insert :: Ord a => a -> Heap a -> Heap a
worker first storage mdelay = do
ctime <- getCurrentTime
maybe (newTVarIO False) (registerDelay) mdelay
ret <- atomically $
(do
(tm,task) <- takeTMVar first
if tm < ctime
then do
f' <- findMin <$> readTVar storage
putTMVar first f'
modifyTVar storage deleteMin
return $ Right task
else return $ Left (tm `diffTime` ctime))
`orElse` (readTVar delay >>= flip unless retry)
case ret of
Right task -> do
run task
addAgain task
worker first loop Nothing
Left d -> worker fist storage (Just {- тут тип нужно привести -} d)
и создавай сколько нужно воркеров, добавление задачи будет так:
addTask first storage d t = do
c <- getCurrectTime
let c' = c `addTime` d --на память не помню но в UTCTime все методы нужные есть
atomically $ do
f@(t, _) <- readTMVar first
if t < c'
then modifyTVar storage (insert (d,t))
else do
modifyTVar storage (insert f)
swapTMVar first (d,t)
я почти сплю так что с десяток очепяток тут есть, но смысл такой.
Исправление qnikst, :
в принципе твой вариант на STM тоже хорошо ложится:
newtype TimedTask a = TT { unTT :: (UTCTime, a)}
instance Ord a where
compare = compare `on` (fst . unTT)
-- подойдет любая очередь приоритетов
class Heap where
deleteMin :: Heap a -> Heap a
findMin :: Ord a => Heap a -> a
insert :: Ord a => a -> Heap a -> Heap a
worker first storage mdelay = do
ctime <- getCurrentTime
maybe (newTVarIO False) (registerDelay) mdelay
ret <- atomically $
(do
(tm,task) <- readTVar first
if tm < ctime
then do
f' <- findMin <$> readTVar storage
writeTVar first f'
modifyTVar storage deleteMin
return $ Right task
else return $ Left (tm `diffTime` ctime))
`orElse` (readTVar delay >>= flip unless retry)
case ret of
Right task -> do
run task
addAgain task
worker first loop Nothing
Left d -> worker fist storage (Just {- тут тип нужно привести -} d)
и создавай сколько нужно воркеров, добавление задачи будет так:
addTask first storage d t = do
c <- getCurrectTime
let c' = c `addTime` d --на память не помню но в UTCTime все методы нужные есть
atomically $ do
f@(t, _) <- readTVar first
if t < c'
then modifyTVar storage (insert (d,t))
else do
modifyTVar storage (insert f)
writeTVar first (d,t)
я почти сплю так что с десяток очепяток тут есть, но смысл такой.
Исправление qnikst, :
в принципе твой вариант на STM тоже хорошо ложится:
newtype TimedTask a = TT { unTT :: (UTCTime, a)}
instance Ord a where
compare = compare `on` (fst . unTT)
-- подойдет любая очередь приоритетов
class Heap where
deleteMin :: Heap a -> Heap a
findMin :: Ord a => Heap a -> a
insert :: Ord a => a -> Heap a -> Heap a
worker first storage mdelay = do
ctime <- getCurrentTime
maybe (newTVarIO False) (registerDelay) mdelay
ret <- atomically $
(do
(tm,task) <- readTVar first
if tm < ctime
then do
f' <- findMin <$> readTVar storage
writeTVar first f'
modifyTVar storage deleteMin
return $ Right task
else return $ Left (tm `diffTime` ctime))
`orElse` (readTVar delay >>= flip unless retry)
case ret of
Right task -> do
run task
addAgain task
worker first loop Nothing
Left d -> worker fist storage (Just {- тут тип нужно привести -} d)
и создавай сколько нужно воркеров, добавление задачи будет так:
addTask d t = do
c <- getCurrectTime
let c' = c `addTime` d --на память не помню но в UTCTime все методы нужные есть
atomically $ do
f@(t, _) <- readTVar first
if t < c'
then modifyTVar storage (insert (d,t))
else do
modifyTVar storage (insert f)
writeTVar first (d,t)
я почти сплю так что с десяток очепяток тут есть, но смысл такой.
Исходная версия qnikst, :
в принципе твой вариант на STM тоже хорошо ложится:
newtype TimedTask a = TT { unTT :: (UTCTime, a)}
instance Ord a where
compare = compare `on` (fst . unTT)
-- подойдет любая очередь приоритетов
class Heap where
deleteMin :: Heap a -> Heap a
findMin :: Ord a => Heap a -> a
insert :: Ord a => a -> Heap a -> Heap a
worker first storage mdelay = do
ctime <- getCurrentTime
maybe (newTVarIO False) (registerDelay) mdelay
ret <- atomically $
(do
(tm,task) <- readTVar first
if tm < ctime
then do
f' <- findMin <$> readTVar storage
writeTVar first f'
modifyTVar storage deleteMin
return $ Right task
else return $ Left (tm `diffTime` ctime))
`orElse` (readTVar delay >>= flip unless retry)
case ret of
Right task -> do
run task
addAgain task
worker first loop Nothing
Left d -> worker fist storage (Just {- тут тип нужно привести -} d)
и создавай сколько нужно воркеров, добавление задачи будет так:
addTask d t = do c <- getCurrectTime let c' = c `addTime` d --на память не помню но в UTCTime все методы нужные есть atomically $ do f@(t, _) <- readTVar first if t < c' then modifyTVar storage (insert (d,t)) else do modifyTVar storage (insert f) writeTVar first (d,t)
я почти сплю так что с десяток очепяток тут есть, но смысл такой.