{- |
   Module     : Database.HDBC.DriverUtils
   Copyright  : Copyright (C) 2006 John Goerzen
   License    : BSD3

   Maintainer : John Goerzen <jgoerzen@complete.org>
   Stability  : provisional
   Portability: portable

Utilities for database backend drivers.

Please note: this module is intended for authors of database driver libraries
only.  Authors of applications using HDBC should use 'Database.HDBC'
exclusively.

Written by John Goerzen, jgoerzen\@complete.org
-}

module Database.HDBC.DriverUtils (
                                  ChildList,
                                  closeAllChildren,
                                  addChild
                                 )

where
import Control.Concurrent.MVar
import System.Mem.Weak
import Database.HDBC.Types
import Control.Monad

type ChildList = MVar [Weak Statement]

{- | Close all children.  Intended to be called by the 'disconnect' function
in 'Connection'. 

There may be a potential race condition wherein a call to newSth at the same
time as a call to this function may result in the new child not being closed.
-}
closeAllChildren :: ChildList -> IO ()
closeAllChildren :: ChildList -> IO ()
closeAllChildren ChildList
mcl = 
    do [Weak Statement]
children <- ChildList -> IO [Weak Statement]
forall a. MVar a -> IO a
readMVar ChildList
mcl
       (Weak Statement -> IO ()) -> [Weak Statement] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Weak Statement -> IO ()
closefunc [Weak Statement]
children
    where closefunc :: Weak Statement -> IO ()
closefunc Weak Statement
child =
              do Maybe Statement
c <- Weak Statement -> IO (Maybe Statement)
forall v. Weak v -> IO (Maybe v)
deRefWeak Weak Statement
child
                 case Maybe Statement
c of
                   Maybe Statement
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                   Just Statement
x -> Statement -> IO ()
finish Statement
x

{- | Adds a new child to the existing list.  Also takes care of registering
a finalizer for it, to remove it from the list when possible. -}
addChild :: ChildList -> Statement -> IO ()
addChild :: ChildList -> Statement -> IO ()
addChild ChildList
mcl Statement
stmt =
    do Weak Statement
weakptr <- Statement -> Maybe (IO ()) -> IO (Weak Statement)
forall k. k -> Maybe (IO ()) -> IO (Weak k)
mkWeakPtr Statement
stmt (IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (ChildList -> IO ()
childFinalizer ChildList
mcl))
       ChildList -> ([Weak Statement] -> IO [Weak Statement]) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ ChildList
mcl (\[Weak Statement]
l -> [Weak Statement] -> IO [Weak Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return (Weak Statement
weakptr Weak Statement -> [Weak Statement] -> [Weak Statement]
forall a. a -> [a] -> [a]
: [Weak Statement]
l))

{- | The general finalizer for a child.

It is simply a filter that removes any finalized weak pointers from the parent.

If the MVar is locked at the start, does nothing to avoid deadlock.  Future
runs would probably catch it anyway. -}
childFinalizer :: ChildList -> IO ()
childFinalizer :: ChildList -> IO ()
childFinalizer ChildList
mcl = 
    do Maybe [Weak Statement]
c <- ChildList -> IO (Maybe [Weak Statement])
forall a. MVar a -> IO (Maybe a)
tryTakeMVar ChildList
mcl
       case Maybe [Weak Statement]
c of
         Maybe [Weak Statement]
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         Just [Weak Statement]
cl ->
             do [Weak Statement]
newlist <- (Weak Statement -> IO Bool)
-> [Weak Statement] -> IO [Weak Statement]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Weak Statement -> IO Bool
forall v. Weak v -> IO Bool
filterfunc [Weak Statement]
cl
                ChildList -> [Weak Statement] -> IO ()
forall a. MVar a -> a -> IO ()
putMVar ChildList
mcl [Weak Statement]
newlist
    where filterfunc :: Weak v -> IO Bool
filterfunc Weak v
c =
              do Maybe v
dc <- Weak v -> IO (Maybe v)
forall v. Weak v -> IO (Maybe v)
deRefWeak Weak v
c
                 case Maybe v
dc of
                   Maybe v
Nothing -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                   Just v
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True