LINUX.ORG.RU

История изменений

Исправление 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)

я почти сплю так что с десяток очепяток тут есть, но смысл такой.