remove comments

remove comments

{-#LANGUAGE ForeignFunctionInterface #-}

module Cudd.Reorder (
    CuddReorderingType(..),
    cuddReorderingStatus,
    cuddAutodynEnable,
    cuddAutodynDisable,
    cuddReduceHeap,
    cuddMakeTreeNode,
    cuddReadReorderingTime,
    cuddReadReorderings,
    cuddEnableReorderingReporting,
    cuddDisableReorderingReporting,
    cuddReorderingReporting,
    regStdPreReordHook,
    regStdPostReordHook,
    cuddTurnOnCountDead,
    cuddTurnOffCountDead,
    cuddDeadAreCounted,
    cuddReadSiftMaxSwap,
    cuddSetSiftMaxSwap,
    cuddReadSiftMaxVar,
    cuddSetSiftMaxVar,
    cuddReadNextReordering,
    cuddSetNextReordering,
    cuddReadMaxGrowthAlternate,
    cuddSetMaxGrowthAlternate,
    cuddReadMaxGrowth,
    cuddReadReorderingCycle,
    cuddSetReorderingCycle,
    cuddSetPopulationSize,
    cuddReadNumberXovers,
    cuddSetNumberXovers,
    regReordGCHook
    ) where

import System.IO
import System.Mem
import Foreign
import Foreign.Ptr
import Foreign.C.Types
import Foreign.C.String
import Foreign.ForeignPtr
import Foreign.Marshal.Array
import Foreign.Marshal.Utils
import Control.Monad
import Control.Monad.ST
import Control.Monad.ST.Unsafe

import Cudd.Internal
import Cudd.C
import Cudd.Hook

#include <stdio.h>
#include <cudd.h>

readIntegral :: (Integral i, Num j) => (Ptr CDdManager -> IO i) -> STDdManager s u -> ST s j
readIntegral f (STDdManager m) = unsafeIOToST $ liftM fromIntegral $ f m

setIntegral :: (Integral i, Num j) => (Ptr CDdManager -> j -> IO ()) -> STDdManager s u -> i -> ST s ()
setIntegral f (STDdManager m) v = unsafeIOToST $ f m (fromIntegral v)

readFloat :: (Real r, Fractional f) => (Ptr CDdManager -> IO r) -> STDdManager s u -> ST s f
readFloat f (STDdManager m) = unsafeIOToST $ liftM realToFrac $ f m

setFloat :: (Real r, Fractional f) => (Ptr CDdManager -> f -> IO ()) -> STDdManager s u -> r -> ST s ()
setFloat f (STDdManager m) v = unsafeIOToST $ f m (realToFrac v)

--Reordering types
{#enum Cudd_ReorderingType as CuddReorderingType {underscoreToCase} deriving (Show, Eq) #}

--Reorder when needed
foreign import ccall safe "cudd.h Cudd_ReorderingStatus"
	c_cuddReorderingStatus :: Ptr CDdManager -> Ptr CInt -> IO (CInt)

cuddReorderingStatus :: STDdManager s u -> ST s (Int, CuddReorderingType)
cuddReorderingStatus (STDdManager m) = unsafeIOToST $ do
	alloca $ \mem -> do
		res <- c_cuddReorderingStatus m mem
		typ <- peek mem
		return $ (fromIntegral res, toEnum $ fromIntegral typ)

foreign import ccall safe "cudd.h Cudd_AutodynEnable"
	c_cuddAutodynEnable :: Ptr CDdManager -> CInt -> IO ()

cuddAutodynEnable :: STDdManager s u -> CuddReorderingType -> ST s ()
cuddAutodynEnable (STDdManager m) t = unsafeIOToST $ c_cuddAutodynEnable m (fromIntegral $ fromEnum t)

foreign import ccall safe "cudd.h Cudd_AutodynDisable"
	c_cuddAutodynDisable :: Ptr CDdManager -> IO ()

cuddAutodynDisable :: STDdManager s u -> ST s ()
cuddAutodynDisable (STDdManager m) = unsafeIOToST $ c_cuddAutodynDisable m

--Reorder right now
foreign import ccall safe "cudd.h Cudd_ReduceHeap"
	c_cuddReduceHeap :: Ptr CDdManager -> CInt -> CInt -> IO (CInt)

cuddReduceHeap :: STDdManager s u -> CuddReorderingType -> Int -> ST s Int
cuddReduceHeap (STDdManager m) typ minsize = unsafeIOToST $ liftM fromIntegral $ c_cuddReduceHeap m (fromIntegral $ fromEnum typ) (fromIntegral minsize)

--Grouping
foreign import ccall safe "cudd.h Cudd_MakeTreeNode"
	c_cuddMakeTreeNode :: Ptr CDdManager -> CUInt -> CUInt -> CUInt -> IO (Ptr ())

cuddMakeTreeNode :: STDdManager s u -> Int -> Int -> Int -> ST s (Ptr ())
cuddMakeTreeNode (STDdManager m) low size typ = unsafeIOToST $ do
    res <- c_cuddMakeTreeNode m (fromIntegral low) (fromIntegral size) (fromIntegral typ)
    when (res==nullPtr) (error "cuddMakeTreeNode returned error")
    return res

--Reordering stats
foreign import ccall safe "cudd.h Cudd_ReadReorderingTime"
	c_cuddReadReorderingTime :: Ptr CDdManager -> IO (CLong)

cuddReadReorderingTime :: STDdManager s u -> ST s Int
cuddReadReorderingTime = readIntegral c_cuddReadReorderingTime

foreign import ccall safe "cudd.h Cudd_ReadReorderings"
	c_cuddReadReorderings :: Ptr CDdManager -> IO (CUInt)

cuddReadReorderings :: STDdManager s u -> ST s Int
cuddReadReorderings = readIntegral c_cuddReadReorderings

--Hooks
foreign import ccall safe "cudd.h &Cudd_StdPreReordHook"
	c_cuddStdPreReordHook :: HookFP

foreign import ccall safe "cudd.h &Cudd_StdPostReordHook"
	c_cuddStdPostReordHook :: HookFP

foreign import ccall safe "cudd.h Cudd_EnableReorderingReporting"
	c_cuddEnableReorderingReporting :: Ptr CDdManager -> IO (CInt)

cuddEnableReorderingReporting :: STDdManager s u -> ST s Int
cuddEnableReorderingReporting (STDdManager m) = unsafeIOToST $ liftM fromIntegral $ c_cuddEnableReorderingReporting m

foreign import ccall safe "cudd.h Cudd_DisableReorderingReporting"
	c_cuddDisableReorderingReporting :: Ptr CDdManager -> IO (CInt)

cuddDisableReorderingReporting :: STDdManager s u -> ST s Int
cuddDisableReorderingReporting (STDdManager m) = unsafeIOToST $ liftM fromIntegral $ c_cuddDisableReorderingReporting m

foreign import ccall safe "cudd.h Cudd_ReorderingReporting"
	c_cuddReorderingReporting :: Ptr CDdManager -> IO (CInt)

cuddReorderingReporting :: STDdManager s u -> ST s Int
cuddReorderingReporting (STDdManager m) = unsafeIOToST $ liftM fromIntegral $ c_cuddReorderingReporting m

regStdPreReordHook :: STDdManager s u -> ST s Int
regStdPreReordHook m = cuddAddHook m c_cuddStdPreReordHook CuddPreReorderingHook

regStdPostReordHook :: STDdManager s u -> ST s Int
regStdPostReordHook m = cuddAddHook m c_cuddStdPostReordHook CuddPostReorderingHook

--Universal reordering params
foreign import ccall safe "cudd.h Cudd_TurnOffCountDead"
	c_cuddTurnOffCountDead :: Ptr CDdManager -> IO ()

cuddTurnOffCountDead :: STDdManager s u -> ST s ()
cuddTurnOffCountDead (STDdManager m) = unsafeIOToST $ c_cuddTurnOffCountDead m

foreign import ccall safe "cudd.h Cudd_TurnOnCountDead"
	c_cuddTurnOnCountDead :: Ptr CDdManager -> IO ()

cuddTurnOnCountDead :: STDdManager s u -> ST s ()
cuddTurnOnCountDead (STDdManager m) = unsafeIOToST $ c_cuddTurnOnCountDead m

foreign import ccall safe "cudd.h Cudd_DeadAreCounted"
	c_cuddDeadAreCounted :: Ptr CDdManager -> IO CInt

cuddDeadAreCounted :: STDdManager s u -> ST s Int
cuddDeadAreCounted (STDdManager m) = unsafeIOToST $ liftM fromIntegral $ c_cuddDeadAreCounted m

--Sifting parameters
foreign import ccall safe "cudd.h Cudd_ReadSiftMaxSwap"
	c_cuddReadSiftMaxSwap :: Ptr CDdManager -> IO (CInt)

cuddReadSiftMaxSwap :: STDdManager s u -> ST s Int
cuddReadSiftMaxSwap = readIntegral c_cuddReadSiftMaxSwap

foreign import ccall safe "cudd.h Cudd_SetSiftMaxSwap"
	c_cuddSetSiftMaxSwap :: Ptr CDdManager -> CInt -> IO ()

cuddSetSiftMaxSwap :: STDdManager s u -> Int -> ST s ()
cuddSetSiftMaxSwap = setIntegral c_cuddSetSiftMaxSwap

foreign import ccall safe "cudd.h Cudd_ReadSiftMaxVar"
	c_cuddReadSiftMaxVar :: Ptr CDdManager -> IO (Int)

cuddReadSiftMaxVar :: STDdManager s u -> ST s Int
cuddReadSiftMaxVar = readIntegral c_cuddReadSiftMaxVar

foreign import ccall safe "cudd.h Cudd_SetSiftMaxVar"
	c_cuddSetSiftMaxVar :: Ptr CDdManager -> CInt -> IO ()

cuddSetSiftMaxVar :: STDdManager s u -> Int -> ST s ()
cuddSetSiftMaxVar = setIntegral c_cuddSetSiftMaxVar

foreign import ccall safe "cudd.h Cudd_ReadNextReordering"
	c_cuddReadNextReordering :: Ptr CDdManager -> IO (Int)

cuddReadNextReordering :: STDdManager s u -> ST s Int
cuddReadNextReordering = readIntegral c_cuddReadNextReordering

foreign import ccall safe "cudd.h Cudd_SetNextReordering"
	c_cuddSetNextReordering :: Ptr CDdManager -> CInt -> IO ()

cuddSetNextReordering :: STDdManager s u -> Int -> ST s ()
cuddSetNextReordering = setIntegral c_cuddSetNextReordering

foreign import ccall safe "cudd.h Cudd_ReadMaxGrowthAlternate"
	c_cuddReadMaxGrowthAlternate :: Ptr CDdManager -> IO CDouble

cuddReadMaxGrowthAlternate :: STDdManager s u -> ST s Double
cuddReadMaxGrowthAlternate = readFloat c_cuddReadMaxGrowthAlternate

foreign import ccall safe "cudd.h Cudd_SetMaxGrowthAlternate"
	c_cuddSetMaxGrowthAlternate :: Ptr CDdManager -> CDouble -> IO ()

cuddSetMaxGrowthAlternate :: STDdManager s u -> Double -> ST s ()
cuddSetMaxGrowthAlternate = setFloat c_cuddSetMaxGrowthAlternate

foreign import ccall safe "cudd.h Cudd_ReadMaxGrowth"
	c_cuddReadMaxGrowth :: Ptr CDdManager -> IO CDouble

cuddReadMaxGrowth :: STDdManager s u -> ST s Double
cuddReadMaxGrowth = readFloat c_cuddReadMaxGrowth

foreign import ccall safe "cudd.h Cudd_SetMaxGrowth"
	c_cuddSetMaxGrowth :: Ptr CDdManager -> CDouble -> IO ()

cuddSetMaxGrowth :: STDdManager s u -> Double -> ST s ()
cuddSetMaxGrowth = setFloat c_cuddSetMaxGrowth

foreign import ccall safe "cudd.h Cudd_ReadReorderingCycle"
	c_cuddReadReorderingCycle :: Ptr CDdManager -> IO (CInt)

cuddReadReorderingCycle :: STDdManager s u -> ST s Int
cuddReadReorderingCycle = readIntegral c_cuddReadReorderingCycle

foreign import ccall safe "cudd.h Cudd_SetReorderingCycle"
	c_cuddSetReorderingCycle :: Ptr CDdManager -> CInt -> IO ()

cuddSetReorderingCycle :: STDdManager s u -> Int -> ST s ()
cuddSetReorderingCycle = setIntegral c_cuddSetReorderingCycle

--Genetic algorithm
foreign import ccall safe "cudd.h Cudd_ReadPopulationSize"
	c_cuddReadPopulationSize :: Ptr CDdManager -> IO (CInt)

cuddReadPopulationSize :: STDdManager s u -> ST s Int
cuddReadPopulationSize = readIntegral c_cuddReadPopulationSize

foreign import ccall safe "cudd.h Cudd_SetPopulationSize"
	c_cuddSetPopulationSize :: Ptr CDdManager -> CInt -> IO ()

cuddSetPopulationSize :: STDdManager s u -> Int -> ST s ()
cuddSetPopulationSize = setIntegral c_cuddSetPopulationSize

foreign import ccall safe "cudd.h Cudd_ReadNumberXovers"
	c_cuddReadNumberXovers :: Ptr CDdManager -> IO (CInt)

cuddReadNumberXovers :: STDdManager s u -> ST s Int
cuddReadNumberXovers = readIntegral c_cuddReadNumberXovers

foreign import ccall safe "cudd.h Cudd_SetNumberXovers"
	c_cuddSetNumberXovers :: Ptr CDdManager -> CInt -> IO ()

cuddSetNumberXovers :: STDdManager s u -> Int -> ST s ()
cuddSetNumberXovers = setIntegral c_cuddSetNumberXovers

reordGCHook :: HookTyp
reordGCHook _ _ _ = do
    performGC
    return (fromIntegral 1)

foreign import ccall "wrapper"
    makeFunPtr :: HookTyp -> IO (FunPtr HookTyp)

regReordGCHook :: STDdManager s u -> ST s Int
regReordGCHook m = do
    hk <- unsafeIOToST $ makeFunPtr reordGCHook
    cuddAddHook m hk CuddPreReorderingHook

{-#LANGUAGE ForeignFunctionInterface #-}

module Cudd.Reorder (
    CuddReorderingType(..),
    cuddReorderingStatus,
    cuddAutodynEnable,
    cuddAutodynDisable,
    cuddReduceHeap,
    cuddMakeTreeNode,
    cuddReadReorderingTime,
    cuddReadReorderings,
    cuddEnableReorderingReporting,
    cuddDisableReorderingReporting,
    cuddReorderingReporting,
    regStdPreReordHook,
    regStdPostReordHook,
    cuddTurnOnCountDead,
    cuddTurnOffCountDead,
    cuddDeadAreCounted,
    cuddReadSiftMaxSwap,
    cuddSetSiftMaxSwap,
    cuddReadSiftMaxVar,
    cuddSetSiftMaxVar,
    cuddReadNextReordering,
    cuddSetNextReordering,
    cuddReadMaxGrowthAlternate,
    cuddSetMaxGrowthAlternate,
    cuddReadMaxGrowth,
    cuddReadReorderingCycle,
    cuddSetReorderingCycle,
    cuddSetPopulationSize,
    cuddReadNumberXovers,
    cuddSetNumberXovers,
    regReordGCHook
    ) where

import System.IO
import System.Mem
import Foreign
import Foreign.Ptr
import Foreign.C.Types
import Foreign.C.String
import Foreign.ForeignPtr
import Foreign.Marshal.Array
import Foreign.Marshal.Utils
import Control.Monad
import Control.Monad.ST
import Control.Monad.ST.Unsafe

import Cudd.Internal
import Cudd.C
import Cudd.Hook

#include <stdio.h>
#include <cudd.h>

readIntegral :: (Integral i, Num j) => (Ptr CDdManager -> IO i) -> STDdManager s u -> ST s j
readIntegral f (STDdManager m) = unsafeIOToST $ liftM fromIntegral $ f m

setIntegral :: (Integral i, Num j) => (Ptr CDdManager -> j -> IO ()) -> STDdManager s u -> i -> ST s ()
setIntegral f (STDdManager m) v = unsafeIOToST $ f m (fromIntegral v)

readFloat :: (Real r, Fractional f) => (Ptr CDdManager -> IO r) -> STDdManager s u -> ST s f
readFloat f (STDdManager m) = unsafeIOToST $ liftM realToFrac $ f m

setFloat :: (Real r, Fractional f) => (Ptr CDdManager -> f -> IO ()) -> STDdManager s u -> r -> ST s ()
setFloat f (STDdManager m) v = unsafeIOToST $ f m (realToFrac v)

--Reordering types
{#enum Cudd_ReorderingType as CuddReorderingType {underscoreToCase} deriving (Show, Eq) #}

--Reorder when needed
foreign import ccall safe "cudd.h Cudd_ReorderingStatus"
	c_cuddReorderingStatus :: Ptr CDdManager -> Ptr CInt -> IO (CInt)

cuddReorderingStatus :: STDdManager s u -> ST s (Int, CuddReorderingType)
cuddReorderingStatus (STDdManager m) = unsafeIOToST $ do
	alloca $ \mem -> do
		res <- c_cuddReorderingStatus m mem
		typ <- peek mem
		return $ (fromIntegral res, toEnum $ fromIntegral typ)

foreign import ccall safe "cudd.h Cudd_AutodynEnable"
	c_cuddAutodynEnable :: Ptr CDdManager -> CInt -> IO ()

cuddAutodynEnable :: STDdManager s u -> CuddReorderingType -> ST s ()
cuddAutodynEnable (STDdManager m) t = unsafeIOToST $ c_cuddAutodynEnable m (fromIntegral $ fromEnum t)

foreign import ccall safe "cudd.h Cudd_AutodynDisable"
	c_cuddAutodynDisable :: Ptr CDdManager -> IO ()

cuddAutodynDisable :: STDdManager s u -> ST s ()
cuddAutodynDisable (STDdManager m) = unsafeIOToST $ c_cuddAutodynDisable m

--Reorder right now
foreign import ccall safe "cudd.h Cudd_ReduceHeap"
	c_cuddReduceHeap :: Ptr CDdManager -> CInt -> CInt -> IO (CInt)

cuddReduceHeap :: STDdManager s u -> CuddReorderingType -> Int -> ST s Int
cuddReduceHeap (STDdManager m) typ minsize = unsafeIOToST $ liftM fromIntegral $ c_cuddReduceHeap m (fromIntegral $ fromEnum typ) (fromIntegral minsize)

--Grouping
foreign import ccall safe "cudd.h Cudd_MakeTreeNode"
	c_cuddMakeTreeNode :: Ptr CDdManager -> CUInt -> CUInt -> CUInt -> IO (Ptr ())

cuddMakeTreeNode :: STDdManager s u -> Int -> Int -> Int -> ST s (Ptr ())
cuddMakeTreeNode (STDdManager m) low size typ = unsafeIOToST $ do
    res <- c_cuddMakeTreeNode m (fromIntegral low) (fromIntegral size) (fromIntegral typ)
    when (res==nullPtr) (error "cuddMakeTreeNode returned error")
    return res

--Reordering stats
foreign import ccall safe "cudd.h Cudd_ReadReorderingTime"
	c_cuddReadReorderingTime :: Ptr CDdManager -> IO (CLong)

cuddReadReorderingTime :: STDdManager s u -> ST s Int
cuddReadReorderingTime = readIntegral c_cuddReadReorderingTime

foreign import ccall safe "cudd.h Cudd_ReadReorderings"
	c_cuddReadReorderings :: Ptr CDdManager -> IO (CUInt)

cuddReadReorderings :: STDdManager s u -> ST s Int
cuddReadReorderings = readIntegral c_cuddReadReorderings

--Hooks
foreign import ccall safe "cudd.h &Cudd_StdPreReordHook"
	c_cuddStdPreReordHook :: HookFP

foreign import ccall safe "cudd.h &Cudd_StdPostReordHook"
	c_cuddStdPostReordHook :: HookFP

foreign import ccall safe "cudd.h Cudd_EnableReorderingReporting"
	c_cuddEnableReorderingReporting :: Ptr CDdManager -> IO (CInt)

cuddEnableReorderingReporting :: STDdManager s u -> ST s Int
cuddEnableReorderingReporting (STDdManager m) = unsafeIOToST $ liftM fromIntegral $ c_cuddEnableReorderingReporting m

foreign import ccall safe "cudd.h Cudd_DisableReorderingReporting"
	c_cuddDisableReorderingReporting :: Ptr CDdManager -> IO (CInt)

cuddDisableReorderingReporting :: STDdManager s u -> ST s Int
cuddDisableReorderingReporting (STDdManager m) = unsafeIOToST $ liftM fromIntegral $ c_cuddDisableReorderingReporting m

foreign import ccall safe "cudd.h Cudd_ReorderingReporting"
	c_cuddReorderingReporting :: Ptr CDdManager -> IO (CInt)

cuddReorderingReporting :: STDdManager s u -> ST s Int
cuddReorderingReporting (STDdManager m) = unsafeIOToST $ liftM fromIntegral $ c_cuddReorderingReporting m

regStdPreReordHook :: STDdManager s u -> ST s Int
regStdPreReordHook m = cuddAddHook m c_cuddStdPreReordHook CuddPreReorderingHook

regStdPostReordHook :: STDdManager s u -> ST s Int
regStdPostReordHook m = cuddAddHook m c_cuddStdPostReordHook CuddPostReorderingHook

--Universal reordering params
foreign import ccall safe "cudd.h Cudd_TurnOffCountDead"
	c_cuddTurnOffCountDead :: Ptr CDdManager -> IO ()

cuddTurnOffCountDead :: STDdManager s u -> ST s ()
cuddTurnOffCountDead (STDdManager m) = unsafeIOToST $ c_cuddTurnOffCountDead m

foreign import ccall safe "cudd.h Cudd_TurnOnCountDead"
	c_cuddTurnOnCountDead :: Ptr CDdManager -> IO ()

cuddTurnOnCountDead :: STDdManager s u -> ST s ()
cuddTurnOnCountDead (STDdManager m) = unsafeIOToST $ c_cuddTurnOnCountDead m

foreign import ccall safe "cudd.h Cudd_DeadAreCounted"
	c_cuddDeadAreCounted :: Ptr CDdManager -> IO CInt

cuddDeadAreCounted :: STDdManager s u -> ST s Int
cuddDeadAreCounted (STDdManager m) = unsafeIOToST $ liftM fromIntegral $ c_cuddDeadAreCounted m

--Sifting parameters
foreign import ccall safe "cudd.h Cudd_ReadSiftMaxSwap"
	c_cuddReadSiftMaxSwap :: Ptr CDdManager -> IO (CInt)

cuddReadSiftMaxSwap :: STDdManager s u -> ST s Int
cuddReadSiftMaxSwap = readIntegral c_cuddReadSiftMaxSwap

foreign import ccall safe "cudd.h Cudd_SetSiftMaxSwap"
	c_cuddSetSiftMaxSwap :: Ptr CDdManager -> CInt -> IO ()

cuddSetSiftMaxSwap :: STDdManager s u -> Int -> ST s ()
cuddSetSiftMaxSwap = setIntegral c_cuddSetSiftMaxSwap

foreign import ccall safe "cudd.h Cudd_ReadSiftMaxVar"
	c_cuddReadSiftMaxVar :: Ptr CDdManager -> IO (Int)

cuddReadSiftMaxVar :: STDdManager s u -> ST s Int
cuddReadSiftMaxVar = readIntegral c_cuddReadSiftMaxVar

foreign import ccall safe "cudd.h Cudd_SetSiftMaxVar"
	c_cuddSetSiftMaxVar :: Ptr CDdManager -> CInt -> IO ()

cuddSetSiftMaxVar :: STDdManager s u -> Int -> ST s ()
cuddSetSiftMaxVar = setIntegral c_cuddSetSiftMaxVar

foreign import ccall safe "cudd.h Cudd_ReadNextReordering"
	c_cuddReadNextReordering :: Ptr CDdManager -> IO (Int)

cuddReadNextReordering :: STDdManager s u -> ST s Int
cuddReadNextReordering = readIntegral c_cuddReadNextReordering

foreign import ccall safe "cudd.h Cudd_SetNextReordering"
	c_cuddSetNextReordering :: Ptr CDdManager -> CInt -> IO ()

cuddSetNextReordering :: STDdManager s u -> Int -> ST s ()
cuddSetNextReordering = setIntegral c_cuddSetNextReordering

foreign import ccall safe "cudd.h Cudd_ReadMaxGrowthAlternate"
	c_cuddReadMaxGrowthAlternate :: Ptr CDdManager -> IO CDouble

cuddReadMaxGrowthAlternate :: STDdManager s u -> ST s Double
cuddReadMaxGrowthAlternate = readFloat c_cuddReadMaxGrowthAlternate

foreign import ccall safe "cudd.h Cudd_SetMaxGrowthAlternate"
	c_cuddSetMaxGrowthAlternate :: Ptr CDdManager -> CDouble -> IO ()

cuddSetMaxGrowthAlternate :: STDdManager s u -> Double -> ST s ()
cuddSetMaxGrowthAlternate = setFloat c_cuddSetMaxGrowthAlternate

foreign import ccall safe "cudd.h Cudd_ReadMaxGrowth"
	c_cuddReadMaxGrowth :: Ptr CDdManager -> IO CDouble

cuddReadMaxGrowth :: STDdManager s u -> ST s Double
cuddReadMaxGrowth = readFloat c_cuddReadMaxGrowth

foreign import ccall safe "cudd.h Cudd_SetMaxGrowth"
	c_cuddSetMaxGrowth :: Ptr CDdManager -> CDouble -> IO ()

cuddSetMaxGrowth :: STDdManager s u -> Double -> ST s ()
cuddSetMaxGrowth = setFloat c_cuddSetMaxGrowth

foreign import ccall safe "cudd.h Cudd_ReadReorderingCycle"
	c_cuddReadReorderingCycle :: Ptr CDdManager -> IO (CInt)

cuddReadReorderingCycle :: STDdManager s u -> ST s Int
cuddReadReorderingCycle = readIntegral c_cuddReadReorderingCycle

foreign import ccall safe "cudd.h Cudd_SetReorderingCycle"
	c_cuddSetReorderingCycle :: Ptr CDdManager -> CInt -> IO ()

cuddSetReorderingCycle :: STDdManager s u -> Int -> ST s ()
cuddSetReorderingCycle = setIntegral c_cuddSetReorderingCycle

--Genetic algorithm
foreign import ccall safe "cudd.h Cudd_ReadPopulationSize"
	c_cuddReadPopulationSize :: Ptr CDdManager -> IO (CInt)

cuddReadPopulationSize :: STDdManager s u -> ST s Int
cuddReadPopulationSize = readIntegral c_cuddReadPopulationSize

foreign import ccall safe "cudd.h Cudd_SetPopulationSize"
	c_cuddSetPopulationSize :: Ptr CDdManager -> CInt -> IO ()

cuddSetPopulationSize :: STDdManager s u -> Int -> ST s ()
cuddSetPopulationSize = setIntegral c_cuddSetPopulationSize

foreign import ccall safe "cudd.h Cudd_ReadNumberXovers"
	c_cuddReadNumberXovers :: Ptr CDdManager -> IO (CInt)

cuddReadNumberXovers :: STDdManager s u -> ST s Int
cuddReadNumberXovers = readIntegral c_cuddReadNumberXovers

foreign import ccall safe "cudd.h Cudd_SetNumberXovers"
	c_cuddSetNumberXovers :: Ptr CDdManager -> CInt -> IO ()

cuddSetNumberXovers :: STDdManager s u -> Int -> ST s ()
cuddSetNumberXovers = setIntegral c_cuddSetNumberXovers

reordGCHook :: HookTyp
reordGCHook _ _ _ = do
    --putStrLn "reordGCHook"
    performGC
    --putStrLn "gc done"
    return (fromIntegral 1)

foreign import ccall "wrapper"
    makeFunPtr :: HookTyp -> IO (FunPtr HookTyp)

regReordGCHook :: STDdManager s u -> ST s Int
regReordGCHook m = do
    hk <- unsafeIOToST $ makeFunPtr reordGCHook
    cuddAddHook m hk CuddPreReorderingHook


gstreamer: M.S.G.Core.Clock: a few small doc fixes

--  GIMP Toolkit (GTK) Binding for Haskell: binding to gstreamer -*-haskell-*-
--
--  Author : Peter Gavin
--  Created: 1-Apr-2007
--
--  Copyright (c) 2007 Peter Gavin
--
--  This library is free software: you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public License
--  as published by the Free Software Foundation, either version 3 of
--  the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
--  You should have received a copy of the GNU Lesser General Public
--  License along with this program.  If not, see
--  <http://www.gnu.org/licenses/>.
--
--  GStreamer, the C library which this Haskell library depends on, is
--  available under LGPL Version 2. The documentation included with
--  this library is based on the original GStreamer documentation.
--
--  |
--  Maintainer  : gtk2hs-devel@lists.sourceforge.net
--  Stability   : alpha
--  Portability : portable (depends on GHC)
--
--  Abstract class of global clocks.
module Media.Streaming.GStreamer.Core.Clock (

-- * Detail
  -- | GStreamer uses a global clock to synchronize the plugins in a
  --   pipeline. Different clock implementations are possible by
  --   implementing this abstract base class.
  --
  --   The 'Clock' returns a monotonically increasing time with the
  --   method 'clockGetTime'. Its accuracy and base time depend
  --   on the specific clock implementation but time is always
  --   expressed in nanoseconds. Since the baseline of the clock is
  --   undefined, the clock time returned is not meaningful in itself,
  --   what matters are the deltas between two clock times. The time
  --   returned by a clock is called the absolute time.
  --
  --   The pipeline uses the clock to calculate the stream
  --   time. Usually all renderers synchronize to the global clock
  --   using the buffer timestamps, the newsegment events and the
  --   element's base time, see GstPipeline.
  --
  --   A clock implementation can support periodic and single shot
  --   clock notifications both synchronous and asynchronous.
  --
  --   One first needs to create a 'ClockID' for the periodic or
  --   single shot notification using 'clockNewSingleShotID' or
  --   'clockNewPeriodicID'.
  --
  --   To perform a blocking wait for the specific time of the
  --   'ClockID' use 'clockIDWait'. This calls can be interrupted with
  --   the 'clockIDUnschedule' call. If the blocking wait is
  --   unscheduled a return value of 'ClockUnscheduled' is returned.
  --
  --   Periodic callbacks scheduled async will be repeadedly called
  --   automatically until it is unscheduled. To schedule a sync
  --   periodic callback, 'clockIDWait' should be called repeatedly.
  --
  --   The async callbacks can happen from any thread, either provided
  --   by the core or from a streaming thread. The application should
  --   be prepared for this.
  --
  --   A 'ClockID' that has been unscheduled cannot be used again for
  --   any wait operation; a new 'ClockID' should be created.
  --
  --   It is possible to perform a blocking wait on the same 'ClockID'
  --   from multiple threads. However, registering the same 'ClockID'
  --   for multiple async notifications is not possible, the callback
  --   will only be called for the thread registering the entry last.
  --
  --   These clock operations do not operate on the stream time, so
  --   the callbacks will also occur when not in the playing state as
  --   if the clock just keeps on running. Some clocks however do not
  --   progress when the element that provided the clock is not
  --   playing.
  --
  --   When a clock has the 'ClockFlagCanSetMaster' flag set, it can
  --   be slaved to another 'Clock' with 'clockSetMaster'. The clock
  --   will then automatically be synchronized to this master clock by
  --   repeatedly sampling the master clock and the slave clock and
  --   recalibrating the slave clock with 'clockSetCalibration'. This
  --   feature is mostly useful for plugins that have an internal
  --   clock but must operate with another clock selected by the
  --   GstPipeline. They can track the offset and rate difference of
  --   their internal clock relative to the master clock by using the
  --   'clockGetCalibration' function.
  --
  --   The master\/slave synchronisation can be tuned with the
  --   the 'clockTimeout', 'clockWindowSize' and 'clockWindowThreshold' properties.
  --   The 'clockTimeout' property defines the interval to
  --   sample the master clock and run the calibration
  --   functions. 'clockWindowSize' defines the number of samples to
  --   use when calibrating and 'clockWindowThreshold' defines the
  --   minimum number of samples before the calibration is performed.

-- * Types
  Clock,
  ClockClass,
  castToClock,
  toClock,

  -- | A time value measured in nanoseconds.
  ClockTime,

  -- | The 'ClockTime' value representing an invalid time.
  clockTimeNone,
  clockTimeIsValid,

  -- | The 'ClockTime' value representing 1 second, i.e. 1e9.
  second,
  -- | The 'ClockTime' value representing 1 millisecond, i.e. 1e6.
  msecond,
  -- | The 'ClockTime' value representing 1 microsecond, i.e. 1e3.
  usecond,
  -- | The 'ClockTime' value representing 1 nanosecond, i.e. 1.
  nsecond,
  -- | A value holding the difference between two 'ClockTime's.
  ClockTimeDiff,
  -- | An opaque identifier for a timer event.
  ClockID,
  -- | An enumeration type returned by 'clockIDWait'.
  ClockReturn(..),
  -- | The flags a 'Clock' may have.
  ClockFlags(..),
  clockGetFlags,
  clockSetFlags,
  clockUnsetFlags,

-- * Clock Operations
  clockAddObservation,
  clockSetMaster,
  clockGetMaster,
  clockSetResolution,
  clockGetResolution,
  clockGetTime,
  clockNewSingleShotID,
  clockNewPeriodicID,
  clockGetInternalTime,
  clockGetCalibration,
  clockSetCalibration,
  clockIDGetTime,
  clockIDWait,
  clockIDUnschedule,

-- * Clock Properties
  clockTimeout,
  clockWindowSize,
  clockWindowThreshold

  ) where

import Data.Ratio ( Ratio
                  , (%)
                  , numerator
                  , denominator )
import Control.Monad ( liftM
                     , liftM4)
{#import Media.Streaming.GStreamer.Core.Types#}
import System.Glib.FFI
import System.Glib.Attributes ( Attr
                              , newAttr )
import System.Glib.Properties

{# context lib = "gstreamer" prefix = "gst" #}

-- | Get the flags set on the clock.
clockGetFlags :: ClockClass clockT
              => clockT          -- ^ @clock@
              -> IO [ClockFlags] -- ^ the flags currently set on the clock
clockGetFlags = mkObjectGetFlags

-- | Set the given flags on the clock.
clockSetFlags :: ClockClass clockT
              => clockT       -- ^ @clock@
              -> [ClockFlags] -- ^ @flags@ - the flags to be set
              -> IO ()
clockSetFlags = mkObjectSetFlags

-- | Unset the given flags on the clock.
clockUnsetFlags :: ClockClass clockT
                => clockT       -- ^ @clock@
                -> [ClockFlags] -- ^ @flags@ - the flags to be unset
                -> IO ()
clockUnsetFlags = mkObjectUnsetFlags

-- | Returns 'True' if the given 'ClockTime' is valid, and 'False'
--   otherwise.
clockTimeIsValid :: ClockTime -- ^ @clockTime@
                 -> Bool      -- ^ 'True' if @clockTime@ is valid, 'False' otherwise
clockTimeIsValid = (/= clockTimeNone)

-- | The time master of the master clock and the time slave of the
--   slave clock are added to the list of observations. If enough
--   observations are available, a linear regression algorithm is run
--   on the observations and clock is recalibrated.
--
--   If a calibration is performed, the correlation coefficient of the
--   interpolation will be returned. A value of 1.0 means the clocks
--   are in perfect sync. This value can be used to control the
--   sampling frequency of the master and slave clocks.
clockAddObservation :: ClockClass clock
                    => clock
                    -> ClockTime
                    -> ClockTime
                    -> IO (Maybe Double)
clockAddObservation clock slave master =
    alloca $ \rSquaredPtr ->
        do success <- {# call clock_add_observation #} (toClock clock)
                                                       (fromIntegral slave)
                                                       (fromIntegral master)
                                                       rSquaredPtr
           if toBool success
               then liftM (Just . realToFrac) $ peek rSquaredPtr
               else return Nothing

-- | Set @master@ as the master clock for @clock@. The @clock@ will
--   automatically be calibrated so that 'clockGetTime' reports the
--   same time as the @master@ clock.
--
--   A clock provider that slaves its clock to a master can get the
--   current calibration values with 'clockGetCalibration'.
--
--   The @master@ clock can be 'Nothing' in which case @clock@ will
--   not be slaved any longer. It will, however, continue to report
--   its time adjusted using the last configured rate and time
--   offsets.
--
--   Note that if @clock@ does not have the 'ClockFlagCanSetMaster'
--   flag set, this function will not succeed and return 'False'.
clockSetMaster :: (ClockClass clock, ClockClass master)
               => clock        -- ^ @clock@
               -> Maybe master -- ^ @master@
               -> IO Bool      -- ^ 'True' if @clock@ is capable of
                               --   being slaved to the @master@ clock, otherwise 'False'
clockSetMaster clock master =
    withObject (toClock clock) $ \clockPtr ->
        maybeWith withObject (liftM toClock $ master) $ \masterPtr ->
            liftM toBool $ gst_clock_set_master clockPtr masterPtr
    where
      _ = {# call clock_set_master #}

-- | Return the master that @clock@ is slaved to, or 'Nothing' if
--   @clock@ is not slaved.
clockGetMaster :: ClockClass clock
               => clock            -- ^ @clock@
               -> IO (Maybe Clock) -- ^ the master that @clock@ is slaved to, or 'Nothing'
clockGetMaster clock =
    {# call clock_get_master #} (toClock clock) >>= maybePeek takeObject

-- | Set the resolution of @clock@. Some clocks have the possibility
--   to operate with different resolution at the expense of more
--   resource usage. There is normally no need to change the default
--   resolution of a clock. The resolution of a clock can only be
--   changed if the clock has the 'ClockFlagCanSetResolution' flag
--   set.
clockSetResolution :: ClockClass clock
                   => clock
                   -> ClockTime
                   -> IO ClockTime
clockSetResolution clock resolution =
    liftM fromIntegral $
        {# call clock_set_resolution #} (toClock clock)
                                        (fromIntegral resolution)

-- | Get the resolution of the @clock@. The resolution of the clock is
--   the granularity of the values returned by 'clockGetTime'.
clockGetResolution :: ClockClass clock
                   => clock        -- ^ @clock@
                   -> IO ClockTime -- ^ the resolution currently set in @clock@
clockGetResolution clock =
    liftM fromIntegral $
        {# call clock_get_resolution #} (toClock clock)

-- | Gets the current time of @clock@. The time is always
--   monotonically increasing and adjusted according to the current
--   offset and rate.
clockGetTime :: ClockClass clock
             => clock        -- ^ @clock@
             -> IO ClockTime -- ^ the current time in @clock@
clockGetTime clock =
    liftM fromIntegral $
        {# call clock_get_time #} (toClock clock)

-- | Get a 'ClockID' from @clock@ to trigger a single shot
--   notification at the requested time.
clockNewSingleShotID :: ClockClass clock
                     => clock      -- ^ @clock@
                     -> ClockTime  -- ^ @clockTime@
                     -> IO ClockID -- ^ a single shot notification id triggered at @clockTime@
clockNewSingleShotID clock time =
    {# call clock_new_single_shot_id #} (toClock clock)
                                        (fromIntegral time) >>=
        takeClockID . castPtr

-- | Get a 'ClockID' from @clock@ to trigger periodic
--   notifications. The notifications will start at time @startTime@
--   and then be fired at each @interval@ after.
clockNewPeriodicID :: ClockClass clock
                   => clock      -- ^ @clock@
                   -> ClockTime  -- ^ @startTime@
                   -> ClockTime  -- ^ @interval@
                   -> IO ClockID -- ^ a periodic notification id
clockNewPeriodicID clock startTime interval =
    {# call clock_new_periodic_id #} (toClock clock)
                                     (fromIntegral startTime)
                                     (fromIntegral interval) >>=
        takeClockID . castPtr

-- | Gets the current internal time of @clock@. The time is
--   returned unadjusted in the offset and rate.
clockGetInternalTime :: ClockClass clock
                     => clock        -- ^ @clock@
                     -> IO ClockTime -- ^ the clock's internal time value
clockGetInternalTime clock =
    liftM fromIntegral $
        {# call clock_get_internal_time #} (toClock clock)

-- | Gets the internal rate and reference time of @clock@. See
--   'clockSetCalibration' for more information.
clockGetCalibration :: ClockClass clock
                    => clock -- ^ @clock@
                    -> IO (ClockTime, ClockTime, Ratio ClockTime)
                       -- ^ the clock's internal time, external (adjusted) time, and skew rate
clockGetCalibration clock =
    alloca $ \internalPtr ->
        alloca $ \externalPtr ->
            alloca $ \rateNumPtr ->
                alloca $ \rateDenomPtr ->
                    do {# call clock_get_calibration #} (toClock clock)
                                                        internalPtr
                                                        externalPtr
                                                        rateNumPtr
                                                        rateDenomPtr
                       liftM4 (\a b c d ->
                               (fromIntegral a,
                                fromIntegral b,
                                fromIntegral c % fromIntegral d))
                              (peek internalPtr)
                              (peek externalPtr)
                              (peek rateNumPtr)
                              (peek rateDenomPtr)

-- | Adjusts the rate and time of clock. A rate of @1 % 1@ is the
--   normal speed of the clock. Larger values make the clock go
--   faster.
--
--   The parameters @internal@ and @external@ specifying that
--   'clockGetTime' should have returned @external@ when the clock had
--   internal time @internal@. The parameter @internal@ should not be
--   in the future; that is, it should be less than the value returned
--   by 'clockGetInternalTime' when this function is called.
--
--   Subsequent calls to 'clockGetTime' will return clock times
--   computed as follows:
--
--   > (clock_internal - internal) * rate + external
--
--   Note that 'clockGetTime' always returns increasing values, so if
--   the clock is moved backwards, 'clockGetTime' will report the
--   previous value until the clock catches up.
clockSetCalibration :: ClockClass clock
                    => clock           -- ^ @clock@
                    -> ClockTime       -- ^ @internal@
                    -> ClockTime       -- ^ @external@
                    -> Ratio ClockTime -- ^ @rate@
                    -> IO ()
clockSetCalibration clock internal external rate =
    {# call clock_set_calibration #} (toClock clock)
                                     (fromIntegral internal)
                                     (fromIntegral external)
                                     (fromIntegral $ numerator rate)
                                     (fromIntegral $ denominator rate)

-- | Get the time of @clockID@.
clockIDGetTime :: ClockID      -- ^ @clockID@
               -> IO ClockTime
clockIDGetTime clockID =
    liftM fromIntegral $ withClockID clockID $
        {# call clock_id_get_time #} . castPtr

-- | Perform a blocking wait on @clockID@. The parameter @clockID@
--   should have been created with 'clockNewSingleShotID' or
--   'clockNewPeriodicID', and should not been unscheduled with a call
--   to 'clockIDUnschedule'.
--
--   If second value in the returned pair is not 'Nothing', it will
--   contain the difference against the clock and the time of
--   @clockID@ when this method was called. Positive values indicate
--   how late @clockID@ was relative to the clock. Negative values
--   indicate how much time was spend waiting on the clock before the
--   function returned.
clockIDWait :: ClockID -- ^ @clockID@
            -> IO (ClockReturn, Maybe ClockTimeDiff)
clockIDWait clockID =
    alloca $ \jitterPtr ->
        do result <- liftM cToEnum $ withClockID clockID $ \clockIDPtr ->
                         {# call clock_id_wait #} (castPtr clockIDPtr) jitterPtr
           jitter <- let peekJitter = liftM (Just . fromIntegral) $ peek jitterPtr
                     in case result of
                          ClockOk -> peekJitter
                          ClockEarly -> peekJitter
                          _ -> return Nothing
           return (result, jitter)

-- | Cancel an outstanding request with @clockID@. After this call,
--   @clockID@ cannot be used anymore to recieve notifications; you
--   must create a new 'ClockID'.
clockIDUnschedule :: ClockID -- ^ @clockID@
                  -> IO ()
clockIDUnschedule clockID =
    withClockID clockID $ {# call clock_id_unschedule #} . castPtr

clockTimeout :: ClockClass clockT
             => Attr clockT ClockTime
clockTimeout = newAttr
    (objectGetPropertyUInt64 "timeout")
    (objectSetPropertyUInt64 "timeout")

clockWindowSize :: ClockClass clockT
                => Attr clockT Int
clockWindowSize =
    newAttrFromIntProperty "window-size"

clockWindowThreshold :: ClockClass clockT
                     => Attr clockT Int
clockWindowThreshold =
    newAttrFromIntProperty "window-threshold"

--  GIMP Toolkit (GTK) Binding for Haskell: binding to gstreamer -*-haskell-*-
--
--  Author : Peter Gavin
--  Created: 1-Apr-2007
--
--  Copyright (c) 2007 Peter Gavin
--
--  This library is free software: you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public License
--  as published by the Free Software Foundation, either version 3 of
--  the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
--  You should have received a copy of the GNU Lesser General Public
--  License along with this program.  If not, see
--  <http://www.gnu.org/licenses/>.
--
--  GStreamer, the C library which this Haskell library depends on, is
--  available under LGPL Version 2. The documentation included with
--  this library is based on the original GStreamer documentation.
--
--  |
--  Maintainer  : gtk2hs-devel@lists.sourceforge.net
--  Stability   : alpha
--  Portability : portable (depends on GHC)
--
--  Abstract class of global clocks.
module Media.Streaming.GStreamer.Core.Clock (

-- * Detail
  -- | GStreamer uses a global clock to synchronize the plugins in a
  --   pipeline. Different clock implementations are possible by
  --   implementing this abstract base class.
  --
  --   The 'Clock' returns a monotonically increasing time with the
  --   method 'clockGetTime'. Its accuracy and base time depend
  --   on the specific clock implementation but time is always
  --   expressed in nanoseconds. Since the baseline of the clock is
  --   undefined, the clock time returned is not meaningful in itself,
  --   what matters are the deltas between two clock times. The time
  --   returned by a clock is called the absolute time.
  --
  --   The pipeline uses the clock to calculate the stream
  --   time. Usually all renderers synchronize to the global clock
  --   using the buffer timestamps, the newsegment events and the
  --   element's base time, see GstPipeline.
  --
  --   A clock implementation can support periodic and single shot
  --   clock notifications both synchronous and asynchronous.
  --
  --   One first needs to create a 'ClockID' for the periodic or
  --   single shot notification using 'clockNewSingleShotID' or
  --   'clockNewPeriodicID'.
  --
  --   To perform a blocking wait for the specific time of the
  --   'ClockID' use 'clockIDWait'. This calls can be interrupted with
  --   the 'clockIDUnschedule' call. If the blocking wait is
  --   unscheduled a return value of 'ClockUnscheduled' is returned.
  --
  --   Periodic callbacks scheduled async will be repeadedly called
  --   automatically until it is unscheduled. To schedule a sync
  --   periodic callback, 'clockIDWait' should be called repeatedly.
  --
  --   The async callbacks can happen from any thread, either provided
  --   by the core or from a streaming thread. The application should
  --   be prepared for this.
  --
  --   A 'ClockID' that has been unscheduled cannot be used again for
  --   any wait operation; a new 'ClockID' should be created.
  --
  --   It is possible to perform a blocking wait on the same 'ClockID'
  --   from multiple threads. However, registering the same 'ClockID'
  --   for multiple async notifications is not possible, the callback
  --   will only be called for the thread registering the entry last.
  --
  --   These clock operations do not operate on the stream time, so
  --   the callbacks will also occur when not in the playing state as
  --   if the clock just keeps on running. Some clocks however do not
  --   progress when the element that provided the clock is not
  --   playing.
  --
  --   When a clock has the 'ClockFlagCanSetMaster' flag set, it can
  --   be slaved to another 'Clock' with 'clockSetMaster'. The clock
  --   will then automatically be synchronized to this master clock by
  --   repeatedly sampling the master clock and the slave clock and
  --   recalibrating the slave clock with 'clockSetCalibration'. This
  --   feature is mostly useful for plugins that have an internal
  --   clock but must operate with another clock selected by the
  --   GstPipeline. They can track the offset and rate difference of
  --   their internal clock relative to the master clock by using the
  --   'clockGetCalibration' function.
  --
  --   The master\/slave synchronisation can be tuned with the
  --   the 'clockTimeout', 'clockWindowSize' and 'clockWindowThreshold' properties.
  --   The 'clockTimeout' property defines the interval to
  --   sample the master clock and run the calibration
  --   functions. 'clockWindowSize' defines the number of samples to
  --   use when calibrating and 'clockWindowThreshold' defines the
  --   minimum number of samples before the calibration is performed.

-- * Types
  Clock,
  ClockClass,
  castToClock,
  toClock,

  -- | A time value measured in nanoseconds.
  ClockTime,

  -- | The 'ClockTime' value representing an invalid time.
  clockTimeNone,
  clockTimeIsValid,

  -- | The 'ClockTime' value representing 1 second, i.e. 1e9.
  second,
  -- | The 'ClockTime' value representing 1 millisecond, i.e. 1e6.
  msecond,
  -- | The 'ClockTime' value representing 1 microsecond, i.e. 1e3.
  usecond,
  -- | The 'ClockTime' value representing 1 nanosecond, i.e. 1.
  nsecond,
  -- | A value holding the difference between two 'ClockTime's.
  ClockTimeDiff,
  -- | An opaque identifier for a timer event.
  ClockID,
  -- | An enumeration type returned by 'clockIDWait'.
  ClockReturn(..),
  -- | The flags a 'Clock' may have.
  ClockFlags(..),
  clockGetFlags,
  clockSetFlags,
  clockUnsetFlags,

-- * Clock Operations
  clockAddObservation,
  clockSetMaster,
  clockGetMaster,
  clockSetResolution,
  clockGetResolution,
  clockGetTime,
  clockNewSingleShotID,
  clockNewPeriodicID,
  clockGetInternalTime,
  clockGetCalibration,
  clockSetCalibration,
  clockIDGetTime,
  clockIDWait,
  clockIDUnschedule,

-- * Clock Properties
  clockTimeout,
  clockWindowSize,
  clockWindowThreshold

  ) where

import Data.Ratio ( Ratio
                  , (%)
                  , numerator
                  , denominator )
import Control.Monad ( liftM
                     , liftM4)
{#import Media.Streaming.GStreamer.Core.Types#}
import System.Glib.FFI
import System.Glib.Attributes ( Attr
                              , newAttr )
import System.Glib.Properties

{# context lib = "gstreamer" prefix = "gst" #}

-- | Gets the flags set on the clock.
clockGetFlags :: ClockClass clockT
              => clockT          -- ^ @clock@
              -> IO [ClockFlags] -- ^ the flags currently set on the clock
clockGetFlags = mkObjectGetFlags

-- | Sets the given flags on the clock.
clockSetFlags :: ClockClass clockT
              => clockT       -- ^ @clock@
              -> [ClockFlags] -- ^ @flags@ - the flags to be set
              -> IO ()
clockSetFlags = mkObjectSetFlags

-- | Unsets the given flags on the clock.
clockUnsetFlags :: ClockClass clockT
                => clockT       -- ^ @clock@
                -> [ClockFlags] -- ^ @flags@ - the flags to be unset
                -> IO ()
clockUnsetFlags = mkObjectUnsetFlags

-- | Returns 'True' if the given 'ClockTime' is valid, and 'False'
--   otherwise.
clockTimeIsValid :: ClockTime -- ^ @clockTime@
                 -> Bool      -- ^ 'True' if @clockTime@ is valid, 'False' otherwise
clockTimeIsValid = (/= clockTimeNone)

-- | The time master of the master clock and the time slave of the
--   slave clock are added to the list of observations. If enough
--   observations are available, a linear regression algorithm is run
--   on the observations and clock is recalibrated.
--
--   If a calibration is performed, the correlation coefficient of the
--   interpolation will be returned. A value of 1.0 means the clocks
--   are in perfect sync. This value can be used to control the
--   sampling frequency of the master and slave clocks.
clockAddObservation :: ClockClass clock
                    => clock
                    -> ClockTime
                    -> ClockTime
                    -> IO (Maybe Double)
clockAddObservation clock slave master =
    alloca $ \rSquaredPtr ->
        do success <- {# call clock_add_observation #} (toClock clock)
                                                       (fromIntegral slave)
                                                       (fromIntegral master)
                                                       rSquaredPtr
           if toBool success
               then liftM (Just . realToFrac) $ peek rSquaredPtr
               else return Nothing

-- | Set @master@ as the master clock for @clock@. The @clock@ will
--   automatically be calibrated so that 'clockGetTime' reports the
--   same time as the @master@ clock.
--
--   A clock provider that slaves its clock to a master can get the
--   current calibration values with 'clockGetCalibration'.
--
--   The @master@ clock can be 'Nothing' in which case @clock@ will
--   not be slaved any longer. It will, however, continue to report
--   its time adjusted using the last configured rate and time
--   offsets.
--
--   Note that if @clock@ does not have the 'ClockFlagCanSetMaster'
--   flag set, this function will not succeed and return 'False'.
clockSetMaster :: (ClockClass clock, ClockClass master)
               => clock        -- ^ @clock@
               -> Maybe master -- ^ @master@
               -> IO Bool      -- ^ 'True' if @clock@ is capable of
                               --   being slaved to the @master@ clock, otherwise 'False'
clockSetMaster clock master =
    withObject (toClock clock) $ \clockPtr ->
        maybeWith withObject (liftM toClock $ master) $ \masterPtr ->
            liftM toBool $ gst_clock_set_master clockPtr masterPtr
    where
      _ = {# call clock_set_master #}

-- | Return the master that @clock@ is slaved to, or 'Nothing' if
--   @clock@ is not slaved.
clockGetMaster :: ClockClass clock
               => clock            -- ^ @clock@
               -> IO (Maybe Clock) -- ^ the master that @clock@ is slaved to, or 'Nothing'
clockGetMaster clock =
    {# call clock_get_master #} (toClock clock) >>= maybePeek takeObject

-- | Set the resolution of @clock@. Some clocks have the possibility
--   to operate with different resolution at the expense of more
--   resource usage. There is normally no need to change the default
--   resolution of a clock. The resolution of a clock can only be
--   changed if the clock has the 'ClockFlagCanSetResolution' flag
--   set.
clockSetResolution :: ClockClass clock
                   => clock
                   -> ClockTime
                   -> IO ClockTime
clockSetResolution clock resolution =
    liftM fromIntegral $
        {# call clock_set_resolution #} (toClock clock)
                                        (fromIntegral resolution)

-- | Get the resolution of the @clock@. The resolution of the clock is
--   the granularity of the values returned by 'clockGetTime'.
clockGetResolution :: ClockClass clock
                   => clock        -- ^ @clock@
                   -> IO ClockTime -- ^ the resolution currently set in @clock@
clockGetResolution clock =
    liftM fromIntegral $
        {# call clock_get_resolution #} (toClock clock)

-- | Gets the current time of @clock@. The time is always
--   monotonically increasing and adjusted according to the current
--   offset and rate.
clockGetTime :: ClockClass clock
             => clock        -- ^ @clock@
             -> IO ClockTime -- ^ the current time in @clock@
clockGetTime clock =
    liftM fromIntegral $
        {# call clock_get_time #} (toClock clock)

-- | Get a 'ClockID' from @clock@ to trigger a single shot
--   notification at the requested time.
clockNewSingleShotID :: ClockClass clock
                     => clock      -- ^ @clock@
                     -> ClockTime  -- ^ @clockTime@
                     -> IO ClockID -- ^ a single shot notification id triggered at @clockTime@
clockNewSingleShotID clock time =
    {# call clock_new_single_shot_id #} (toClock clock)
                                        (fromIntegral time) >>=
        takeClockID . castPtr

-- | Get a 'ClockID' from @clock@ to trigger periodic
--   notifications. The notifications will start at time @startTime@
--   and then be fired at each @interval@ after.
clockNewPeriodicID :: ClockClass clock
                   => clock      -- ^ @clock@
                   -> ClockTime  -- ^ @startTime@
                   -> ClockTime  -- ^ @interval@
                   -> IO ClockID -- ^ a periodic notification id
clockNewPeriodicID clock startTime interval =
    {# call clock_new_periodic_id #} (toClock clock)
                                     (fromIntegral startTime)
                                     (fromIntegral interval) >>=
        takeClockID . castPtr

-- | Gets the current internal time of @clock@. The time is
--   returned unadjusted in the offset and rate.
clockGetInternalTime :: ClockClass clock
                     => clock        -- ^ @clock@
                     -> IO ClockTime -- ^ the clock's internal time value
clockGetInternalTime clock =
    liftM fromIntegral $
        {# call clock_get_internal_time #} (toClock clock)

-- | Gets the internal rate and reference time of @clock@. See
--   'clockSetCalibration' for more information.
clockGetCalibration :: ClockClass clock
                    => clock -- ^ @clock@
                    -> IO (ClockTime, ClockTime, Ratio ClockTime)
                       -- ^ the clock's internal time, external (adjusted) time, and skew rate
clockGetCalibration clock =
    alloca $ \internalPtr ->
        alloca $ \externalPtr ->
            alloca $ \rateNumPtr ->
                alloca $ \rateDenomPtr ->
                    do {# call clock_get_calibration #} (toClock clock)
                                                        internalPtr
                                                        externalPtr
                                                        rateNumPtr
                                                        rateDenomPtr
                       liftM4 (\a b c d ->
                               (fromIntegral a,
                                fromIntegral b,
                                fromIntegral c % fromIntegral d))
                              (peek internalPtr)
                              (peek externalPtr)
                              (peek rateNumPtr)
                              (peek rateDenomPtr)

-- | Adjusts the rate and time of clock. A rate of @1 % 1@ is the
--   normal speed of the clock. Larger values make the clock go
--   faster.
--
--   The parameters @internal@ and @external@ specifying that
--   'clockGetTime' should have returned @external@ when the clock had
--   internal time @internal@. The parameter @internal@ should not be
--   in the future; that is, it should be less than the value returned
--   by 'clockGetInternalTime' when this function is called.
--
--   Subsequent calls to 'clockGetTime' will return clock times
--   computed as follows:
--
--   > (clock_internal - internal) * rate + external
--
--   Note that 'clockGetTime' always returns increasing values, so if
--   the clock is moved backwards, 'clockGetTime' will report the
--   previous value until the clock catches up.
clockSetCalibration :: ClockClass clock
                    => clock           -- ^ @clock@
                    -> ClockTime       -- ^ @internal@
                    -> ClockTime       -- ^ @external@
                    -> Ratio ClockTime -- ^ @rate@
                    -> IO ()
clockSetCalibration clock internal external rate =
    {# call clock_set_calibration #} (toClock clock)
                                     (fromIntegral internal)
                                     (fromIntegral external)
                                     (fromIntegral $ numerator rate)
                                     (fromIntegral $ denominator rate)

-- | Get the time of @clockID@.
clockIDGetTime :: ClockID      -- ^ @clockID@
               -> IO ClockTime
clockIDGetTime clockID =
    liftM fromIntegral $ withClockID clockID $
        {# call clock_id_get_time #} . castPtr

-- | Perform a blocking wait on @clockID@. The parameter @clockID@
--   should have been created with 'clockNewSingleShotID' or
--   'clockNewPeriodicID', and should not been unscheduled with a call
--   to 'clockIDUnschedule'.
--
--   If second value in the returned pair is not 'Nothing', it will
--   contain the difference against the clock and the time of
--   @clockID@ when this method was called. Positive values indicate
--   how late @clockID@ was relative to the clock. Negative values
--   indicate how much time was spend waiting on the clock before the
--   function returned.
clockIDWait :: ClockID -- ^ @clockID@
            -> IO (ClockReturn, Maybe ClockTimeDiff)
clockIDWait clockID =
    alloca $ \jitterPtr ->
        do result <- liftM cToEnum $ withClockID clockID $ \clockIDPtr ->
                         {# call clock_id_wait #} (castPtr clockIDPtr) jitterPtr
           jitter <- let peekJitter = liftM (Just . fromIntegral) $ peek jitterPtr
                     in case result of
                          ClockOk -> peekJitter
                          ClockEarly -> peekJitter
                          _ -> return Nothing
           return (result, jitter)

-- | Cancel an outstanding request with @clockID@. After this call,
--   @clockID@ cannot be used anymore to recieve notifications; you
--   must create a new 'ClockID'.
clockIDUnschedule :: ClockID -- ^ @clockID@
                  -> IO ()
clockIDUnschedule clockID =
    withClockID clockID $ {# call clock_id_unschedule #} . castPtr

clockTimeout :: ClockClass clockT
             => Attr clockT ClockTime
clockTimeout = newAttr
    (objectGetPropertyUInt64 "timeout")
    (objectSetPropertyUInt64 "timeout")

clockWindowSize :: ClockClass clockT
                => Attr clockT Int
clockWindowSize =
    newAttrFromIntProperty "window-size"

clockWindowThreshold :: ClockClass clockT
                     => Attr clockT Int
clockWindowThreshold =
    newAttrFromIntProperty "window-threshold"


Rename the conditional map insert operation

module Database.HyperDex.Internal.Hyperclient
  ( -- Simple, single-key operations
    get
  , put
  , putIfNotExist
  , delete
  , putConditional
    -- Atomic numeric operations
  , atomicAdd, atomicSub
  , atomicMul, atomicDiv
    -- Atomic integral operations
  , atomicMod
  , atomicAnd, atomicOr
  , atomicXor
    -- Atomic string operations
  , atomicStringPrepend, atomicStringAppend
  , atomicListLPush, atomicListRPush
  , atomicSetAdd, atomicSetRemove
  , atomicSetUnion, atomicSetIntersect
    -- Atomic simple map operations
  , atomicMapInsert, atomicMapDelete
  -- , atomicConditionalMapInsert
    -- Atomic numeric value operations
  , atomicMapAdd, atomicMapSub
  , atomicMapMul, atomicMapDiv
    -- Atomic integral value operations
  , atomicMapMod
  , atomicMapAnd, atomicMapOr
  , atomicMapXor
    -- Atomic string value operations
  , atomicMapStringPrepend
  , atomicMapStringAppend
  -- Search operations
  , search
  , deleteGroup
  )
  where

import Foreign
import Foreign.C

import Data.ByteString (ByteString)
import Data.Text (Text)

#include "hyperclient.h"

{# import Database.HyperDex.Internal.ReturnCode #}
{# import Database.HyperDex.Internal.Client #}
{# import Database.HyperDex.Internal.Attribute #}
{# import Database.HyperDex.Internal.AttributeCheck #}
{# import Database.HyperDex.Internal.MapAttribute #}
import Database.HyperDex.Internal.Util

data Op = OpPut
        | OpPutIfNotExist
        | OpAtomicAdd
        | OpAtomicSub
        | OpAtomicMul
        | OpAtomicDiv
        | OpAtomicMod
        | OpAtomicAnd
        | OpAtomicOr
        | OpAtomicXor
        | OpAtomicStringPrepend
        | OpAtomicStringAppend
        | OpAtomicListLPush
        | OpAtomicListRPush
        | OpAtomicSetAdd
        | OpAtomicSetRemove
        | OpAtomicSetIntersect
        | OpAtomicSetUnion

data MapOp = OpAtomicMapInsert
           | OpAtomicMapDelete
           | OpAtomicMapAdd
           | OpAtomicMapSub
           | OpAtomicMapMul
           | OpAtomicMapDiv
           | OpAtomicMapMod
           | OpAtomicMapAnd
           | OpAtomicMapOr
           | OpAtomicMapXor
           | OpAtomicMapStringPrepend
           | OpAtomicMapStringAppend

put :: Client -> Text -> ByteString -> [Attribute] -> AsyncResult ()
put = hyperclientOp OpPut

putIfNotExist :: Client -> Text -> ByteString -> [Attribute] -> AsyncResult ()
putIfNotExist = hyperclientOp OpPutIfNotExist

atomicAdd, atomicSub,
  atomicMul, atomicDiv,
  atomicMod,
  atomicAnd, atomicOr,
  atomicXor,
  atomicStringPrepend, atomicStringAppend,
  atomicListLPush, atomicListRPush,
  atomicSetAdd, atomicSetRemove,
  atomicSetUnion, atomicSetIntersect :: Client -> Text -> ByteString -> [Attribute] -> AsyncResult ()

atomicAdd          = hyperclientOp OpAtomicAdd
atomicSub          = hyperclientOp OpAtomicSub
atomicMul          = hyperclientOp OpAtomicMul
atomicDiv          = hyperclientOp OpAtomicDiv
atomicMod          = hyperclientOp OpAtomicMod
atomicAnd          = hyperclientOp OpAtomicAnd
atomicOr           = hyperclientOp OpAtomicOr
atomicXor          = hyperclientOp OpAtomicXor
atomicStringPrepend      = hyperclientOp OpAtomicStringPrepend
atomicStringAppend       = hyperclientOp OpAtomicStringAppend
atomicListLPush    = hyperclientOp OpAtomicListLPush
atomicListRPush    = hyperclientOp OpAtomicListRPush
atomicSetAdd       = hyperclientOp OpAtomicSetAdd
atomicSetRemove    = hyperclientOp OpAtomicSetRemove
atomicSetIntersect = hyperclientOp OpAtomicSetIntersect
atomicSetUnion     = hyperclientOp OpAtomicSetUnion

atomicMapInsert,
  atomicMapDelete,
  atomicMapAdd,
  atomicMapSub,
  atomicMapMul,
  atomicMapDiv,
  atomicMapMod,
  atomicMapAnd,
  atomicMapOr,
  atomicMapXor,
  atomicMapStringPrepend,
  atomicMapStringAppend :: Client -> Text -> ByteString -> [MapAttribute] -> AsyncResult ()

atomicMapInsert = hyperclientMapOp OpAtomicMapInsert
atomicMapDelete = hyperclientMapOp OpAtomicMapDelete
atomicMapAdd    = hyperclientMapOp OpAtomicMapAdd
atomicMapSub    = hyperclientMapOp OpAtomicMapSub
atomicMapMul    = hyperclientMapOp OpAtomicMapMul
atomicMapDiv    = hyperclientMapOp OpAtomicMapDiv
atomicMapMod    = hyperclientMapOp OpAtomicMapMod
atomicMapAnd    = hyperclientMapOp OpAtomicMapAnd
atomicMapOr     = hyperclientMapOp OpAtomicMapOr
atomicMapXor    = hyperclientMapOp OpAtomicMapXor
atomicMapStringPrepend = hyperclientMapOp OpAtomicMapStringPrepend
atomicMapStringAppend  = hyperclientMapOp OpAtomicMapStringAppend

-- int64_t
-- hyperclient_put(struct hyperclient* client, const char* space, const char* key,
--                 size_t key_sz, const struct hyperclient_attribute* attrs,
--                 size_t attrs_sz, enum hyperclient_returncode* status);
get :: Client
    -> Text
    -> ByteString
    -> AsyncResult [Attribute]
get client s k = withClient client $ \hyperclient -> do
  returnCodePtr <- new (fromIntegral . fromEnum $ HyperclientGarbage)
  attributePtrPtr <- malloc
  attributeSizePtr <- malloc
  space <- newTextUtf8 s
  (key,keySize) <- newCBStringLen k
  handle <- wrapHyperCall $
            {# call hyperclient_get #}
              hyperclient
              space key (fromIntegral keySize)
              returnCodePtr attributePtrPtr attributeSizePtr
  let continuation = do
        returnCode <- fmap (toEnum . fromIntegral) $ peek returnCodePtr
        attributes <-
          case returnCode of
            HyperclientSuccess -> do
              attributePtr <- peek attributePtrPtr
              attributeSize <- fmap fromIntegral $ peek attributeSizePtr
              attrs <- peekArray attributeSize attributePtr
              hyperdexFreeAttributes attributePtr attributeSize
              return attrs
            _ -> return []
        free returnCodePtr
        free attributePtrPtr
        free attributeSizePtr
        free space
        free key
        return $
          case returnCode of
            HyperclientSuccess -> Right attributes
            _                  -> Left returnCode
  return (handle, continuation)

-- int64_t
-- hyperclient_del(struct hyperclient* client, const char* space, const char* key,
--                 size_t key_sz, enum hyperclient_returncode* status);
delete :: Client
       -> Text
       -> ByteString
       -> AsyncResult ()
delete client s k = withClient client $ \hyperclient -> do
  returnCodePtr <- new (fromIntegral . fromEnum $ HyperclientGarbage)
  space <- newTextUtf8 s
  (key,keySize) <- newCBStringLen k
  handle <- wrapHyperCall $
            {# call hyperclient_del #}
              hyperclient
              space key (fromIntegral keySize)
              returnCodePtr
  let continuation = do
        returnCode <- fmap (toEnum . fromIntegral) $ peek returnCodePtr
        free returnCodePtr
        free space
        free key
        return $
          case returnCode of
            HyperclientSuccess -> Right ()
            _                  -> Left returnCode
  return (handle, continuation)

-- int64_t
-- hyperclient_cond_put(struct hyperclient* client, const char* space,
--                      const char* key, size_t key_sz,
--                      const struct hyperclient_attribute_check* checks, size_t checks_sz,
--                      const struct hyperclient_attribute* attrs, size_t attrs_sz,
--                      enum hyperclient_returncode* status);
putConditional :: Client
               -> Text
               -> ByteString
               -> [AttributeCheck]
               -> [Attribute]
               -> AsyncResult ()
putConditional client s k checks attributes = withClient client $ \hyperclient -> do
  returnCodePtr <- new (fromIntegral . fromEnum $ HyperclientGarbage)
  space <- newTextUtf8 s
  (key,keySize) <- newCBStringLen k
  (attributePtr, attributeSize) <- newHyperDexAttributeArray attributes
  (checkPtr, checkSize) <- newHyperDexAttributeCheckArray checks
  handle <- wrapHyperCall $
            {# call hyperclient_cond_put #}
              hyperclient
              space key (fromIntegral keySize)
              checkPtr (fromIntegral checkSize)
              attributePtr (fromIntegral attributeSize)
              returnCodePtr
  let continuation = do
        returnCode <- fmap (toEnum . fromIntegral) $ peek returnCodePtr
        free returnCodePtr
        free space
        free key
        haskellFreeAttributes attributePtr attributeSize
        haskellFreeAttributeChecks checkPtr checkSize
        return $
          case returnCode of
            HyperclientSuccess -> Right ()
            _                  -> Left returnCode
  return (handle, continuation)

-- int64_t
-- hyperclient_atomic_xor(struct hyperclient* client, const char* space,
--                        const char* key, size_t key_sz,
--                        const struct hyperclient_attribute* attrs, size_t attrs_sz,
--                        enum hyperclient_returncode* status);
hyperclientOp :: Op
              -> Client
              -> Text
              -> ByteString
              -> [Attribute]
              -> AsyncResult ()
hyperclientOp op =
  \client s k attributes ->
    withClient client $ \hyperclient -> do
  returnCodePtr <- new (fromIntegral . fromEnum $ HyperclientGarbage)
  space <- newTextUtf8 s
  (key,keySize) <- newCBStringLen k
  (attributePtr, attributeSize) <- newHyperDexAttributeArray attributes
  let ccall = case op of
              OpPut           -> {# call hyperclient_put #}
              OpPutIfNotExist -> {# call hyperclient_put_if_not_exist #}
              OpAtomicAdd     -> {# call hyperclient_atomic_add #}
              OpAtomicSub     -> {# call hyperclient_atomic_sub #}
              OpAtomicMul     -> {# call hyperclient_atomic_mul #}
              OpAtomicDiv     -> {# call hyperclient_atomic_div #}
              OpAtomicMod     -> {# call hyperclient_atomic_mod #}
              OpAtomicAnd     -> {# call hyperclient_atomic_and #}
              OpAtomicOr      -> {# call hyperclient_atomic_or  #}
              OpAtomicXor     -> {# call hyperclient_atomic_xor #}
              OpAtomicStringPrepend -> {# call hyperclient_string_prepend #}
              OpAtomicStringAppend  -> {# call hyperclient_string_append  #}
              OpAtomicListLPush     -> {# call hyperclient_list_lpush #}
              OpAtomicListRPush     -> {# call hyperclient_list_rpush #}
              OpAtomicSetAdd        -> {# call hyperclient_set_add       #}
              OpAtomicSetRemove     -> {# call hyperclient_set_remove    #}
              OpAtomicSetIntersect  -> {# call hyperclient_set_intersect #}
              OpAtomicSetUnion      -> {# call hyperclient_set_union     #}
  handle <- wrapHyperCall $
            ccall
              hyperclient
              space key (fromIntegral keySize)
              attributePtr (fromIntegral attributeSize) returnCodePtr
  let continuation = do
        returnCode <- fmap (toEnum . fromIntegral) $ peek returnCodePtr
        free returnCodePtr
        free space
        free key
        hyperdexFreeAttributes attributePtr attributeSize
        return $
          case returnCode of
            HyperclientSuccess -> Right ()
            _                  -> Left returnCode
  return (handle, continuation)
{-# INLINE hyperclientOp #-}

-- int64_t
-- hyperclient_map_add(struct hyperclient* client, const char* space,
--                     const char* key, size_t key_sz,
--                     const struct hyperclient_map_attribute* attrs, size_t attrs_sz,
--                     enum hyperclient_returncode* status);
hyperclientMapOp :: MapOp
                 -> Client
                 -> Text
                 -> ByteString
                 -> [MapAttribute]
                 -> AsyncResult ()
hyperclientMapOp op =
  \client s k mapAttributes ->
    withClient client $ \hyperclient -> do
  returnCodePtr <- new (fromIntegral . fromEnum $ HyperclientGarbage)
  space <- newTextUtf8 s
  (key,keySize) <- newCBStringLen k
  (mapAttributePtr, mapAttributeSize) <- newHyperDexMapAttributeArray mapAttributes
  let ccall = case op of
              OpAtomicMapInsert -> {# call hyperclient_map_add    #}
              OpAtomicMapDelete -> {# call hyperclient_map_remove #}
              OpAtomicMapAdd    -> {# call hyperclient_map_atomic_add #}
              OpAtomicMapSub    -> {# call hyperclient_map_atomic_sub #}
              OpAtomicMapMul    -> {# call hyperclient_map_atomic_mul #}
              OpAtomicMapDiv    -> {# call hyperclient_map_atomic_div #}
              OpAtomicMapMod    -> {# call hyperclient_map_atomic_mod #}
              OpAtomicMapAnd    -> {# call hyperclient_map_atomic_and #}
              OpAtomicMapOr     -> {# call hyperclient_map_atomic_or  #}
              OpAtomicMapXor    -> {# call hyperclient_map_atomic_xor #}
              OpAtomicMapStringPrepend -> {# call hyperclient_map_string_prepend #}
              OpAtomicMapStringAppend  -> {# call hyperclient_map_string_append  #}
  handle <- wrapHyperCall $
            ccall
              hyperclient space
              key (fromIntegral keySize)
              mapAttributePtr (fromIntegral mapAttributeSize)
              returnCodePtr
  let continuation = do
        returnCode <- fmap (toEnum . fromIntegral) $ peek returnCodePtr
        free returnCodePtr
        free space
        free key
        --haskellFreeMapAttributes mapAttributePtr mapAttributeSize
        return $
          case returnCode of
            HyperclientSuccess -> Right ()
            _                  -> Left returnCode
  return (handle, continuation)
{-# INLINE hyperclientMapOp #-}

-- int64_t
-- hyperclient_map_add(struct hyperclient* client, const char* space,
--                     const char* key, size_t key_sz,
--                     const struct hyperclient_map_attribute* attrs, size_t attrs_sz,
--                     enum hyperclient_returncode* status);
---- A compilation error prevents this from being implemented:
-- /home/cloudium/git/hyhac/dist/build/libHShyhac-0.2.0.0_p.a(Hyperclient.p_o): In function `ra9O_info':
-- /tmp/ghc20379_0/ghc20379_1.p_o:(.text+0x1d6): undefined reference to `hyperclient_cond_map_add'
-- /home/cloudium/git/hyhac/dist/build/libHShyhac-0.2.0.0_p.a(Hyperclient.p_o): In function `sdlx_info':
-- /tmp/ghc20379_0/ghc20379_1.p_o:(.text+0x3d08d): undefined reference to `hyperclient_cond_map_add'
-- /home/cloudium/git/hyhac/dist/build/libHShyhac-0.2.0.0_p.a(Hyperclient.p_o): In function `sdm2_info':
-- /tmp/ghc20379_0/ghc20379_1.p_o:(.text+0x3dc85): undefined reference to `hyperclient_cond_map_add'

-- atomicConditionalMapInsert :: Hyperclient -> Text -> ByteString
--                            -> [AttributeCheck]
--                            -> [MapAttribute]
--                            -> AsyncResultHandle ()
-- atomicConditionalMapInsert client s k checks mapAttributes = do
--   returnCodePtr <- new (fromIntegral . fromEnum $ HyperclientGarbage)
--   space <- newTextUtf8 s
--   (key,keySize) <- newCBStringLen k
--   (checkPtr, checkSize) <- newHyperDexAttributeCheckArray checks
--   (mapAttributePtr, mapAttributeSize) <- newHyperDexMapAttributeArray mapAttributes
--   handle <- {# call hyperclient_cond_map_add #}
--               client space
--               key (fromIntegral keySize)
--               checkPtr (fromIntegral checkSize)
--               mapAttributePtr (fromIntegral mapAttributeSize)
--               returnCodePtr
--   let continuation = do
--         returnCode <- fmap (toEnum . fromIntegral) $ peek returnCodePtr
--         free returnCodePtr
--         free space
--         free key
--         --haskellFreeMapAttributes mapAttributePtr mapAttributeSize
--         return $
--           case returnCode of
--             HyperclientSuccess -> Right ()
--             _                  -> Left returnCode
--   return (handle, continuation)
-- {-# INLINE atomicConditionalMapInsert #-}

-- int64_t
-- hyperclient_search(struct hyperclient* client, const char* space,
--                    const struct hyperclient_attribute_check* checks, size_t checks_sz,
--                    enum hyperclient_returncode* status,
--                    struct hyperclient_attribute** attrs, size_t* attrs_sz);
search :: Client
          -> Text
          -> [AttributeCheck]
          -> AsyncResult (SearchStream [Attribute])
search client s checks = withClientStream client $ \hyperclient -> do
  returnCodePtr <- new (fromIntegral . fromEnum $ HyperclientGarbage)
  space <- newTextUtf8 s
  (checkPtr, checkSize) <- newHyperDexAttributeCheckArray checks
  resultSetPtrPtr <- malloc
  resultSetSizePtr <- malloc
  handle <- wrapHyperCall $
            {# call hyperclient_search #}
              hyperclient space
              checkPtr (fromIntegral checkSize :: {# type size_t #})
              returnCodePtr
              resultSetPtrPtr resultSetSizePtr
  case handle >= 0 of
    True -> do
      let continuation (Just HyperclientSuccess) = do
            returnCode <- fmap (toEnum . fromIntegral) $ peek returnCodePtr
            case returnCode of
              HyperclientSuccess -> do
                resultSize <- peek resultSetSizePtr
                resultSetPtr <- peek resultSetPtrPtr
                resultSet <- peekArray (fromIntegral resultSize) resultSetPtr
                return $ Right resultSet
              _ -> return $ Left returnCode
          continuation e = do
            free returnCodePtr
            free space
            haskellFreeAttributeChecks checkPtr checkSize
            free resultSetPtrPtr
            free resultSetSizePtr
            return $ Left $ case e of
                              Nothing -> HyperclientDupeattr
                              Just rc -> rc
      return (handle, continuation)
    False -> do
      let continuation = const $ do
            returnCode <- fmap (toEnum . fromIntegral) $ peek returnCodePtr
            free returnCodePtr
            free space
            haskellFreeAttributeChecks checkPtr checkSize
            free resultSetPtrPtr
            free resultSetSizePtr
            return $ Left returnCode
      return (handle, continuation)

-- int64_t
-- hyperclient_group_del(struct hyperclient* client, const char* space,
--                       const struct hyperclient_attribute_check* checks, size_t checks_sz,
--                       enum hyperclient_returncode* status);
--
deleteGroup :: Client
            -> Text
            -> [AttributeCheck]
            -> AsyncResult ()
deleteGroup client s checks = withClient client $ \hyperclient -> do
  returnCodePtr <- new (fromIntegral . fromEnum $ HyperclientGarbage)
  space <- newTextUtf8 s
  (checkPtr, checkSize) <- newHyperDexAttributeCheckArray checks
  handle <- wrapHyperCall $
            {# call hyperclient_group_del #}
              hyperclient space
              checkPtr (fromIntegral checkSize)
              returnCodePtr
  let continuation = do
        returnCode <- fmap (toEnum . fromIntegral) $ peek returnCodePtr
        free returnCodePtr
        free space
        haskellFreeAttributeChecks checkPtr checkSize
        return $
          case returnCode of
            HyperclientSuccess -> Right ()
            _                  -> Left returnCode
  return (handle, continuation)

module Database.HyperDex.Internal.Hyperclient
  ( -- Simple, single-key operations
    get
  , put
  , putIfNotExist
  , delete
  , putConditional
    -- Atomic numeric operations
  , atomicAdd, atomicSub
  , atomicMul, atomicDiv
    -- Atomic integral operations
  , atomicMod
  , atomicAnd, atomicOr
  , atomicXor
    -- Atomic string operations
  , atomicStringPrepend, atomicStringAppend
  , atomicListLPush, atomicListRPush
  , atomicSetAdd, atomicSetRemove
  , atomicSetUnion, atomicSetIntersect
    -- Atomic simple map operations
  , atomicMapInsert, atomicMapDelete
  -- , hyperMapInsertConditional
    -- Atomic numeric value operations
  , atomicMapAdd, atomicMapSub
  , atomicMapMul, atomicMapDiv
    -- Atomic integral value operations
  , atomicMapMod
  , atomicMapAnd, atomicMapOr
  , atomicMapXor
    -- Atomic string value operations
  , atomicMapStringPrepend
  , atomicMapStringAppend
  -- Search operations
  , search
  , deleteGroup
  )
  where

import Foreign
import Foreign.C

import Data.ByteString (ByteString)
import Data.Text (Text)

#include "hyperclient.h"

{# import Database.HyperDex.Internal.ReturnCode #}
{# import Database.HyperDex.Internal.Client #}
{# import Database.HyperDex.Internal.Attribute #}
{# import Database.HyperDex.Internal.AttributeCheck #}
{# import Database.HyperDex.Internal.MapAttribute #}
import Database.HyperDex.Internal.Util

data Op = OpPut
        | OpPutIfNotExist
        | OpAtomicAdd
        | OpAtomicSub
        | OpAtomicMul
        | OpAtomicDiv
        | OpAtomicMod
        | OpAtomicAnd
        | OpAtomicOr
        | OpAtomicXor
        | OpAtomicStringPrepend
        | OpAtomicStringAppend
        | OpAtomicListLPush
        | OpAtomicListRPush
        | OpAtomicSetAdd
        | OpAtomicSetRemove
        | OpAtomicSetIntersect
        | OpAtomicSetUnion

data MapOp = OpAtomicMapInsert
           | OpAtomicMapDelete
           | OpAtomicMapAdd
           | OpAtomicMapSub
           | OpAtomicMapMul
           | OpAtomicMapDiv
           | OpAtomicMapMod
           | OpAtomicMapAnd
           | OpAtomicMapOr
           | OpAtomicMapXor
           | OpAtomicMapStringPrepend
           | OpAtomicMapStringAppend

put :: Client -> Text -> ByteString -> [Attribute] -> AsyncResult ()
put = hyperclientOp OpPut

putIfNotExist :: Client -> Text -> ByteString -> [Attribute] -> AsyncResult ()
putIfNotExist = hyperclientOp OpPutIfNotExist

atomicAdd, atomicSub,
  atomicMul, atomicDiv,
  atomicMod,
  atomicAnd, atomicOr,
  atomicXor,
  atomicStringPrepend, atomicStringAppend,
  atomicListLPush, atomicListRPush,
  atomicSetAdd, atomicSetRemove,
  atomicSetUnion, atomicSetIntersect :: Client -> Text -> ByteString -> [Attribute] -> AsyncResult ()

atomicAdd          = hyperclientOp OpAtomicAdd
atomicSub          = hyperclientOp OpAtomicSub
atomicMul          = hyperclientOp OpAtomicMul
atomicDiv          = hyperclientOp OpAtomicDiv
atomicMod          = hyperclientOp OpAtomicMod
atomicAnd          = hyperclientOp OpAtomicAnd
atomicOr           = hyperclientOp OpAtomicOr
atomicXor          = hyperclientOp OpAtomicXor
atomicStringPrepend      = hyperclientOp OpAtomicStringPrepend
atomicStringAppend       = hyperclientOp OpAtomicStringAppend
atomicListLPush    = hyperclientOp OpAtomicListLPush
atomicListRPush    = hyperclientOp OpAtomicListRPush
atomicSetAdd       = hyperclientOp OpAtomicSetAdd
atomicSetRemove    = hyperclientOp OpAtomicSetRemove
atomicSetIntersect = hyperclientOp OpAtomicSetIntersect
atomicSetUnion     = hyperclientOp OpAtomicSetUnion

atomicMapInsert,
  atomicMapDelete,
  atomicMapAdd,
  atomicMapSub,
  atomicMapMul,
  atomicMapDiv,
  atomicMapMod,
  atomicMapAnd,
  atomicMapOr,
  atomicMapXor,
  atomicMapStringPrepend,
  atomicMapStringAppend :: Client -> Text -> ByteString -> [MapAttribute] -> AsyncResult ()

atomicMapInsert = hyperclientMapOp OpAtomicMapInsert
atomicMapDelete = hyperclientMapOp OpAtomicMapDelete
atomicMapAdd    = hyperclientMapOp OpAtomicMapAdd
atomicMapSub    = hyperclientMapOp OpAtomicMapSub
atomicMapMul    = hyperclientMapOp OpAtomicMapMul
atomicMapDiv    = hyperclientMapOp OpAtomicMapDiv
atomicMapMod    = hyperclientMapOp OpAtomicMapMod
atomicMapAnd    = hyperclientMapOp OpAtomicMapAnd
atomicMapOr     = hyperclientMapOp OpAtomicMapOr
atomicMapXor    = hyperclientMapOp OpAtomicMapXor
atomicMapStringPrepend = hyperclientMapOp OpAtomicMapStringPrepend
atomicMapStringAppend  = hyperclientMapOp OpAtomicMapStringAppend

-- hyperMapInsertConditional :: Client -> Text -> ByteString -> [AttributeCheck] -> [MapAttribute] -> AsyncResult ()
-- hyperMapInsertConditional c s k checks attrs = withClient c $ \hc -> hyperclientConditionalMapInsert hc s k checks attrs

-- int64_t
-- hyperclient_put(struct hyperclient* client, const char* space, const char* key,
--                 size_t key_sz, const struct hyperclient_attribute* attrs,
--                 size_t attrs_sz, enum hyperclient_returncode* status);
get :: Client
    -> Text
    -> ByteString
    -> AsyncResult [Attribute]
get client s k = withClient client $ \hyperclient -> do
  returnCodePtr <- new (fromIntegral . fromEnum $ HyperclientGarbage)
  attributePtrPtr <- malloc
  attributeSizePtr <- malloc
  space <- newTextUtf8 s
  (key,keySize) <- newCBStringLen k
  handle <- wrapHyperCall $
            {# call hyperclient_get #}
              hyperclient
              space key (fromIntegral keySize)
              returnCodePtr attributePtrPtr attributeSizePtr
  let continuation = do
        returnCode <- fmap (toEnum . fromIntegral) $ peek returnCodePtr
        attributes <-
          case returnCode of
            HyperclientSuccess -> do
              attributePtr <- peek attributePtrPtr
              attributeSize <- fmap fromIntegral $ peek attributeSizePtr
              attrs <- peekArray attributeSize attributePtr
              hyperdexFreeAttributes attributePtr attributeSize
              return attrs
            _ -> return []
        free returnCodePtr
        free attributePtrPtr
        free attributeSizePtr
        free space
        free key
        return $
          case returnCode of
            HyperclientSuccess -> Right attributes
            _                  -> Left returnCode
  return (handle, continuation)

-- int64_t
-- hyperclient_del(struct hyperclient* client, const char* space, const char* key,
--                 size_t key_sz, enum hyperclient_returncode* status);
delete :: Client
       -> Text
       -> ByteString
       -> AsyncResult ()
delete client s k = withClient client $ \hyperclient -> do
  returnCodePtr <- new (fromIntegral . fromEnum $ HyperclientGarbage)
  space <- newTextUtf8 s
  (key,keySize) <- newCBStringLen k
  handle <- wrapHyperCall $
            {# call hyperclient_del #}
              hyperclient
              space key (fromIntegral keySize)
              returnCodePtr
  let continuation = do
        returnCode <- fmap (toEnum . fromIntegral) $ peek returnCodePtr
        free returnCodePtr
        free space
        free key
        return $
          case returnCode of
            HyperclientSuccess -> Right ()
            _                  -> Left returnCode
  return (handle, continuation)

-- int64_t
-- hyperclient_cond_put(struct hyperclient* client, const char* space,
--                      const char* key, size_t key_sz,
--                      const struct hyperclient_attribute_check* checks, size_t checks_sz,
--                      const struct hyperclient_attribute* attrs, size_t attrs_sz,
--                      enum hyperclient_returncode* status);
putConditional :: Client
               -> Text
               -> ByteString
               -> [AttributeCheck]
               -> [Attribute]
               -> AsyncResult ()
putConditional client s k checks attributes = withClient client $ \hyperclient -> do
  returnCodePtr <- new (fromIntegral . fromEnum $ HyperclientGarbage)
  space <- newTextUtf8 s
  (key,keySize) <- newCBStringLen k
  (attributePtr, attributeSize) <- newHyperDexAttributeArray attributes
  (checkPtr, checkSize) <- newHyperDexAttributeCheckArray checks
  handle <- wrapHyperCall $
            {# call hyperclient_cond_put #}
              hyperclient
              space key (fromIntegral keySize)
              checkPtr (fromIntegral checkSize)
              attributePtr (fromIntegral attributeSize)
              returnCodePtr
  let continuation = do
        returnCode <- fmap (toEnum . fromIntegral) $ peek returnCodePtr
        free returnCodePtr
        free space
        free key
        haskellFreeAttributes attributePtr attributeSize
        haskellFreeAttributeChecks checkPtr checkSize
        return $
          case returnCode of
            HyperclientSuccess -> Right ()
            _                  -> Left returnCode
  return (handle, continuation)

-- int64_t
-- hyperclient_atomic_xor(struct hyperclient* client, const char* space,
--                        const char* key, size_t key_sz,
--                        const struct hyperclient_attribute* attrs, size_t attrs_sz,
--                        enum hyperclient_returncode* status);
hyperclientOp :: Op
              -> Client
              -> Text
              -> ByteString
              -> [Attribute]
              -> AsyncResult ()
hyperclientOp op =
  \client s k attributes ->
    withClient client $ \hyperclient -> do
  returnCodePtr <- new (fromIntegral . fromEnum $ HyperclientGarbage)
  space <- newTextUtf8 s
  (key,keySize) <- newCBStringLen k
  (attributePtr, attributeSize) <- newHyperDexAttributeArray attributes
  let ccall = case op of
              OpPut           -> {# call hyperclient_put #}
              OpPutIfNotExist -> {# call hyperclient_put_if_not_exist #}
              OpAtomicAdd     -> {# call hyperclient_atomic_add #}
              OpAtomicSub     -> {# call hyperclient_atomic_sub #}
              OpAtomicMul     -> {# call hyperclient_atomic_mul #}
              OpAtomicDiv     -> {# call hyperclient_atomic_div #}
              OpAtomicMod     -> {# call hyperclient_atomic_mod #}
              OpAtomicAnd     -> {# call hyperclient_atomic_and #}
              OpAtomicOr      -> {# call hyperclient_atomic_or  #}
              OpAtomicXor     -> {# call hyperclient_atomic_xor #}
              OpAtomicStringPrepend -> {# call hyperclient_string_prepend #}
              OpAtomicStringAppend  -> {# call hyperclient_string_append  #}
              OpAtomicListLPush     -> {# call hyperclient_list_lpush #}
              OpAtomicListRPush     -> {# call hyperclient_list_rpush #}
              OpAtomicSetAdd        -> {# call hyperclient_set_add       #}
              OpAtomicSetRemove     -> {# call hyperclient_set_remove    #}
              OpAtomicSetIntersect  -> {# call hyperclient_set_intersect #}
              OpAtomicSetUnion      -> {# call hyperclient_set_union     #}
  handle <- wrapHyperCall $
            ccall
              hyperclient
              space key (fromIntegral keySize)
              attributePtr (fromIntegral attributeSize) returnCodePtr
  let continuation = do
        returnCode <- fmap (toEnum . fromIntegral) $ peek returnCodePtr
        free returnCodePtr
        free space
        free key
        hyperdexFreeAttributes attributePtr attributeSize
        return $
          case returnCode of
            HyperclientSuccess -> Right ()
            _                  -> Left returnCode
  return (handle, continuation)
{-# INLINE hyperclientOp #-}

-- int64_t
-- hyperclient_map_add(struct hyperclient* client, const char* space,
--                     const char* key, size_t key_sz,
--                     const struct hyperclient_map_attribute* attrs, size_t attrs_sz,
--                     enum hyperclient_returncode* status);
hyperclientMapOp :: MapOp
                 -> Client
                 -> Text
                 -> ByteString
                 -> [MapAttribute]
                 -> AsyncResult ()
hyperclientMapOp op =
  \client s k mapAttributes ->
    withClient client $ \hyperclient -> do
  returnCodePtr <- new (fromIntegral . fromEnum $ HyperclientGarbage)
  space <- newTextUtf8 s
  (key,keySize) <- newCBStringLen k
  (mapAttributePtr, mapAttributeSize) <- newHyperDexMapAttributeArray mapAttributes
  let ccall = case op of
              OpAtomicMapInsert -> {# call hyperclient_map_add    #}
              OpAtomicMapDelete -> {# call hyperclient_map_remove #}
              OpAtomicMapAdd    -> {# call hyperclient_map_atomic_add #}
              OpAtomicMapSub    -> {# call hyperclient_map_atomic_sub #}
              OpAtomicMapMul    -> {# call hyperclient_map_atomic_mul #}
              OpAtomicMapDiv    -> {# call hyperclient_map_atomic_div #}
              OpAtomicMapMod    -> {# call hyperclient_map_atomic_mod #}
              OpAtomicMapAnd    -> {# call hyperclient_map_atomic_and #}
              OpAtomicMapOr     -> {# call hyperclient_map_atomic_or  #}
              OpAtomicMapXor    -> {# call hyperclient_map_atomic_xor #}
              OpAtomicMapStringPrepend -> {# call hyperclient_map_string_prepend #}
              OpAtomicMapStringAppend  -> {# call hyperclient_map_string_append  #}
  handle <- wrapHyperCall $
            ccall
              hyperclient space
              key (fromIntegral keySize)
              mapAttributePtr (fromIntegral mapAttributeSize)
              returnCodePtr
  let continuation = do
        returnCode <- fmap (toEnum . fromIntegral) $ peek returnCodePtr
        free returnCodePtr
        free space
        free key
        --haskellFreeMapAttributes mapAttributePtr mapAttributeSize
        return $
          case returnCode of
            HyperclientSuccess -> Right ()
            _                  -> Left returnCode
  return (handle, continuation)
{-# INLINE hyperclientMapOp #-}

-- int64_t
-- hyperclient_map_add(struct hyperclient* client, const char* space,
--                     const char* key, size_t key_sz,
--                     const struct hyperclient_map_attribute* attrs, size_t attrs_sz,
--                     enum hyperclient_returncode* status);
---- A compilation error prevents this from being implemented:
-- /home/cloudium/git/hyhac/dist/build/libHShyhac-0.2.0.0_p.a(Hyperclient.p_o): In function `ra9O_info':
-- /tmp/ghc20379_0/ghc20379_1.p_o:(.text+0x1d6): undefined reference to `hyperclient_cond_map_add'
-- /home/cloudium/git/hyhac/dist/build/libHShyhac-0.2.0.0_p.a(Hyperclient.p_o): In function `sdlx_info':
-- /tmp/ghc20379_0/ghc20379_1.p_o:(.text+0x3d08d): undefined reference to `hyperclient_cond_map_add'
-- /home/cloudium/git/hyhac/dist/build/libHShyhac-0.2.0.0_p.a(Hyperclient.p_o): In function `sdm2_info':
-- /tmp/ghc20379_0/ghc20379_1.p_o:(.text+0x3dc85): undefined reference to `hyperclient_cond_map_add'

--hyperclientConditionalMapInsert :: Hyperclient -> Text -> ByteString
--                                -> [AttributeCheck]
--                                -> [MapAttribute]
--                                -> AsyncResultHandle ()
--hyperclientConditionalMapInsert client s k checks mapAttributes = do
--  returnCodePtr <- new (fromIntegral . fromEnum $ HyperclientGarbage)
--  space <- newTextUtf8 s
--  (key,keySize) <- newCBStringLen k
--  (checkPtr, checkSize) <- newHyperDexAttributeCheckArray checks
--  (mapAttributePtr, mapAttributeSize) <- newHyperDexMapAttributeArray mapAttributes
--  handle <- {# call hyperclient_cond_map_add #}
--              client space
--              key (fromIntegral keySize)
--              checkPtr (fromIntegral checkSize)
--              mapAttributePtr (fromIntegral mapAttributeSize)
--              returnCodePtr
--  let continuation = do
--        returnCode <- fmap (toEnum . fromIntegral) $ peek returnCodePtr
--        free returnCodePtr
--        free space
--        free key
--        --haskellFreeMapAttributes mapAttributePtr mapAttributeSize
--        return $
--          case returnCode of
--            HyperclientSuccess -> Right ()
--            _                  -> Left returnCode
--  return (handle, continuation)
--{-# INLINE hyperclientConditionalMapInsert #-}

-- int64_t
-- hyperclient_search(struct hyperclient* client, const char* space,
--                    const struct hyperclient_attribute_check* checks, size_t checks_sz,
--                    enum hyperclient_returncode* status,
--                    struct hyperclient_attribute** attrs, size_t* attrs_sz);
search :: Client
          -> Text
          -> [AttributeCheck]
          -> AsyncResult (SearchStream [Attribute])
search client s checks = withClientStream client $ \hyperclient -> do
  returnCodePtr <- new (fromIntegral . fromEnum $ HyperclientGarbage)
  space <- newTextUtf8 s
  (checkPtr, checkSize) <- newHyperDexAttributeCheckArray checks
  resultSetPtrPtr <- malloc
  resultSetSizePtr <- malloc
  handle <- wrapHyperCall $
            {# call hyperclient_search #}
              hyperclient space
              checkPtr (fromIntegral checkSize :: {# type size_t #})
              returnCodePtr
              resultSetPtrPtr resultSetSizePtr
  case handle >= 0 of
    True -> do
      let continuation (Just HyperclientSuccess) = do
            returnCode <- fmap (toEnum . fromIntegral) $ peek returnCodePtr
            case returnCode of
              HyperclientSuccess -> do
                resultSize <- peek resultSetSizePtr
                resultSetPtr <- peek resultSetPtrPtr
                resultSet <- peekArray (fromIntegral resultSize) resultSetPtr
                return $ Right resultSet
              _ -> return $ Left returnCode
          continuation e = do
            free returnCodePtr
            free space
            haskellFreeAttributeChecks checkPtr checkSize
            free resultSetPtrPtr
            free resultSetSizePtr
            return $ Left $ case e of
                              Nothing -> HyperclientDupeattr
                              Just rc -> rc
      return (handle, continuation)
    False -> do
      let continuation = const $ do
            returnCode <- fmap (toEnum . fromIntegral) $ peek returnCodePtr
            free returnCodePtr
            free space
            haskellFreeAttributeChecks checkPtr checkSize
            free resultSetPtrPtr
            free resultSetSizePtr
            return $ Left returnCode
      return (handle, continuation)

-- int64_t
-- hyperclient_group_del(struct hyperclient* client, const char* space,
--                       const struct hyperclient_attribute_check* checks, size_t checks_sz,
--                       enum hyperclient_returncode* status);
--
deleteGroup :: Client
            -> Text
            -> [AttributeCheck]
            -> AsyncResult ()
deleteGroup client s checks = withClient client $ \hyperclient -> do
  returnCodePtr <- new (fromIntegral . fromEnum $ HyperclientGarbage)
  space <- newTextUtf8 s
  (checkPtr, checkSize) <- newHyperDexAttributeCheckArray checks
  handle <- wrapHyperCall $
            {# call hyperclient_group_del #}
              hyperclient space
              checkPtr (fromIntegral checkSize)
              returnCodePtr
  let continuation = do
        returnCode <- fmap (toEnum . fromIntegral) $ peek returnCodePtr
        free returnCodePtr
        free space
        haskellFreeAttributeChecks checkPtr checkSize
        return $
          case returnCode of
            HyperclientSuccess -> Right ()
            _                  -> Left returnCode
  return (handle, continuation)