-- |
-- Module      :  Control.Manager
-- Copyright   :  (c) Alexandru Scvortov 2008
-- License     :  LGPL (see LICENSE file)
-- Maintainer  :  scvalex@gmail.com
--

-- FIXME Control.Manager is overly complicated.
module Control.Manager
    ( ioManager
    , ConnInstr(..)
    , connectionManager
    ) where

import Control.Concurrent
import Control.Concurrent.Extra
import Control.Concurrent.STM
import Control.Exception.Extra
import Control.Monad 
import Text.Printf ( printf )


-- | ioManager reads IO actions off the channel and executes them in
-- sequence.
--
-- NOTE: it is meant to run as a separate thread
ioManager :: TChan (IO ()) -> IO ()
ioManager c = do
  putStrLn "Standalone: IO Manager starting..."
  forever $ do
    acc <- atomically $ readTChan c
    acc -- TODO why can't I combine this 
        -- with the above bind statement

-- | used to control the behaviour of connectionManager
data ConnInstr = ConnInstr (IO ()) -- ^ the query/connection action
                           (Maybe Integer) -- ^ timeout in MILIseconds
                           (String -> IO ()) -- ^ what to do if action fails
                           (IO ()) -- ^ what to do after, regardless of outcome

-- | connectionManager reads ConnInstr from the channel and executes
-- them, keeping a cap on the maximum number of connections
--
-- NOTE: it is meant to run as a spearate thread
connectionManager :: TChan ConnInstr -- ^ connection instruction channel
                  -> Int             -- ^ max connections
                  -> IO ()
connectionManager cctrl cap = do
  putStrLn "Standalone: Connection Manager starting..."
  connAlive <- newTVarIO 0
  forever $ do
    ConnInstr act mt fai fin <- atomically $ do
                 stillAlive <- readTVar connAlive
                 check (stillAlive < cap)
                 i <- readTChan cctrl
                 modifyTVar connAlive (+1)
                 return i
    case mt of
      Nothing -> do
              forkIO $ act `catchAll` (\e -> fai $ "connection error: " ++ show e)
                           `finally` (fin >> (atomically $ modifyTVar connAlive (\x -> x - 1)))
      Just n -> do
                 forkIOWithTimeout n
                                   (act `catchAll` (\e -> fai $ "connection error: " ++ show e))
                                   (fai "timed out")
                               `finally` (fin >> (atomically $ modifyTVar connAlive (\x -> x - 1)))
