module Gnome.Keyring.Internal.Operation
(
Operation
, async
, async'
, sync
, OperationImpl
, operationImpl
, voidOperation
, maybeTextOperation
, textListOperation
) where
import Control.Exception (throwIO)
import Control.Monad (join)
import Data.Text.Lazy (Text)
import Gnome.Keyring.Internal.FFI
import Gnome.Keyring.Internal.Types
data Operation a = Operation
{ async :: (Error -> IO ()) -> (a -> IO ()) -> IO CancellationKey
, syncImpl :: IO (Result, a)
}
sync :: Operation a -> IO a
sync op = do
(res, x) <- syncImpl op
case res of
RESULT_OK -> return x
_ -> throwIO $ resultToError res
async' :: Operation a -> (Error -> IO ()) -> IO () -> IO CancellationKey
async' op onError onSuccess = async op onError (const onSuccess)
type OperationImpl a b = (FunPtr a -> Ptr () -> DestroyNotifyPtr -> IO CancellationKey) -> IO (Result, b) -> Operation b
operationImpl :: ((CInt -> IO a -> IO ()) -> IO (FunPtr b)) -> OperationImpl b a
operationImpl impl asyncIO = Operation $ \onError onSuccess -> do
callback <- impl $ \cres io -> case result cres of
RESULT_OK -> io >>= onSuccess
x -> onError $ resultToError x
destroy <- wrapDestroyNotify $ \ptr -> do
let stable = castPtrToStablePtr ptr
join $ deRefStablePtr stable
freeStablePtr stable
stable <- newStablePtr $ do
freeHaskellFunPtr callback
freeHaskellFunPtr destroy
asyncIO callback (castStablePtrToPtr stable) destroy
voidOperation :: OperationImpl DoneCallback ()
voidOperation = operationImpl $ \checkResult ->
wrapDoneCallback $ \cres _ ->
checkResult cres $ return ()
maybeTextOperation :: OperationImpl GetStringCallback (Maybe Text)
maybeTextOperation = operationImpl $ \checkResult ->
wrapGetStringCallback $ \cres cstr _ ->
checkResult cres $ peekNullableText cstr
textListOperation :: OperationImpl GetListCallback [Text]
textListOperation = operationImpl $ \checkResult ->
wrapGetListCallback $ \cres list _ ->
checkResult cres $ mapGList peekText list