packages feed

KyotoCabinet (empty) → 0.1

raw patch · 6 files changed

+1651/−0 lines, 6 filesdep +basedep +bytestringdep +extensible-exceptionssetup-changed

Dependencies added: base, bytestring, extensible-exceptions

Files

+ COPYING view
@@ -0,0 +1,28 @@+Copyright 2011, Google Inc.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+notice, this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above+copyright notice, this list of conditions and the following disclaimer+in the documentation and/or other materials provided with the+distribution.+    * Neither the name of Google Inc. nor the names of its+contributors may be used to endorse or promote products derived from+this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Database/KyotoCabinet/Db.hsc view
@@ -0,0 +1,1421 @@+{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, DeriveDataTypeable,+             ScopedTypeVariables #-}+{-+Copyright 2011, Google Inc.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+notice, this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above+copyright notice, this list of conditions and the following disclaimer+in the documentation and/or other materials provided with the+distribution.+    * Neither the name of Google Inc. nor the names of its+contributors may be used to endorse or promote products derived from+this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+-}++#include <kclangc.h>++-- | Kyoto Cabinet DB bindings. All IO monad functions can throw KcException.+--+-- This documentation is not a complete description of the Kyoto+-- Cabinet DB interface.  You will need to refer to Kyoto Cabinet DB's+-- C API documentation for the details: <http://fallabs.com/kyotocabinet/>++module Database.KyotoCabinet.Db (+  -- * Types+  KcDb,+  KcCur,+  KcError(..),+  KcTune(..),+  KcTuneType(..),+  KcLogger(..),+  KcLogLevel(..),+  KcOption(..),+  KcCompressor(..),+  KcComparator(..),+  KcOpenMode(..),+  KcMergeMode(..),+  KcException(..),+  KcVisitAction(..),+  KcVisitFull,+  KcVisitEmpty,+  KcFileProc,++  -- * Utilities+  -- | Most of these routines are probably not needed by haskell users, but are+  -- included for completeness.+  kcversion,+  kcmalloc,+  kcfree,+  kctime,+  kcatoi,+  kcatoix,+  kcatof,+  kchashmurmur,+  kchashfnv,+  kcnan,+  kcinf,+  kcchknan,+  kcchkinf,+  kcecodename,++  -- * DB Operations+  kcdbnew,+  kcdbdel,+  kcdbopen,+  kcdbclose,+  kcdbecode,+  kcdbemsg,+  kcdbaccept,+  kcdbacceptbulk,+  kcdbiterate,+  kcdbset,+  kcdbadd,+  kcdbreplace,+  kcdbappend,+  kcdbincrint,+  kcdbincrdouble,+  kcdbcas,+  kcdbremove,+  kcdbget,+  kcdbgetbuf,+  kcdbsetbulk,+  kcdbremovebulk,+  kcdbgetbulk,+  kcdbclear,+  kcdbsync,+  kcdbcopy,+  kcdbbegintran,+  kcdbbegintrantry,+  kcdbendtran,+  kcdbdumpsnap,+  kcdbloadsnap,+  kcdbcount,+  kcdbsize,+  kcdbpath,+  kcdbstatus,+  kcdbmatchprefix,+  kcdbmatchregex,+  kcdbmerge,++  -- * Cursor Operations+  kcdbcursor,+  kccurdel,+  kccuraccept,+  kccurremove,+  kccurgetkey,+  kccurgetvalue,+  kccurget,+  kccurjump,+  kccurjumpkey,+  kccurjumpback,+  kccurjumpbackkey,+  kccurstep,+  kccurstepback,+  kccurdb,+  kccurecode,+  kccuremsg,++  -- * Scoped Operations+  kcwithdbopen,+  kcwithdbcursor,+  kcwithdbtran+  ) where++import Control.Applicative+import Control.Exception+import Data.Bits+import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BS+import qualified Data.ByteString.Unsafe as BS+import Data.Typeable+import Data.Int+import Foreign.C+import Foreign.Marshal.Alloc+import Foreign.Marshal.Array+import Foreign.Storable+import Foreign.Ptr+import Foreign.ForeignPtr+import Prelude hiding (catch)+--import Debug.Trace++--------------------------------------------------------------------------------+-- Structs++-- | Binary string of byte array.+newtype KcStr = KcStr BS.ByteString++instance Storable KcStr where+  sizeOf    _ = (#size KCSTR)+  alignment _ = alignment (undefined :: CSize)+  peek ptr = do+    b <- (#peek KCSTR, buf) ptr+    s <- (#peek KCSTR, size) ptr+    KcStr <$> BS.unsafePackCStringFinalizer b s (kcfree b)+  poke ptr (KcStr bs) = do+    BS.unsafeUseAsCStringLen bs $ \(b, s) -> do+      (#poke KCSTR, buf) ptr b+      (#poke KCSTR, size) ptr s++withKcStrArray :: [BS.ByteString] -> (Ptr KcStr -> IO a) -> IO a+withKcStrArray strs f = do+  allocaArray (length strs) $ \arr -> do+    pokeArray arr (map KcStr strs)+    f arr++-- | Key-Value record.+newtype KcRec = KcRec (BS.ByteString, BS.ByteString)++instance Storable KcRec where+  sizeOf    _ = (#size KCREC)+  alignment _ = alignment (undefined :: KcStr)+  peek ptr = do+    KcStr k <- (#peek KCREC, key) ptr+    KcStr v <- (#peek KCREC, value) ptr+    return $ KcRec (k, v)+  poke ptr (KcRec (k, v)) = do+    (#poke KCREC, key) ptr (KcStr k)+    (#poke KCREC, value) ptr (KcStr v)++withKcRecArray :: [(BS.ByteString, BS.ByteString)] -> (Ptr KcRec -> IO a) -> IO a+withKcRecArray recs f = do+  allocaArray (length recs) $ \arr -> do+    pokeArray arr (map KcRec recs)+    f arr++bsListOfCStringArr :: Ptr CString -> CLLong -> IO [BS.ByteString]+bsListOfCStringArr strarr n = do+  strlist <- peekArray (fromIntegral n) strarr+  bssOfCstrs strlist++bssOfCstrs :: [CString] -> IO [BS.ByteString]+bssOfCstrs [] = return []+bssOfCstrs (h:t) = do+  hLen <- BS.c_strlen h+  bs' <- BS.unsafePackCStringFinalizer (castPtr h) (fromIntegral hLen) (kcfree h)+  rest <- bssOfCstrs t+  return $ bs' `seq` (bs':rest)++--------------------------------------------------------------------------------+-- Constants++-- | Error codes.+data KcError = KCESUCCESS   -- ^ success+             | KCENOIMPL    -- ^ not implemented+             | KCEINVALID   -- ^ invalid operation+             | KCENOREPOS   -- ^ no repository+             | KCENOPERM    -- ^ no permission+             | KCEBROKEN    -- ^ broken file+             | KCEDUPREC    -- ^ record duplication+             | KCENOREC     -- ^ no record+             | KCELOGIC     -- ^ logical inconsistency+             | KCESYSTEM    -- ^ system error+             | KCEMISC      -- ^ miscellaneous error+             | KCUNKNOWNERROR Int+             deriving (Eq, Show)++kcErrorOfNum :: CInt -> KcError+kcErrorOfNum (#const KCESUCCESS) = KCESUCCESS+kcErrorOfNum (#const KCENOIMPL) = KCENOIMPL+kcErrorOfNum (#const KCEINVALID) = KCEINVALID+kcErrorOfNum (#const KCENOREPOS) = KCENOREPOS+kcErrorOfNum (#const KCENOPERM) = KCENOPERM+kcErrorOfNum (#const KCEBROKEN) = KCEBROKEN+kcErrorOfNum (#const KCEDUPREC) = KCEDUPREC+kcErrorOfNum (#const KCENOREC) = KCENOREC+kcErrorOfNum (#const KCELOGIC) = KCELOGIC+kcErrorOfNum (#const KCESYSTEM) = KCESYSTEM+kcErrorOfNum (#const KCEMISC) = KCEMISC+kcErrorOfNum n = KCUNKNOWNERROR (fromIntegral n)++-- | Open modes.+data KcOpenMode = KCOREADER         -- ^ open as a reader+                | KCOWRITER         -- ^ open as a writer+                | KCOCREATE         -- ^ writer creating+                | KCOTRUNCATE       -- ^ writer truncating+                | KCOAUTOTRAN       -- ^ auto transaction+                | KCOAUTOSYNC       -- ^ auto synchronization+                | KCONOLOCK         -- ^ open without locking+                | KCOTRYLOCK        -- ^ lock without blocking+                | KCONOREPAIR       -- ^ open without auto repair+                deriving (Eq, Show)++numOfKcOpenMode :: KcOpenMode -> Int+numOfKcOpenMode KCOREADER = (#const KCOREADER)+numOfKcOpenMode KCOWRITER = (#const KCOWRITER)+numOfKcOpenMode KCOCREATE = (#const KCOCREATE)+numOfKcOpenMode KCOTRUNCATE = (#const KCOTRUNCATE)+numOfKcOpenMode KCOAUTOTRAN = (#const KCOAUTOTRAN)+numOfKcOpenMode KCOAUTOSYNC = (#const KCOAUTOSYNC)+numOfKcOpenMode KCONOLOCK = (#const KCONOLOCK)+numOfKcOpenMode KCOTRYLOCK = (#const KCOTRYLOCK)+numOfKcOpenMode KCONOREPAIR = (#const KCONOREPAIR)++numOfOpenModes :: [KcOpenMode] -> CUInt+numOfOpenModes mode = fromIntegral $ foldr (\m acc -> numOfKcOpenMode m .|. acc) 0 mode++-- | Merge modes.+data KcMergeMode = KCMSET       -- ^ overwrite the existing value+                 | KCMADD       -- ^ keep the existing value+                 | KCMREPLACE   -- ^ modify the existing record only+                 | KCMAPPEND    -- ^ append the new value+                 deriving (Eq, Show)++numOfKcMergeMode :: KcMergeMode -> Int+numOfKcMergeMode KCMSET = (#const KCMSET)+numOfKcMergeMode KCMADD = (#const KCMADD)+numOfKcMergeMode KCMREPLACE = (#const KCMREPLACE)+numOfKcMergeMode KCMAPPEND = (#const KCMAPPEND)++{- link errors:+-- | The package version.+kcVERSION = #const KCVERSION++-- | Special pointer for no operation by the visiting function.+kcVISNOP = #const KCVISNOP++-- | Special pointer to remove the record by the visiting function.+kcVISREMOVE = #const KCVISREMOVE+-}++-- | Current KC version.+kcversion :: IO String+kcversion = kcVERSION >>= peekCAString++foreign import ccall safe "kclangc.h getKCVERSION" kcVERSION+  :: IO CString++foreign import ccall safe "kclangc.h getKCVISNOP" kcVISNOP+  :: IO CString++foreign import ccall safe "kclangc.h getKCVISREMOVE" kcVISREMOVE+  :: IO CString++-- | Return one of these from 'KcVisitFull', 'KcVisitEmpty' or+-- 'KcFileProc' to update the database after a visitor access.+data KcVisitAction = KCVISNOP | KCVISSET BS.ByteString | KCVISREMOVE++-- | Type of a visitor function when key-value is present.+type KcVisitFull = BS.ByteString -> BS.ByteString -> IO KcVisitAction++callVisitFull :: KcVisitFull -> KCVISITFULL+callVisitFull visitFull kbuf ksiz vbuf vsiz sp _ = do+  key <- BS.unsafePackCStringLen (kbuf, fromIntegral ksiz)+  val <- BS.unsafePackCStringLen (vbuf, fromIntegral vsiz)+  rv <- visitFull key val+  case rv of+    KCVISNOP -> kcVISNOP+    KCVISSET newVal ->+      BS.unsafeUseAsCStringLen newVal $ \(cstr, clen) -> do+        poke sp (fromIntegral clen)+        return cstr -- XXX what if newVal is gc'd?+    KCVISREMOVE -> kcVISREMOVE++type KCVISITFULL =+  CString -> CSize -> CString -> CSize -> Ptr CSize -> Ptr () -> IO CString++foreign import ccall "wrapper" wrapKCVISITFULL+  :: KCVISITFULL -> IO (FunPtr KCVISITFULL)++-- | Type of a visitor function when key-value is absent.+type KcVisitEmpty = BS.ByteString -> IO KcVisitAction++callVisitEmpty :: KcVisitEmpty -> KCVISITEMPTY+callVisitEmpty visitEmpty kbuf ksiz sp _ = do+  key <- BS.unsafePackCStringLen (kbuf, fromIntegral ksiz)+  rv <- visitEmpty key+  case rv of+    KCVISNOP -> kcVISNOP+    KCVISSET newVal ->+      BS.unsafeUseAsCStringLen newVal $ \(cstr, clen) -> do+        poke sp (fromIntegral clen)+        return cstr -- XXX what if newVal is gc'd?+    KCVISREMOVE -> kcVISREMOVE++type KCVISITEMPTY = CString -> CSize -> Ptr CSize -> Ptr () -> IO CString++foreign import ccall "wrapper" wrapKCVISITEMPTY+  :: KCVISITEMPTY -> IO (FunPtr KCVISITEMPTY)++-- | Type of a database synchronization callback.+type KcFileProc = FilePath -> Int64 -> Int64 -> IO Bool++callFileProc :: KcFileProc -> KCFILEPROC+callFileProc fileProc path count size _ = do+  filePath <- peekCAString path+  rv <- fileProc filePath (fromIntegral count) (fromIntegral size)+  if rv then return 1 else return 0++type KCFILEPROC = CString -> CLLong -> CLLong -> Ptr () -> IO CInt++foreign import ccall "wrapper" wrapKCFILEPROC+  :: KCFILEPROC -> IO (FunPtr KCFILEPROC)++int64_min :: CLLong+int64_min = #const INT64_MIN++--------------------------------------------------------------------------------+-- Utilities++-- | Allocate a region on memory.+kcmalloc :: Int -> IO (Ptr a)+kcmalloc sz = _kcmalloc (fromIntegral sz)++foreign import ccall safe "kclangc.h kcmalloc" _kcmalloc+  :: CSize -> IO (Ptr a)++-- | Release a region allocated in the library.+foreign import ccall safe "kclangc.h kcfree" kcfree+  :: Ptr a -> IO ()++-- | Get the time of day in seconds.+kctime :: IO Double+kctime = _kctime >>= return . realToFrac++foreign import ccall safe "kclangc.h kctime" _kctime+  :: IO CDouble++-- | Convert a string to an integer.+kcatoi :: String -> IO Int64+kcatoi str =+  withCAString str $ \cstr ->+  _kcatoi cstr >>= return . fromIntegral++foreign import ccall unsafe "kclangc.h kcatoi" _kcatoi+  :: CString -> IO CLLong++-- | Convert a string with a metric prefix to an integer.+kcatoix :: String -> IO Int64+kcatoix str =+  withCAString str $ \cstr ->+  _kcatoix cstr >>= return . fromIntegral++foreign import ccall unsafe "kclangc.h kcatoix" _kcatoix+  :: CString -> IO CLLong++-- | Convert a string to a real number.+kcatof :: String -> IO Double+kcatof str =+  withCAString str $ \cstr ->+  _kcatof cstr >>= return . realToFrac++foreign import ccall unsafe "kclangc.h kcatof" _kcatof+  :: CString -> IO CDouble++-- | Get the hash value by MurMur hashing.+kchashmurmur :: BS.ByteString -> IO Int64+kchashmurmur buff =+  BS.unsafeUseAsCStringLen buff $ \(b, n) ->+    _kchashmurmur b (fromIntegral n) >>= return . fromIntegral++foreign import ccall unsafe "kclangc.h kchashmurmur" _kchashmurmur+  :: CString -> CSize -> IO CLLong++-- | Get the hash value by FNV hashing.+kchashfnv :: BS.ByteString -> IO Int64+kchashfnv buff =+  BS.unsafeUseAsCStringLen buff $ \(b, n) ->+    _kchashfnv b (fromIntegral n) >>= return . fromIntegral++foreign import ccall unsafe "kclangc.h kchashfnv" _kchashfnv+  :: CString -> CSize -> IO CLLong++-- | Get the quiet Not-a-Number value.+kcnan :: IO Double+kcnan = _kcnan >>= return . realToFrac++foreign import ccall unsafe "kclangc.h kcnan" _kcnan+  :: IO CDouble++-- | Get the positive infinity value.+kcinf :: IO Double+kcinf = _kcinf >>= return . realToFrac++foreign import ccall unsafe "kclangc.h kcinf" _kcinf+  :: IO CDouble++-- | Check a number is a Not-a-Number value.+kcchknan :: Double -> IO Bool+kcchknan num = do rv <- _kcchknan (realToFrac num)+                  if rv == 0 then return False else return True++foreign import ccall unsafe "kclangc.h kcchknan" _kcchknan+  :: CDouble -> IO CInt++-- | Check a number is an infinity value.+kcchkinf :: Double -> IO Bool+kcchkinf num = do rv <- _kcchkinf (realToFrac num)+                  if rv == 0 then return False else return True++foreign import ccall unsafe "kclangc.h kcchkinf" _kcchkinf+  :: CDouble -> IO CInt++-- | Get the readable string of an error code.+kcecodename :: Int -> IO String+kcecodename code = do rv <- _kcecodename (fromIntegral code); peekCAString rv++foreign import ccall unsafe "kclangc.h kcecodename" _kcecodename+  :: CInt -> IO CString++--------------------------------------------------------------------------------++-- | An exception indicating an error in a KC operation.+data KcException = KcException String KcError String+    deriving (Eq, Show, Typeable)++instance Exception KcException++kcThrow :: KcDb -> String -> IO a+kcThrow db fname = do+  err <- kcdbecode db+  msg <- kcdbemsg db+  throwIO $ KcException fname err msg++handleBoolResult :: KcDb -> String -> CInt -> IO ()+handleBoolResult db fname status =+  if status == 0 then kcThrow db fname else return ()++--------------------------------------------------------------------------------++-- | Polymorphic database.+newtype KcDb = KcDb { unKcDb :: ForeignPtr KCDB }+data KCDB      -- native type++-- | Create a polymorphic database object.+kcdbnew :: IO KcDb+kcdbnew = _kcdbnew >>= wrapdb++wrapdb :: Ptr KCDB -> IO KcDb+wrapdb db = do+  fp <- newForeignPtr_ db+  --addForeignPtrFinalizer _kcdbdelFunPtr fp+  return $ KcDb fp++foreign import ccall safe "kclangc.h kcdbnew" _kcdbnew+  :: IO (Ptr KCDB)++foreign import ccall safe "kclangc.h &kcdbdel" _kcdbdelFunPtr+  :: FunPtr (Ptr KCDB -> IO ())++-- | Destroy a database object.+kcdbdel :: KcDb -> IO ()+kcdbdel db = do withForeignPtr (unKcDb db) _kcdbdel; return ()++foreign import ccall safe "kclangc.h kcdbdel" _kcdbdel+  :: Ptr KCDB -> IO ()++-- | Tuning parameters for database creation.+data KcTune = KcTuneType KcTuneType+            | KcTuneLogger KcLogger+            | KcTuneLogKinds KcLogLevel+            | KcTuneLogPx String+            | KcTuneOptions [KcOption] -- ^ supported by: cache hash, cache tree, file hash, file tree, directory hash, directory tree+            | KcTuneBuckets Int -- ^ supported by: cache hash, cache tree, file hash, file tree+            | KcTuneCompressor KcCompressor -- ^ supported by: cache hash, cache tree, file hash, file tree, directory hash, directory tree+            | KcTuneZkey String -- ^ supported by: cache hash, cache tree, file hash, file tree, directory hash, directory tree+            | KcTuneCapCount Int -- ^ supported by: cache hash+            | KcTuneCapSize Int -- ^ supported by: cache hash+            | KcTunePage Int -- ^ supported by: cache tree, file tree, directory tree+            | KcTuneComparator KcComparator -- ^ supported by: cache tree, file tree, directory tree+            | KcTunePageCache Int -- ^ supported by: cache tree, file tree, directory tree+            | KcTuneAlignment Int -- ^ supported by: file hash, file tree+            | KcTuneFbp Int -- ^ supported by: file hash, file tree+            | KcTuneMap Int -- ^ supported by: file hash, file tree+            | KcTuneDefrag Int -- ^ supported by: file hash, file tree+data KcTuneType = KcTypePrototypeHashDb | KcTypePrototypeTreeDb+                | KcTypeCacheHashDb | KcTypeCacheTreeDb+                | KcTypeFileHashDb | KcTypeFileTreeDb+                | KcTypeDirectoryHashDb | KcTypeDirectoryTreeDb+data KcLogger = KcLoggerStdout | KcLoggerStderr+data KcLogLevel = KcLogDebug | KcLogInfo | KcLogWarn | KcLogError+data KcOption = KcOptionSmall | KcOptionLinear | KcOptionCompress+data KcCompressor = KcCompressorZlib | KcCompressorDeflate+                      | KcCompressorGzip | KcCompressorLzo+                      | KcCompressorLzma | KcCompressorArc+data KcComparator = KcComparatorLexical | KcComparatorDecimal++instance Show KcTune where+  show (KcTuneType t) = "type=" ++ show t+  show (KcTuneLogger l) = "log=" ++ show l+  show (KcTuneLogKinds l) = "logkinds=" ++ show l+  show (KcTuneLogPx s) = "logpx=" ++ s+  show (KcTuneOptions opts) = "opts=" ++ foldr (\o r -> show o ++ r) "" opts+  show (KcTuneBuckets n) = "bnum=" ++ show n+  show (KcTuneCompressor c) = "zcomp=" ++ show c+  show (KcTuneZkey s) = "zkey=" ++ show s+  show (KcTuneCapCount c) = "capcount=" ++ show c+  show (KcTuneCapSize n) = "capsize=" ++ show n+  show (KcTunePage n) = "psiz=" ++ show n+  show (KcTuneComparator c) = "rcomp=" ++ show c+  show (KcTunePageCache n) = "pccap=" ++ show n+  show (KcTuneAlignment n) = "apow=" ++ show n+  show (KcTuneFbp n) = "fpow=" ++ show n+  show (KcTuneMap n) = "msiz=" ++ show n+  show (KcTuneDefrag n) = "dfunit=" ++ show n++instance Show KcTuneType where+  show KcTypePrototypeHashDb = "-"+  show KcTypePrototypeTreeDb = "+"+  show KcTypeCacheHashDb = "*"+  show KcTypeCacheTreeDb = "%"+  show KcTypeFileHashDb = "kch"+  show KcTypeFileTreeDb = "kct"+  show KcTypeDirectoryHashDb = "kcd"+  show KcTypeDirectoryTreeDb = "kcf"++instance Show KcLogger where+  show KcLoggerStdout = "-"+  show KcLoggerStderr = "+"++instance Show KcLogLevel where+  show KcLogDebug = "debug"+  show KcLogInfo = "info"+  show KcLogWarn = "warn"+  show KcLogError = "error"++instance Show KcOption where+  show KcOptionSmall = "s"+  show KcOptionLinear = "l"+  show KcOptionCompress = "c"++instance Show KcCompressor where+  show KcCompressorZlib = "zlib"+  show KcCompressorDeflate = "def"+  show KcCompressorGzip = "gz"+  show KcCompressorLzo = "lzo"+  show KcCompressorLzma = "lzma"+  show KcCompressorArc = "arc"++instance Show KcComparator where+  show KcComparatorLexical = "lex"+  show KcComparatorDecimal = "dec"++-- | Open a database file.+kcdbopen ::+  KcDb+  -- ^ @db@ - a database object.+  -> String+  -- ^ @path@ - the path of a database file.+  --+  -- * If it is @-@, the database will be a prototype hash database.+  --+  -- * If it is @+@, the database will be a prototype tree database.+  --+  -- * If it is @*@, the database will be a cache hash database.+  --+  -- * If it is @%@, the database will be a cache tree database.+  --+  -- * If its suffix is @.kch@, the database will be a file hash database.+  --+  -- * If its suffix is @.kct@, the database will be a file tree database.+  --+  -- * If its suffix is @.kcd@, the database will be a directory hash database.+  --+  -- * If its suffix is @.kcf@, the database will be a directory tree database.+  --+  -- * Otherwise, this function fails.+  -> [KcTune]+  -- ^ @tune@ - tuning parameters.+  -> [KcOpenMode]+  -- ^ @mode@ - the connection mode flags.+  -- 'KCOWRITER' as a writer, 'KCOREADER' as a reader.+  -- The following flags may be added to the writer mode:+  --+  -- * 'KCOCREATE', which means it creates a new database if the file+  -- does not exist,+  --+  -- * 'KCOTRUNCATE', which means it creates a new database regardless+  -- if the file exists,+  --+  -- * 'KCOAUTOTRAN', which means each updating operation is performed+  -- in implicit transaction,+  --+  -- * 'KCOAUTOSYNC', which means each updating operation is followed+  -- by implicit synchronization with the file system.+  --+  -- The following flags may be added to both of the reader mode and the writer mode:+  --+  -- * 'KCONOLOCK', which means it opens the database file without file locking,+  --+  -- * 'KCOTRYLOCK', which means locking is performed without blocking,+  --+  -- * 'KCONOREPAIR', which means the database file is not repaired+  -- implicitly even if file destruction is detected.+  -> IO ()+  -- ^ Returns @()@ on success, throws 'KcException' on failure.+  --+  -- Every opened database must be closed by the 'kcdbclose' method+  -- when it is no longer in use.  It is not allowed for two or more+  -- database objects in the same process to keep their connections to+  -- the same database file at the same time.+kcdbopen db path tune mode =+  let tunePath = foldl (\prev t -> prev ++ "#" ++ show t) path tune in+  withForeignPtr (unKcDb db) $ \c_db ->+    withCAString tunePath $ \c_path ->+      _kcdbopen c_db c_path (numOfOpenModes mode) >>= handleBoolResult db "kcdbopen"++foreign import ccall safe "kclangc.h kcdbopen" _kcdbopen+  :: Ptr KCDB -> CString -> CUInt -> IO CInt++-- | Close the database file.+kcdbclose :: KcDb -> IO ()+kcdbclose db =+  withForeignPtr (unKcDb db) $ \c_db -> do+    _kcdbclose c_db >>= handleBoolResult db "kcdbclose"++foreign import ccall safe "kclangc.h kcdbclose" _kcdbclose+  :: Ptr KCDB -> IO CInt++-- | Get the code of the last happened error.+kcdbecode :: KcDb -> IO KcError+kcdbecode db =+  withForeignPtr (unKcDb db) $ \c_db -> do+    code <- _kcdbecode c_db+    return $ kcErrorOfNum code++foreign import ccall unsafe "kclangc.h kcdbecode" _kcdbecode+  :: Ptr KCDB -> IO CInt++-- | Get the supplement message of the last happened error.+kcdbemsg :: KcDb -> IO String+kcdbemsg db =+  withForeignPtr (unKcDb db) $ \c_db -> do+    msg <- _kcdbemsg c_db+    peekCAString msg++foreign import ccall unsafe "kclangc.h kcdbemsg" _kcdbemsg+  :: Ptr KCDB -> IO CString++-- | Accept a visitor to a record.+kcdbaccept :: KcDb+           -> BS.ByteString -- ^ key+           -> KcVisitFull -> KcVisitEmpty+           -> Bool -- ^ writable+           -> IO ()+kcdbaccept db key visitFull visitEmpty writable =+  withForeignPtr (unKcDb db) $ \c_db -> do+    BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) -> do+      vf <- wrapKCVISITFULL $ callVisitFull visitFull+      ve <- wrapKCVISITEMPTY $ callVisitEmpty visitEmpty+      rv <- _kcdbaccept c_db kbuf (fromIntegral ksiz) vf ve+              nullPtr (if writable then 1 else 0)+      freeHaskellFunPtr ve+      freeHaskellFunPtr vf+      handleBoolResult db "kcdbaccept" rv++foreign import ccall safe "kclangc.h kcdbaccept" _kcdbaccept+  :: Ptr KCDB -> CString -> CSize -> FunPtr KCVISITFULL -> FunPtr KCVISITEMPTY ->+     Ptr () -> CInt -> IO CInt++-- | Accept a visitor to multiple records at once.+kcdbacceptbulk :: KcDb+               -> [BS.ByteString] -- ^ keys+               -> KcVisitFull -> KcVisitEmpty+               -> Bool -- ^ writable+               -> IO ()+kcdbacceptbulk db keys visitFull visitEmpty writable = do+  withForeignPtr (unKcDb db) $ \c_db -> do+    let nkeys = length keys+    withKcStrArray keys $ \keyArr -> do+      vf <- wrapKCVISITFULL $ callVisitFull visitFull+      ve <- wrapKCVISITEMPTY $ callVisitEmpty visitEmpty+      rv <- _kcdbacceptbulk c_db keyArr (fromIntegral nkeys) vf ve+              nullPtr (if writable then 1 else 0)+      freeHaskellFunPtr ve+      freeHaskellFunPtr vf+      handleBoolResult db "kcdbacceptbulk" rv++foreign import ccall safe "kclangc.h kcdbacceptbulk" _kcdbacceptbulk+  :: Ptr KCDB -> Ptr KcStr -> CSize -> FunPtr KCVISITFULL -> FunPtr KCVISITEMPTY ->+     Ptr () -> CInt -> IO CInt++-- | Iterate to accept a visitor for each record.+kcdbiterate :: KcDb -> KcVisitFull+               -> Bool -- ^ writable+               -> IO ()+kcdbiterate db visitFull writable = do+  withForeignPtr (unKcDb db) $ \c_db -> do+    vf <- wrapKCVISITFULL $ callVisitFull visitFull+    rv <- _kcdbiterate c_db vf nullPtr (if writable then 1 else 0)+    freeHaskellFunPtr vf+    handleBoolResult db "kcdbiterate" rv++foreign import ccall safe "kclangc.h kcdbiterate" _kcdbiterate+  :: Ptr KCDB -> FunPtr KCVISITFULL -> Ptr () -> CInt -> IO CInt++-- | Set the value of a record.+kcdbset :: KcDb+        -> BS.ByteString -- ^ key+        -> BS.ByteString -- ^ value+        -> IO ()+kcdbset db key val =+  withForeignPtr (unKcDb db) $ \c_db -> do+    BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) ->+      BS.unsafeUseAsCStringLen val $ \(vbuf, vsiz) -> do+        _kcdbset c_db kbuf (fromIntegral ksiz) vbuf (fromIntegral vsiz)+        >>= handleBoolResult db "kcdbset"++foreign import ccall safe "kclangc.h kcdbset" _kcdbset+  :: Ptr KCDB -> CString -> CSize -> CString -> CSize -> IO CInt++-- | Add a record.+kcdbadd :: KcDb+        -> BS.ByteString -- ^ key+        -> BS.ByteString -- ^ value+        -> IO ()+kcdbadd db key val =+  withForeignPtr (unKcDb db) $ \c_db -> do+    BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) ->+      BS.unsafeUseAsCStringLen val $ \(vbuf, vsiz) -> do+        _kcdbadd c_db kbuf (fromIntegral ksiz) vbuf (fromIntegral vsiz)+        >>= handleBoolResult db "kcdbadd"++foreign import ccall safe "kclangc.h kcdbadd" _kcdbadd+  :: Ptr KCDB -> CString -> CSize -> CString -> CSize -> IO CInt++-- | Replace the value of a record.+kcdbreplace :: KcDb+            -> BS.ByteString -- ^ key+            -> BS.ByteString -- ^ value+            -> IO ()+kcdbreplace db key val =+  withForeignPtr (unKcDb db) $ \c_db -> do+    BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) ->+      BS.unsafeUseAsCStringLen val $ \(vbuf, vsiz) ->+        _kcdbreplace c_db kbuf (fromIntegral ksiz) vbuf (fromIntegral vsiz)+        >>= handleBoolResult db "kcdbreplace"++foreign import ccall safe "kclangc.h kcdbreplace" _kcdbreplace+  :: Ptr KCDB -> CString -> CSize -> CString -> CSize -> IO CInt++-- | Append the value of a record.+kcdbappend :: KcDb+           -> BS.ByteString -- ^ key+           -> BS.ByteString -- ^ value+           -> IO ()+kcdbappend db key val =+  withForeignPtr (unKcDb db) $ \c_db -> do+    BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) ->+      BS.unsafeUseAsCStringLen val $ \(vbuf, vsiz) ->+        _kcdbappend c_db kbuf (fromIntegral ksiz) vbuf (fromIntegral vsiz)+        >>= handleBoolResult db "kcdbappend"++foreign import ccall safe "kclangc.h kcdbappend" _kcdbappend+  :: Ptr KCDB -> CString -> CSize -> CString -> CSize -> IO CInt++-- | Add a number to the numeric value of a record.+kcdbincrint :: KcDb+            -> BS.ByteString -- ^ key+            -> Int64 -- ^ increment amount+            -> IO Int64+kcdbincrint db key num =+  withForeignPtr (unKcDb db) $ \c_db -> do+    BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) -> do+      rv <- _kcdbincrint c_db kbuf (fromIntegral ksiz) (fromIntegral num)+      if rv == int64_min then kcThrow db "kcdbincrint"+        else return (fromIntegral rv)++foreign import ccall safe "kclangc.h kcdbincrint" _kcdbincrint+  :: Ptr KCDB -> CString -> CSize -> CLLong -> IO CLLong++-- | Add a number to the numeric value of a record.+kcdbincrdouble :: KcDb+               -> BS.ByteString -- ^ key+               -> Double -- ^ increment amount+               -> IO Double+kcdbincrdouble db key num =+  withForeignPtr (unKcDb db) $ \c_db -> do+    BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) -> do+      rv <- _kcdbincrdouble c_db kbuf (fromIntegral ksiz) (realToFrac num)+      nan <- _kcnan+      if rv == nan then kcThrow db "kcdbincrdouble"+        else return (realToFrac rv)++foreign import ccall safe "kclangc.h kcdbincrdouble" _kcdbincrdouble+  :: Ptr KCDB -> CString -> CSize -> CDouble -> IO CDouble++-- | Perform compare-and-swap.+kcdbcas :: KcDb+        -> BS.ByteString -- ^ key+        -> BS.ByteString -- ^ old value+        -> BS.ByteString -- ^ new value+        -> IO ()+kcdbcas db key nv ov =+  withForeignPtr (unKcDb db) $ \c_db -> do+    BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) -> do+      BS.unsafeUseAsCStringLen nv $ \(nvbuf, nvsiz) -> do+        BS.unsafeUseAsCStringLen ov $ \(ovbuf, ovsiz) -> do+          _kcdbcas c_db kbuf (fromIntegral ksiz) nvbuf (fromIntegral nvsiz)+            ovbuf (fromIntegral ovsiz)+          >>= handleBoolResult db "kcdbcas"++foreign import ccall safe "kclangc.h kcdbcas" _kcdbcas+  :: Ptr KCDB -> CString -> CSize -> CString -> CSize ->+     CString -> CSize -> IO CInt++-- | Remove a record.+kcdbremove :: KcDb+           -> BS.ByteString -- ^ key+           -> IO ()+kcdbremove db key =+  withForeignPtr (unKcDb db) $ \c_db -> do+    BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) -> do+      _kcdbremove c_db kbuf (fromIntegral ksiz) >>= handleBoolResult db "kcdbremove"++foreign import ccall safe "kclangc.h kcdbremove" _kcdbremove+  :: Ptr KCDB -> CString -> CSize -> IO CInt++-- | Retrieve the value of a record.+kcdbget :: KcDb+        -> BS.ByteString -- ^ key+        -> IO (Maybe BS.ByteString)+kcdbget db key =+  withForeignPtr (unKcDb db) $ \c_db -> do+    BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) -> do+      alloca $ \ptr -> do+        cstr <- _kcdbget c_db kbuf (fromIntegral ksiz) ptr+        if cstr == nullPtr then return Nothing+          else do+          csiz <- peek ptr+          bs <- BS.unsafePackCStringFinalizer (castPtr cstr) (fromIntegral csiz)+                  (kcfree cstr)+          return $ Just bs++foreign import ccall safe "kclangc.h kcdbget" _kcdbget+  :: Ptr KCDB -> CString -> CSize -> Ptr CSize -> IO CString++-- | Retrieve the value of a record.+kcdbgetbuf :: KcDb+           -> BS.ByteString -- ^ key+           -> Int -- ^ max chars to retrieve+           -> IO (Maybe BS.ByteString)+kcdbgetbuf db key maxElts =+  withForeignPtr (unKcDb db) $ \c_db -> do+    BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) -> do+      vbuf <- mallocArray maxElts+      n <- _kcdbgetbuf c_db kbuf (fromIntegral ksiz) vbuf (fromIntegral maxElts)+      if n == -1 then return Nothing+        else do+          bs <- BS.unsafePackCStringFinalizer (castPtr vbuf) (fromIntegral n)+                  (kcfree vbuf)+          return $ Just bs++foreign import ccall safe "kclangc.h kcdbgetbuf" _kcdbgetbuf+  :: Ptr KCDB -> CString -> CSize -> CString -> CSize -> IO CInt++-- | Store records at once.+kcdbsetbulk :: KcDb+            -> [(BS.ByteString, BS.ByteString)] -- ^ records to store+            -> Bool  -- ^ atomic+            -> IO Int64 -- ^ returns number of records stored+kcdbsetbulk db recs atomic =+  withForeignPtr (unKcDb db) $ \c_db -> do+    let nrecs = length recs+    withKcRecArray recs $ \keyArr -> do+      n <- _kcdbsetbulk c_db keyArr (fromIntegral nrecs) (if atomic then 1 else 0)+      if n == -1 then kcThrow db "kcdbsetbulk" else return (fromIntegral n)++foreign import ccall safe "kclangc.h kcdbsetbulk" _kcdbsetbulk+  :: Ptr KCDB -> Ptr KcRec -> CSize -> CInt -> IO CLLong++-- | Remove records at once.+kcdbremovebulk :: KcDb+               -> [BS.ByteString] -- ^ keys of records to remove+               -> Bool -- ^ atomic+               -> IO Int64 -- ^ returns number of records removed+kcdbremovebulk db keys atomic =+  withForeignPtr (unKcDb db) $ \c_db -> do+    let nrecs = length keys+    withKcStrArray keys $ \keyArr -> do+      n <- _kcdbremovebulk c_db keyArr (fromIntegral nrecs) (if atomic then 1 else 0)+      if n == -1 then kcThrow db "kcdbremovebulk" else return (fromIntegral n)++foreign import ccall safe "kclangc.h kcdbremovebulk" _kcdbremovebulk+  :: Ptr KCDB -> Ptr KcStr -> CSize -> CInt -> IO CLLong++-- | Retrieve records at once.+kcdbgetbulk :: KcDb+            -> [BS.ByteString] -- ^ keys of the records to retrieve+            -> Bool -- ^ atomic+            -> IO [(BS.ByteString, BS.ByteString)]+kcdbgetbulk db keys atomic =+  withForeignPtr (unKcDb db) $ \c_db -> do+    let nkeys = length keys+    withKcStrArray keys $ \keyArr -> do+      allocaArray nkeys $ \recArr -> do+        n <- _kcdbgetbulk c_db keyArr (fromIntegral nkeys) recArr+             (if atomic then 1 else 0)+        if n == -1 then kcThrow db "kcdbgetbulk"+          else do+          recList <- peekArray (fromIntegral n) recArr+          return $ map (\(KcRec p) -> p) recList++foreign import ccall safe "kclangc.h kcdbgetbulk" _kcdbgetbulk+  :: Ptr KCDB -> Ptr KcStr -> CSize -> Ptr KcRec -> CInt -> IO CLLong++-- | Remove all records.+kcdbclear :: KcDb -> IO ()+kcdbclear db =+  withForeignPtr (unKcDb db) $ \c_db -> do+    _kcdbclear c_db >>= handleBoolResult db "kcdbclear"++foreign import ccall safe "kclangc.h kcdbclear" _kcdbclear+  :: Ptr KCDB -> IO CInt++-- | Synchronize updated contents with the file and the device.+kcdbsync :: KcDb+         -> Bool -- ^ @True@ for physical synchronization, @False@ for+                 -- logical synchronization+         -> KcFileProc -- ^ postprocessor callback+         -> IO ()+kcdbsync db hard fileProc = do+  withForeignPtr (unKcDb db) $ \c_db -> do+    fp <- wrapKCFILEPROC $ callFileProc fileProc+    rv <- _kcdbsync c_db (if hard then 1 else 0) fp nullPtr+    freeHaskellFunPtr fp+    handleBoolResult db "kcdbsync" rv++foreign import ccall safe "kclangc.h kcdbsync" _kcdbsync+  :: Ptr KCDB -> CInt -> FunPtr KCFILEPROC -> Ptr () -> IO CInt++-- | Create a copy of the database file.+kcdbcopy :: KcDb+         -> FilePath -- ^ path to the destination file+         -> IO ()+kcdbcopy db dest =+  withForeignPtr (unKcDb db) $ \c_db -> do+    withCAString dest $ \c_dest -> do+      _kcdbcopy c_db c_dest >>= handleBoolResult db "kcdbcopy"++foreign import ccall safe "kclangc.h kcdbcopy" _kcdbcopy+  :: Ptr KCDB -> CString -> IO CInt++-- | Begin transaction.+kcdbbegintran :: KcDb+              -> Bool -- ^ @True@ for physical synchronization, @False@+                      -- for logical synchronization+              -> IO ()+kcdbbegintran db hard =+  withForeignPtr (unKcDb db) $ \c_db -> do+    _kcdbbegintran c_db (if hard then 1 else 0)+    >>= handleBoolResult db "kcdbbegintran"++foreign import ccall safe "kclangc.h kcdbbegintran" _kcdbbegintran+  :: Ptr KCDB -> CInt -> IO CInt++-- | Try to begin transaction.+kcdbbegintrantry :: KcDb+                 -> Bool  -- ^ @True@ for physical synchronization,+                          -- @False@ for logical synchronization+                 -> IO ()+kcdbbegintrantry db hard =+  withForeignPtr (unKcDb db) $ \c_db -> do+    _kcdbbegintrantry c_db (if hard then 1 else 0)+    >>= handleBoolResult db "kcdbbegintrantry"++foreign import ccall safe "kclangc.h kcdbbegintrantry" _kcdbbegintrantry+  :: Ptr KCDB -> CInt -> IO CInt++-- | End transaction.+kcdbendtran :: KcDb+            -> Bool  -- ^ @True@ to commit, @False@ to abort+            -> IO ()+kcdbendtran db commit =+  withForeignPtr (unKcDb db) $ \c_db -> do+    _kcdbendtran c_db (if commit then 1 else 0)+    >>= handleBoolResult db "kcdbendtran"++foreign import ccall safe "kclangc.h kcdbendtran" _kcdbendtran+  :: Ptr KCDB -> CInt -> IO CInt++-- | Dump records into a file.+kcdbdumpsnap :: KcDb+             -> FilePath -- ^ destination file+             -> IO ()+kcdbdumpsnap db dest =+  withForeignPtr (unKcDb db) $ \c_db -> do+    withCAString dest $ \c_dest -> do+      _kcdbdumpsnap c_db c_dest >>= handleBoolResult db "kcdbdumpsnap"++foreign import ccall safe "kclangc.h kcdbdumpsnap" _kcdbdumpsnap+  :: Ptr KCDB -> CString -> IO CInt++-- | Load records from a file.+kcdbloadsnap :: KcDb+             -> FilePath -- ^ source file+             -> IO ()+kcdbloadsnap db src =+  withForeignPtr (unKcDb db) $ \c_db -> do+    withCAString src $ \c_src -> do+      _kcdbloadsnap c_db c_src >>= handleBoolResult db "kcdbloadsnap"++foreign import ccall safe "kclangc.h kcdbloadsnap" _kcdbloadsnap+  :: Ptr KCDB -> CString -> IO CInt++-- | Get the number of records.+kcdbcount :: KcDb -> IO Int64+kcdbcount db =+  withForeignPtr (unKcDb db) $ \c_db -> do+    n <- _kcdbcount c_db+    if n == -1 then kcThrow db "kcdbcount" else return (fromIntegral n)++foreign import ccall safe "kclangc.h kcdbcount" _kcdbcount+  :: Ptr KCDB -> IO CLLong++-- | Get the size of the database file.+kcdbsize :: KcDb -> IO Int64+kcdbsize db =+  withForeignPtr (unKcDb db) $ \c_db -> do+    n <- _kcdbsize c_db+    if n == -1 then kcThrow db "kcdbsize" else return (fromIntegral n)++foreign import ccall unsafe "kclangc.h kcdbsize" _kcdbsize+  :: Ptr KCDB -> IO CLLong++-- | Get the path of the database file.+kcdbpath :: KcDb -> IO String+kcdbpath db =+  withForeignPtr (unKcDb db) $ \c_db -> do+    cstr <- _kcdbpath c_db+    if cstr == nullPtr then kcThrow db "kcdbpath"+      else do rv <- peekCAString cstr+              kcfree cstr+              return rv++foreign import ccall safe "kclangc.h kcdbpath" _kcdbpath+  :: Ptr KCDB -> IO CString++-- | Get the miscellaneous status information.+kcdbstatus :: KcDb -> IO String+kcdbstatus db =+  withForeignPtr (unKcDb db) $ \c_db -> do+    cstr <- _kcdbstatus c_db+    if cstr == nullPtr then kcThrow db "kcdbstatus"+      else do rv <- peekCAString cstr+              kcfree cstr+              return rv++foreign import ccall safe "kclangc.h kcdbstatus" _kcdbstatus+  :: Ptr KCDB -> IO CString++-- | Get keys matching a prefix string.+kcdbmatchprefix :: KcDb+                -> BS.ByteString -- ^ prefix+                -> Int -- ^ max elements to return+                -> IO [BS.ByteString]+kcdbmatchprefix db prefix maxElts = do+  withForeignPtr (unKcDb db) $ \c_db -> do+    BS.unsafeUseAsCString prefix $ \pre -> do+      allocaArray maxElts $ \strarr -> do+        n <- _kcdbmatchprefix c_db pre strarr (fromIntegral maxElts)+        if n == -1 then kcThrow db "kcdbmatchprefix"+          else bsListOfCStringArr strarr n++foreign import ccall safe "kclangc.h kcdbmatchprefix" _kcdbmatchprefix+  :: Ptr KCDB -> CString -> Ptr CString -> CSize -> IO CLLong++-- | Get keys matching a regular expression string.+kcdbmatchregex :: KcDb+               -> BS.ByteString -- ^ regexp+               -> Int -- ^ max elements to return+               -> IO [BS.ByteString]+kcdbmatchregex db regexp maxElts = do+  withForeignPtr (unKcDb db) $ \c_db -> do+    BS.unsafeUseAsCString regexp $ \pre -> do+      allocaArray maxElts $ \strarr -> do+        n <- _kcdbmatchregex c_db pre strarr (fromIntegral maxElts)+        if n == -1 then kcThrow db "kcdbmatchregex"+          else bsListOfCStringArr strarr n++foreign import ccall safe "kclangc.h kcdbmatchregex" _kcdbmatchregex+  :: Ptr KCDB -> CString -> Ptr CString -> CSize -> IO CLLong++-- | Merge records from other databases.+kcdbmerge :: KcDb+          -> [KcDb] -- ^ database sources+          -> KcMergeMode -- ^ merge mode:+                         --+                         -- * 'KCMSET' to overwrite the existing value,+                         --+                         -- * 'KCMADD' to keep the existing value,+                         --+                         -- * 'KCMREPLACE' to modify the existing record only,+                         --+                         -- * 'KCMAPPEND' to append the new value.+          -> IO ()+kcdbmerge db srcs mode = do+  withForeignPtr (unKcDb db) $ \c_db -> do+    let elts = length srcs+    allocaArray elts $ \srcarr -> do+      pokeArray srcarr (map (unsafeForeignPtrToPtr . unKcDb) srcs)+      let m = fromIntegral $ numOfKcMergeMode mode+      _kcdbmerge c_db srcarr (fromIntegral elts) m+      >>= handleBoolResult db "kcdbmerge"++foreign import ccall safe "kclangc.h kcdbmerge" _kcdbmerge+  :: Ptr KCDB -> Ptr (Ptr KCDB) -> CSize -> CUInt -> IO CInt++--------------------------------------------------------------------------------+-- Cursors++-- | Polymorphic cursor.+newtype KcCur = KcCur { unKcCur :: ForeignPtr KCCUR } deriving (Eq)+data KCCUR      -- native type++-- | Create a cursor object.+kcdbcursor :: KcDb -> IO KcCur+kcdbcursor db =+  withForeignPtr (unKcDb db) $ \c_db -> do+    cur <- _kcdbcursor c_db+    fp <- newForeignPtr_ cur+    --addForeignPtrFinalizer _kccurdelFunPtr fp+    return $ KcCur fp++foreign import ccall safe "kclangc.h kcdbcursor" _kcdbcursor+  :: Ptr KCDB -> IO (Ptr KCCUR)++foreign import ccall safe "kclangc.h &kccurdel" _kccurdelFunPtr+  :: FunPtr (Ptr KCCUR -> IO ())++-- | Destroy a cursor object.+kccurdel :: KcCur -> IO ()+kccurdel cur =+  withForeignPtr (unKcCur cur) $ \c_cur -> do+    _kccurdel c_cur++foreign import ccall safe "kclangc.h kccurdel" _kccurdel+  :: Ptr KCCUR -> IO ()++-- | Accept a visitor to the current record.+kccuraccept :: KcCur+            -> KcVisitFull+            -> Bool -- ^ writable+            -> Bool -- ^ step+            -> IO ()+kccuraccept cur visitFull writable step = do+  withForeignPtr (unKcCur cur) $ \c_cur -> do+    vf <- wrapKCVISITFULL $ callVisitFull visitFull+    rv <- _kccuraccept c_cur vf nullPtr (if writable then 1 else 0)+            (if step then 1 else 0)+    freeHaskellFunPtr vf+    db <- kccurdb cur+    handleBoolResult db "kccuraccept" rv++foreign import ccall safe "kclangc.h kccuraccept" _kccuraccept+  :: Ptr KCCUR -> FunPtr KCVISITFULL -> Ptr () -> CInt -> CInt -> IO CInt++-- | Remove the current record.+kccurremove :: KcCur -> IO ()+kccurremove cur = do+  withForeignPtr (unKcCur cur) $ \c_cur -> do+    rv <- _kccurremove c_cur+    db <- kccurdb cur+    handleBoolResult db "kccurremove" rv++foreign import ccall safe "kclangc.h kccurremove" _kccurremove+  :: Ptr KCCUR -> IO CInt++-- | Get the key of the current record.+kccurgetkey :: KcCur+            -> Bool -- ^ step+            -> IO BS.ByteString+kccurgetkey cur step = do+  withForeignPtr (unKcCur cur) $ \c_cur -> do+    alloca $ \ptr -> do+      cstr <- _kccurgetkey c_cur ptr (if step then 1 else 0)+      if cstr == nullPtr then kccurdb cur >>= flip kcThrow "kccurgetkey"+        else do+        len <- peek ptr+        BS.unsafePackCStringFinalizer (castPtr cstr) (fromIntegral len) (kcfree cstr)++foreign import ccall safe "kclangc.h kccurgetkey" _kccurgetkey+  :: Ptr KCCUR -> Ptr CSize -> CInt -> IO CString++-- | Get the value of the current record.+kccurgetvalue :: KcCur+              -> Bool -- ^ step+              -> IO BS.ByteString+kccurgetvalue cur step = do+  withForeignPtr (unKcCur cur) $ \c_cur -> do+    alloca $ \ptr -> do+      cstr <- _kccurgetvalue c_cur ptr (if step then 1 else 0)+      if cstr == nullPtr then kccurdb cur >>= flip kcThrow "kccurgetkey"+        else do+        len <- peek ptr+        BS.unsafePackCStringFinalizer (castPtr cstr) (fromIntegral len) (kcfree cstr)++foreign import ccall safe "kclangc.h kccurgetvalue" _kccurgetvalue+  :: Ptr KCCUR -> Ptr CSize -> CInt -> IO CString++-- | Get a pair of the key and the value of the current record.+kccurget :: KcCur+         -> Bool -- ^ step+         -> IO (BS.ByteString, BS.ByteString)+kccurget cur step = do+  withForeignPtr (unKcCur cur) $ \c_cur -> do+    alloca $ \ksp -> do+      alloca $ \vbp -> do+        alloca $ \vsp -> do+          cstr <- _kccurget c_cur ksp vbp vsp (if step then 1 else 0)+          if cstr == nullPtr then kccurdb cur >>= flip kcThrow "kccurget"+            else do+            ks <- peek ksp+            key <- BS.unsafePackCStringFinalizer (castPtr cstr) (fromIntegral ks)+                     (kcfree cstr) -- also frees vp+            vb <- peek vbp+            vs <- peek vsp+            val <- BS.packCStringLen (vb, fromIntegral vs)+            return (key, val)++foreign import ccall safe "kclangc.h kccurget" _kccurget+  :: Ptr KCCUR -> Ptr CSize -> Ptr CString -> Ptr CSize -> CInt ->+     IO CString++-- | Jump the cursor to the first record for forward scan.+kccurjump :: KcCur -> IO ()+kccurjump cur =+  withForeignPtr (unKcCur cur) $ \c_cur -> do+    rv <- _kccurjump c_cur+    db <- kccurdb cur+    handleBoolResult db "kccurjump" rv++foreign import ccall safe "kclangc.h kccurjump" _kccurjump+  :: Ptr KCCUR -> IO CInt++-- | Jump the cursor to a record for forward scan.+kccurjumpkey :: KcCur -> BS.ByteString -> IO ()+kccurjumpkey cur key =+  withForeignPtr (unKcCur cur) $ \c_cur -> do+    BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) -> do+      rv <- _kccurjumpkey c_cur kbuf (fromIntegral ksiz)+      db <- kccurdb cur+      handleBoolResult db "kccurjumpkey" rv++foreign import ccall safe "kclangc.h kccurjumpkey" _kccurjumpkey+  :: Ptr KCCUR -> CString -> CSize -> IO CInt++-- | Jump the cursor to the last record for backward scan.+kccurjumpback :: KcCur -> IO ()+kccurjumpback cur =+  withForeignPtr (unKcCur cur) $ \c_cur -> do+    rv <- _kccurjumpback c_cur+    db <- kccurdb cur+    handleBoolResult db "kccurjumpback" rv++foreign import ccall safe "kclangc.h kccurjumpback" _kccurjumpback+  :: Ptr KCCUR -> IO CInt++-- | Jump the cursor to a record for backward scan.+kccurjumpbackkey :: KcCur -> BS.ByteString -> IO ()+kccurjumpbackkey cur key =+  withForeignPtr (unKcCur cur) $ \c_cur -> do+    BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) -> do+      rv <- _kccurjumpbackkey c_cur kbuf (fromIntegral ksiz)+      db <- kccurdb cur+      handleBoolResult db "kccurjumpbackkey" rv++foreign import ccall safe "kclangc.h kccurjumpbackkey" _kccurjumpbackkey+  :: Ptr KCCUR -> CString -> CSize -> IO CInt++-- | Step the cursor to the next record.+kccurstep :: KcCur -> IO ()+kccurstep cur =+  withForeignPtr (unKcCur cur) $ \c_cur -> do+    rv <- _kccurstep c_cur+    db <- kccurdb cur+    handleBoolResult db "kccurstep" rv++foreign import ccall safe "kclangc.h kccurstep" _kccurstep+  :: Ptr KCCUR -> IO CInt++-- | Step the cursor to the previous record.+kccurstepback :: KcCur -> IO ()+kccurstepback cur =+  withForeignPtr (unKcCur cur) $ \c_cur -> do+    rv <- _kccurstepback c_cur+    db <- kccurdb cur+    handleBoolResult db "kccurstepback" rv++foreign import ccall safe "kclangc.h kccurstepback" _kccurstepback+  :: Ptr KCCUR -> IO CInt++-- | Get the database object.+kccurdb :: KcCur -> IO KcDb+kccurdb cur =+  withForeignPtr (unKcCur cur) $ \c_cur -> do+    _kccurdb c_cur >>= wrapdb++foreign import ccall unsafe "kclangc.h kccurdb" _kccurdb+  :: Ptr KCCUR -> IO (Ptr KCDB)++-- | Get the code of the last happened error.+kccurecode :: KcCur -> IO KcError+kccurecode cur =+  withForeignPtr (unKcCur cur) $ \c_cur -> do+    code <- _kccurecode c_cur+    return $ kcErrorOfNum code++foreign import ccall unsafe "kclangc.h kccurecode" _kccurecode+  :: Ptr KCCUR -> IO CInt++-- | Get the supplement message of the last happened error.+kccuremsg :: KcCur -> IO String+kccuremsg cur =+  withForeignPtr (unKcCur cur) $ \c_cur -> do+    msg <- _kccuremsg c_cur+    peekCAString msg++foreign import ccall unsafe "kclangc.h kccuremsg" _kccuremsg+  :: Ptr KCCUR -> IO CString++--------------------------------------------------------------------------------+-- Helper Routines++-- | Brackets a db command between 'kcdbnew', 'kcdbopen', 'kcdbclose',+-- and 'kcdbdel' calls.+kcwithdbopen :: FilePath -> [KcTune] -> [KcOpenMode] -> (KcDb -> IO a) -> IO a+kcwithdbopen path tune mode action =+  bracket+    (do db <- kcdbnew+        kcdbopen db path tune mode+        return db)+    (\db -> do kcdbclose db+               kcdbdel db)+    action++-- | Brackets a cursor command between 'kcdbcursor' and 'kccurdel' calls.+kcwithdbcursor :: KcDb -> (KcCur -> IO a) -> IO a+kcwithdbcursor db action = bracket (kcdbcursor db) kccurdel action++-- | Brackets a db command between 'kcdbbegintran' and 'kcdbendtran' calls,+-- committing on successful completion of the command, and aborting on+-- exception.+kcwithdbtran :: KcDb+             -> Bool  -- ^ @True@ for physical synchronization,+                      -- @False@ for logical synchronization+             -> IO a  -- ^ db command+             -> IO a+kcwithdbtran db hard action =+  bracketOnError (kcdbbegintran db hard)+                 (const $ kcdbendtran db False)+                 (const $ do rv <- action; kcdbendtran db True; return rv)++--------------------------------------------------------------------------------
+ Database/KyotoCabinet/kc_hs.c view
@@ -0,0 +1,44 @@+/*+Copyright 2011, Google Inc.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+notice, this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above+copyright notice, this list of conditions and the following disclaimer+in the documentation and/or other materials provided with the+distribution.+    * Neither the name of Google Inc. nor the names of its+contributors may be used to endorse or promote products derived from+this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+*/++#include <kclangc.h>++extern const char* const getKCVERSION() {+    return KCVERSION;+}++extern const char* const getKCVISNOP() {+    return KCVISNOP;+}++extern const char* const getKCVISREMOVE() {+    return KCVISREMOVE;+}
+ KyotoCabinet.cabal view
@@ -0,0 +1,54 @@+name: KyotoCabinet+version: 0.1+license: BSD3+license-file: COPYING+cabal-version: >= 1.4+copyright: (c) 2011 Warren Harris, (c) 2011 Google Inc.+author: Warren Harris <warrenharris@google.com>+maintainer: Warren Harris <warrenharris@google.com>+stability: alpha+synopsis: Kyoto Cabinet DB bindings+description:+    Kyoto Cabinet is a library of routines for managing a+    database. The database is a simple data file containing records,+    each is a pair of a key and a value. Every key and value is serial+    bytes with variable length. Both binary data and character string+    can be used as a key and a value. Each key must be unique within a+    database. There is neither concept of data tables nor data+    types. Records are organized in hash table or B+ tree.+    .+    Kyoto Cabinet runs very fast. For example, elapsed time to store+    one million records is 0.9 seconds for hash database, and 1.1+    seconds for B+ tree database. Moreover, the size of database is+    very small. For example, overhead for a record is 16 bytes for+    hash database, and 4 bytes for B+ tree database. Furthermore,+    scalability of Kyoto Cabinet is great. The database size can be up+    to 8EB (9.22e18 bytes).+    .+    Kyoto Cabinet is written in the C++ language, and provided as API+    of C++, C, Java, Python, Ruby, Perl, Lua and Haskell. Kyoto Cabinet is+    available on platforms which have API conforming to C++03 with the+    TR1 library extensions. Kyoto Cabinet is a free software licensed+    under the GNU General Public License. On the other hand, a+    commercial license is also provided. If you use Kyoto Cabinet+    within a proprietary software, the commercial license is required.+    .+    Kyoto Cabinet home page:+    <http://fallabs.com/kyotocabinet/>++category: Database+homepage: https://code.google.com/p/kyotocabinet-hs/+build-type: Simple+extra-source-files:+    examples/kclangcex.hs++Library+    exposed-modules: Database.KyotoCabinet.Db++    build-depends: base >= 3 && < 5,+                   extensible-exceptions,+                   bytestring >= 0.9+    include-dirs:  Database/KyotoCabinet/+    extra-libraries: kyotocabinet+    ghc-options:   -Wall+    c-sources:     Database/KyotoCabinet/kc_hs.c
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple+main = defaultMain+
+ examples/kclangcex.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-+Copyright 2011, Google Inc.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+notice, this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above+copyright notice, this list of conditions and the following disclaimer+in the documentation and/or other materials provided with the+distribution.+    * Neither the name of Google Inc. nor the names of its+contributors may be used to endorse or promote products derived from+this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+-}++module Main where++import Database.KyotoCabinet.Db++import Control.Exception+import qualified Data.ByteString.Char8 as BS+import Prelude hiding (catch)++import System.Mem++visitfull :: KcVisitFull+visitfull key val = do+  putStrLn (BS.unpack key ++ ":" ++ BS.unpack val)+  return KCVISNOP++visitempty :: KcVisitEmpty+visitempty key = do+  putStrLn (BS.unpack key ++ " is missing")+  return $ KCVISNOP+--  let rv = BS.pack ("foo"++"bar")+--  return $ KCVISSET rv++main = do+  -- create and open the database+  kcwithdbopen "casket.kch" [KCOWRITER, KCOCREATE] $ \db -> do++    -- store records+    (do kcdbset db (BS.pack "foo") (BS.pack "hop")+        kcdbset db (BS.pack "bar") (BS.pack "step")+        kcdbset db (BS.pack "baz") (BS.pack "jump")+        kcdbappend db (BS.pack "baz") (BS.pack "run")+        kcdbappend db (BS.pack "baz") (BS.pack "fly"))+      `catch` \(exn::KcException) -> putStrLn ("set error: "++show exn)++    -- retrieve a record+    (do vbuf <- kcdbget db (BS.pack "foo")+        putStrLn (BS.unpack vbuf))+      `catch` \(exn::KcException) -> putStrLn ("get error: "++show exn)++    -- traverse records+    kcwithdbcursor db $ \cur -> do+      kccurjump cur+      let loop = do (key, val) <- kccurget cur True+                    putStrLn (BS.unpack key ++ ":" ++ BS.unpack val)+                    loop+      loop `catch` \(exn::KcException) -> return ()++    -- retrieve a record with visitor+    kcdbaccept db (BS.pack "dummy") visitfull visitempty False+      `catch` \(exn::KcException) ->+        kcdbaccept db (BS.pack "foo") visitfull visitempty False+          `catch` \(exn::KcException) -> putStrLn ("accept error: "++show exn)++    -- traverse records with visitor+    kcdbiterate db visitfull False+      `catch` \(exn::KcException) -> putStrLn ("iterate error: "++show exn)++    (do prefixes <- kcdbmatchprefix db (BS.pack "b") 3+        putStrLn (show prefixes))+      `catch` \(exn::KcException) -> putStrLn ("prefix error: "++show exn)++    (do prefixes <- kcdbmatchregex db (BS.pack ".a.*") 10+        putStrLn (show prefixes))+      `catch` \(exn::KcException) -> putStrLn ("regexp error: "++show exn)++    kcwithlazydbcursorcontext $ \cc -> do+      cur <- kclazydbcursor db cc+      vals <- kclazycurgetvalues cc cur (BS.pack "baz")+      putStrLn (show vals)