  Handle for the Keys database . 
  - 
  - Copyright 2015   <  > 
  - : 
  - Licensed under the GNU GPL version 3 or higher . 
 
 -
 - Copyright 2015 Joey Hess <>
 -:
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Database.Keys.Handle (
	DbHandle,
	newDbHandle,
	unavailableDbHandle,
	DbState(..),
	withDbState,
	flushDbQueue,
	closeDbHandle,
) where

import qualified Database.Queue as H
import Utility.Exception

import Control.Concurrent
import Control.Monad.IO.Class (liftIO, MonadIO)
import Control.Applicative
import Prelude

  The MVar is always left full except when actions are run
-- that access the database.
newtype DbHandle = DbHandle (MVar DbState)

-- The database can be closed or open, but it also may have been
-- tried to open (for read) and didn't exist yet or is not readable.
data DbState = DbClosed | DbOpen H.DbQueue | DbUnavailable

newDbHandle :: IO DbHandle
newDbHandle = DbHandle <$> newMVar DbClosed

unavailableDbHandle :: IO DbHandle
unavailableDbHandle = DbHandle <$> newMVar DbUnavailable

-- Runs an action on the state of the handle, which can change its state.
  The MVar is empty while the action runs , which blocks other users
-- of the handle from running.
withDbState
	:: (MonadIO m, MonadCatch m)
	=> DbHandle
	-> (DbState -> m (v, DbState))
	-> m v
withDbState (DbHandle mvar) a = do
	st <- liftIO $ takeMVar mvar
	go st `onException` (liftIO $ putMVar mvar st)
  where
	go st = do
		(v, st') <- a st
		liftIO $ putMVar mvar st'
		return v

flushDbQueue :: DbHandle -> IO ()
flushDbQueue (DbHandle mvar) = go =<< readMVar mvar
  where
	go (DbOpen qh) = H.flushDbQueue qh
	go _ = return ()

closeDbHandle :: DbHandle -> IO ()
closeDbHandle h = withDbState h go
  where
	go (DbOpen qh) = do
		H.closeDbQueue qh
		return ((), DbClosed)
	go st = return ((), st)

 that access the database.
 The database can be closed or open, but it also may have been
 tried to open (for read) and didn't exist yet or is not readable.
 Runs an action on the state of the handle, which can change its state.
 of the handle from running.
  Handle for the Keys database . 
  - 
  - Copyright 2015   <  > 
  - : 
  - Licensed under the GNU GPL version 3 or higher . 
 
 -
 - Copyright 2015 Joey Hess <>
 -:
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Database.Keys.Handle (
	DbHandle,
	newDbHandle,
	unavailableDbHandle,
	DbState(..),
	withDbState,
	flushDbQueue,
	closeDbHandle,
) where

import qualified Database.Queue as H
import Utility.Exception

import Control.Concurrent
import Control.Monad.IO.Class (liftIO, MonadIO)
import Control.Applicative
import Prelude

  The MVar is always left full except when actions are run
newtype DbHandle = DbHandle (MVar DbState)

data DbState = DbClosed | DbOpen H.DbQueue | DbUnavailable

newDbHandle :: IO DbHandle
newDbHandle = DbHandle <$> newMVar DbClosed

unavailableDbHandle :: IO DbHandle
unavailableDbHandle = DbHandle <$> newMVar DbUnavailable

  The MVar is empty while the action runs , which blocks other users
withDbState
	:: (MonadIO m, MonadCatch m)
	=> DbHandle
	-> (DbState -> m (v, DbState))
	-> m v
withDbState (DbHandle mvar) a = do
	st <- liftIO $ takeMVar mvar
	go st `onException` (liftIO $ putMVar mvar st)
  where
	go st = do
		(v, st') <- a st
		liftIO $ putMVar mvar st'
		return v

flushDbQueue :: DbHandle -> IO ()
flushDbQueue (DbHandle mvar) = go =<< readMVar mvar
  where
	go (DbOpen qh) = H.flushDbQueue qh
	go _ = return ()

closeDbHandle :: DbHandle -> IO ()
closeDbHandle h = withDbState h go
  where
	go (DbOpen qh) = do
		H.closeDbQueue qh
		return ((), DbClosed)
	go st = return ((), st)
