pax_global_header00006660000000000000000000000064112607162170014515gustar00rootroot0000000000000052 comment=47068944e24c897c69f1cac533dd9b5a1335c646 tokyocabinet-haskell-0.0.5/000077500000000000000000000000001126071621700156335ustar00rootroot00000000000000tokyocabinet-haskell-0.0.5/Changes000066400000000000000000000003611126071621700171260ustar00rootroot00000000000000Revision history for tokyocabinet-haskell package. 0.0.5 Sat May 09 06:00:00 UTC 2009 - added ADB interface. 0.0.4 Mon Apr 27 14:01:17 UTC 2009 - added TDB and TDBQRY support. 0.0.1 Tue Mar 31 01:32:18 UTC 2009 - initial release tokyocabinet-haskell-0.0.5/Database/000077500000000000000000000000001126071621700173375ustar00rootroot00000000000000tokyocabinet-haskell-0.0.5/Database/TokyoCabinet.hs000066400000000000000000000340051126071621700222700ustar00rootroot00000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Database.TokyoCabinet ( -- $doc TCM , runTCM , OpenMode(..) , TCDB(..) , H.HDB , F.FDB , T.TDB , BDB -- * Error Code , E.ECODE(..) , E.errmsg ) where import Control.Monad.Trans (MonadIO) import Database.TokyoCabinet.Storable import Database.TokyoCabinet.Sequence import Database.TokyoCabinet.FDB.Key (ID, toID) import qualified Database.TokyoCabinet.HDB as H import qualified Database.TokyoCabinet.FDB as F import qualified Database.TokyoCabinet.TDB as T import qualified Database.TokyoCabinet.BDB as B import qualified Database.TokyoCabinet.BDB.Cursor as C import qualified Database.TokyoCabinet.Error as E import Data.Int import Data.Word -- $doc -- Basic Usage (sample code) -- -- @ -- import Database.TokyoCabinet -- import Data.ByteString.Char8 -- @ -- -- @ -- putsample :: String -> [(ByteString, ByteString)] -> TCM Bool -- putsample file kv = -- do tc <- new :: TCM HDB -- alternatively you can use BDB or FDB -- open tc file [OWRITER, OCREAT] -- mapM (uncurry $ put tc) kv -- close tc -- @ -- -- @ -- getsample :: String -> ByteString -> TCM (Maybe ByteString) -- getsample file key = -- do tc <- new :: TCM HDB -- alternatively you can use BDB or FDB -- open tc file [OREADER] -- val <- get tc key -- close tc -- return val -- @ -- -- @ -- main = runTCM (do putsample \"foo.tch\" [(pack \"foo\", pack \"bar\")] -- getsample \"foo.tch\" (pack \"foo\")) >>= -- maybe (return ()) (putStrLn . show) -- @ -- -- | Tokyo Cabinet related computation. Wrap of IO. newtype TCM a = TCM { -- | Unwrap TCM. runTCM :: IO a } deriving (Monad, MonadIO) -- | Represent open mode for `open' function. data OpenMode = OREADER | OWRITER | OCREAT | OTRUNC | ONOLCK | OLCKNB deriving (Eq, Ord, Show) -- | Type class that abstract Tokyo Cabinet database. class TCDB a where -- | Create a database object. new :: TCM a -- | Free object resource forcibly. delete :: a -> TCM () -- | Open a database file. open :: a -- ^ database object -> String -- ^ path to database file -> [OpenMode] -- ^ open mode -> TCM Bool -- ^ if successful, the return value is True -- | Close the database file. If successful, the return value is True close :: a -> TCM Bool -- | Store a record. put :: (Storable k, Storable v) => a -- ^ database object -> k -- ^ key -> v -- ^ value -> TCM Bool -- ^ if successful, the return value is True -- | Store a new recoed. If a record with the same key exists -- in the database, this function has no effect. putkeep :: (Storable k, Storable v) => a -- ^ database object -> k -- ^ key -> v -- ^ value -> TCM Bool -- ^ if successful, the return value is True -- | Concatenate a value at the end of the existing record. putcat :: (Storable k, Storable v) => a -- ^ database object -> k -- ^ key -> v -- ^ value -> TCM Bool -- ^ if successful, the return value is True -- | Retrieve a record. get :: (Storable k, Storable v) => a -- ^ database object -> k -- ^ key -> TCM (Maybe v) -- ^ If successful, the return value is the -- value of the corresponding record wrapped -- by `Just', else, Nothing is returned. -- | Remove a record. out :: (Storable k) => a -- ^ database object -> k -- ^ key -> TCM Bool -- ^ if successful, the return value is True -- | Get the size of the value of a record. vsiz :: (Storable k) => a -- ^ database object -> k -- ^ key -> TCM (Maybe Int) -- ^ If successful, the return value -- is the size of the value of the -- corresponding record wrapped by -- `Just', else, it is Nothing. -- | Initialize the iterator. If successful, the return value is True. iterinit :: a -> TCM Bool -- | Get the next key of the iterator. If successful, the return -- value is the next key wrapped by `Just', else, it is Nothing. iternext :: (Storable v) => a -> TCM (Maybe v) -- | Get forward matching keys. fwmkeys :: (Storable k, Storable v, Sequence q) => a -- ^ database object -> k -- ^ search string -> Int -- ^ the maximum number of keys to be fetched -> TCM (q v) -- ^ result keys -- | Add an integer to a record. addint :: (Storable k) => a -- ^ database object -> k -- ^ key -> Int -- ^ the addtional value -> TCM (Maybe Int) -- ^ If the corresponding record -- exists, the value is treated as an -- integer and is added to. If no -- record corresponds, a new record -- of the additional value is stored. -- | Add a real number to a record. adddouble :: (Storable k) => a -- ^ database object -> k -- ^ key -> Double -- ^ the additional value -> TCM (Maybe Double) -- ^ If the corresponding record -- exists, the value is treated as -- a real number and is added -- to. If no record corresponds, a -- new record of the additional -- value is stored. -- | Synchronize updated contents with the file and the device. -- If successful, the return value is True. sync :: a -> TCM Bool -- | Remove all records. If successful, the return value is True. vanish :: a -> TCM Bool -- | Copy the database file. copy :: a -- ^ database object -> String -- ^ path of the destination file -> TCM Bool -- ^ If successful, the return value is True. -- | Get the path of the database file. path :: a -> TCM (Maybe String) -- | Get the number of records. rnum :: a -> TCM Word64 -- | Get the size of the database file. size :: a -> TCM Word64 -- | Get the last happened error code. ecode :: a -> TCM E.ECODE -- | Get the default extension for specified database object. defaultExtension :: a -> String openModeToHOpenMode :: OpenMode -> H.OpenMode openModeToHOpenMode OREADER = H.OREADER openModeToHOpenMode OWRITER = H.OWRITER openModeToHOpenMode OCREAT = H.OCREAT openModeToHOpenMode OTRUNC = H.OTRUNC openModeToHOpenMode ONOLCK = H.ONOLCK openModeToHOpenMode OLCKNB = H.OLCKNB lift :: (a -> IO b) -> a -> TCM b lift = (TCM .) lift2 :: (a -> b -> IO c) -> a -> b -> TCM c lift2 f x y = TCM $ f x y lift3 :: (a -> b -> c -> IO d) -> a -> b -> c -> TCM d lift3 f x y z = TCM $ f x y z instance TCDB H.HDB where new = TCM H.new delete = lift H.delete open tc name mode = TCM $ H.open tc name (map openModeToHOpenMode mode) close = lift H.close put = lift3 H.put putkeep = lift3 H.putkeep putcat = lift3 H.putcat get = lift2 H.get out = lift2 H.out vsiz = lift2 H.vsiz iterinit = lift H.iterinit iternext = lift H.iternext fwmkeys = lift3 H.fwmkeys addint = lift3 H.addint adddouble = lift3 H.adddouble sync = lift H.sync vanish = lift H.vanish copy = lift2 H.copy path = lift H.path rnum = lift H.rnum size = lift H.fsiz ecode = lift H.ecode defaultExtension = const ".tch" openModeToBOpenMode :: OpenMode -> B.OpenMode openModeToBOpenMode OREADER = B.OREADER openModeToBOpenMode OWRITER = B.OWRITER openModeToBOpenMode OCREAT = B.OCREAT openModeToBOpenMode OTRUNC = B.OTRUNC openModeToBOpenMode ONOLCK = B.ONOLCK openModeToBOpenMode OLCKNB = B.OLCKNB data BDB = BDB { unTCBDB :: B.BDB , unTCBDBCUR :: C.BDBCUR } liftB :: (B.BDB -> IO a) -> BDB -> TCM a liftB f x = TCM $ f (unTCBDB x) liftB2 :: (B.BDB -> a -> IO b) -> BDB -> a -> TCM b liftB2 f x y = TCM $ f (unTCBDB x) y liftB3 :: (B.BDB -> a -> b -> IO c) -> BDB -> a -> b -> TCM c liftB3 f x y z = TCM $ f (unTCBDB x) y z instance TCDB BDB where new = TCM $ do bdb <- B.new cur <- C.new bdb return $ BDB bdb cur delete = liftB B.delete open tc name mode = TCM $ B.open (unTCBDB tc) name (map openModeToBOpenMode mode) close = liftB B.close put = liftB3 B.put putkeep = liftB3 B.putkeep putcat = liftB3 B.putcat get = liftB2 B.get out = liftB2 B.out vsiz = liftB2 B.vsiz iterinit bdb = TCM $ C.first (unTCBDBCUR bdb) iternext bdb = TCM $ do k <- C.key (unTCBDBCUR bdb) C.next (unTCBDBCUR bdb) return k fwmkeys = liftB3 B.fwmkeys addint = liftB3 B.addint adddouble = liftB3 B.adddouble sync = liftB B.sync vanish = liftB B.vanish copy = liftB2 B.copy path = liftB B.path rnum = liftB B.rnum size = liftB B.fsiz ecode = liftB B.ecode defaultExtension = const ".tcb" instance TCDB B.BDB where new = TCM B.new delete = lift B.delete open tc name mode = TCM $ B.open tc name (map openModeToBOpenMode mode) close = lift B.close put = lift3 B.put putkeep = lift3 B.putkeep putcat = lift3 B.putcat get = lift2 B.get out = lift2 B.out vsiz = lift2 B.vsiz iterinit = undefined iternext = undefined fwmkeys = lift3 B.fwmkeys addint = lift3 B.addint adddouble = lift3 B.adddouble sync = lift B.sync vanish = lift B.vanish copy = lift2 B.copy path = lift B.path rnum = lift B.rnum size = lift B.fsiz ecode = lift B.ecode defaultExtension = const ".tcb" openModeToFOpenMode :: OpenMode -> F.OpenMode openModeToFOpenMode OREADER = F.OREADER openModeToFOpenMode OWRITER = F.OWRITER openModeToFOpenMode OCREAT = F.OCREAT openModeToFOpenMode OTRUNC = F.OTRUNC openModeToFOpenMode ONOLCK = F.ONOLCK openModeToFOpenMode OLCKNB = F.OLCKNB storableToKey :: (Storable a) => a -> ID storableToKey = toID . toInt64 liftF2 :: (Storable b) => (a -> ID -> IO c) -> a -> b -> TCM c liftF2 f x y = TCM $ f x (storableToKey y) liftF3 :: (Storable b) => (a -> ID -> c -> IO d) -> a -> b -> c -> TCM d liftF3 f x y z = TCM $ f x (storableToKey y) z keyToStorable :: (Storable a) => String -> a keyToStorable = fromString instance TCDB F.FDB where new = TCM F.new delete = lift F.delete open tc name mode = TCM $ F.open tc name (map openModeToFOpenMode mode) close = lift F.close put = liftF3 F.put putkeep = liftF3 F.putkeep putcat = liftF3 F.putcat get = liftF2 F.get out = liftF2 F.out vsiz = liftF2 F.vsiz iterinit = lift F.iterinit iternext tc = TCM $ do key <- F.iternext tc case key of Nothing -> return Nothing Just x -> return $ Just (keyToStorable x) fwmkeys = lift3 F.fwmkeys addint = liftF3 F.addint adddouble = liftF3 F.adddouble sync = lift F.sync vanish = lift F.vanish copy = lift2 F.copy path = lift F.path rnum = lift F.rnum size = lift F.fsiz ecode = lift F.ecode defaultExtension = const ".tcf" openModeToTOpenMode :: OpenMode -> T.OpenMode openModeToTOpenMode OREADER = T.OREADER openModeToTOpenMode OWRITER = T.OWRITER openModeToTOpenMode OCREAT = T.OCREAT openModeToTOpenMode OTRUNC = T.OTRUNC openModeToTOpenMode ONOLCK = T.ONOLCK openModeToTOpenMode OLCKNB = T.OLCKNB instance TCDB T.TDB where new = TCM T.new delete = lift T.delete open tc name mode = TCM $ T.open tc name (map openModeToTOpenMode mode) close = lift T.close put = lift3 T.put' putkeep = lift3 T.putkeep' putcat = lift3 T.putcat' get = lift2 T.get' out = lift2 T.out vsiz = lift2 T.vsiz iterinit = lift T.iterinit iternext = lift T.iternext fwmkeys = lift3 T.fwmkeys addint = lift3 T.addint adddouble = lift3 T.adddouble sync = lift T.sync vanish = lift T.vanish copy = lift2 T.copy path = lift T.path rnum = lift T.rnum size = lift T.fsiz ecode = lift T.ecode defaultExtension = const ".tct" tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/000077500000000000000000000000001126071621700217325ustar00rootroot00000000000000tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/ADB.hs000066400000000000000000000151721126071621700226620ustar00rootroot00000000000000-- | Interface to TC's Abstract DataBase. See also, -- for details module Database.TokyoCabinet.ADB ( -- $doc ADB , ECODE(..) , new , delete , open , close , put , putkeep , putcat , out , get , vsiz , iterinit , iternext , fwmkeys , addint , adddouble , sync , optimize , vanish , copy , tranbegin , trancommit , tranabort , path , rnum , size , misc ) where import Data.Word import Foreign.C.String import Foreign.ForeignPtr import Database.TokyoCabinet.ADB.C import Database.TokyoCabinet.Error import Database.TokyoCabinet.Internal import Database.TokyoCabinet.Storable import Database.TokyoCabinet.Sequence -- $doc -- Example -- -- @ -- import Control.Monad -- import Database.TokyoCabinet.ADB -- @ -- -- @ -- main = do adb <- new -- -- open the abstract database object -- -- \"+\" means that the database will be an on-memory tree database -- open adb \"+\" >>= err adb \"open failed\" -- -- store records -- puts adb [(\"foo\", \"hop\"), (\"bar\", \"step\"), (\"baz\", \"jump\")] >>= -- err adb \"put failed\" . (all id) -- -- retrieve records -- get_print adb \"foo\" -- -- traverse records -- iterinit adb -- iter adb >>= mapM_ (\k -> putStr (k++\":\") >> get_print adb k) -- -- close the database -- close adb >>= err adb \"close failed\" -- where -- puts :: ADB -> [(String, String)] -> IO [Bool] -- puts adb = mapM (uncurry $ put adb) -- @ -- -- @ -- get_print :: ADB -> String -> IO () -- get_print adb key = get adb key >>= -- maybe (error \"something goes wrong\") putStrLn -- @ -- -- @ -- err :: ADB -> String -> Bool -> IO () -- err adb msg = flip unless $ error msg -- @ -- -- @ -- iter :: ADB -> IO [String] -- iter adb = iternext adb >>= -- maybe (return []) (\x -> return . (x:) =<< iter adb) -- @ -- data ADB = ADB { unTCADB :: !(ForeignPtr ADB') } -- | Create a Abstract database object. new :: IO ADB new = ADB `fmap` (c_tcadbnew >>= newForeignPtr tcadbFinalizer) -- | Free ADB resource forcibly. -- ADB is kept by ForeignPtr, so Haskell runtime GC cleans up memory for -- almost situation. Most always, you don't need to call this. -- After call this, you must not touch ADB object. Its behavior is undefined. delete :: ADB -> IO () delete adb = finalizeForeignPtr (unTCADB adb) -- | Open an abstract dataabse. open :: ADB -> String -> IO Bool open adb name = withForeignPtr (unTCADB adb) $ (withCString name) . c_tcadbopen -- | Close an abstract database object. close :: ADB -> IO Bool close adb = withForeignPtr (unTCADB adb) c_tcadbclose -- | Stora a record into an abstract database object. put :: (Storable k, Storable v) => ADB -> k -> v -> IO Bool put = putHelper c_tcadbput unTCADB -- | Store a new record into an abstract database object. putkeep :: (Storable k, Storable v) => ADB -> k -> v -> IO Bool putkeep = putHelper c_tcadbputkeep unTCADB -- | Concatenate a value at the end of the existing record in an -- abstract database object. putcat :: (Storable k, Storable v) => ADB -> k -> v -> IO Bool putcat = putHelper c_tcadbputcat unTCADB -- | Remove a record of an abstract database object. out :: (Storable k) => ADB -> k -> IO Bool out = outHelper c_tcadbout unTCADB -- | Retrieve a record in an abstract database object. get :: (Storable k, Storable v) => ADB -> k -> IO (Maybe v) get = getHelper c_tcadbget unTCADB -- | Get the size of the value of a record in an abstract database object. vsiz :: (Storable k) => ADB -> k -> IO (Maybe Int) vsiz = vsizHelper c_tcadbvsiz unTCADB -- | Initialize the iterator of an abstract database object. iterinit :: ADB -> IO Bool iterinit adb = withForeignPtr (unTCADB adb) c_tcadbiterinit -- | Get the next key of the iterator of an abstract database object. iternext :: (Storable k) => ADB -> IO (Maybe k) iternext = iternextHelper c_tcadbiternext unTCADB -- | Get forward matching keys in an abstract database object. fwmkeys :: (Storable k1, Storable k2, Sequence q) => ADB -> k1 -> Int -> IO (q k2) fwmkeys = fwmHelper c_tcadbfwmkeys unTCADB -- | Add an integer to a record in an abstract database object. addint :: (Storable k) => ADB -> k -> Int -> IO (Maybe Int) addint = addHelper c_tcadbaddint unTCADB fromIntegral fromIntegral (== cINT_MIN) -- | Add a real number to a record in an abstract database object. adddouble :: (Storable k) => ADB -> k -> Double -> IO (Maybe Double) adddouble = addHelper c_tcadbadddouble unTCADB realToFrac realToFrac isNaN -- | Synchronize updated contents of an abstract database object with -- the file and the device. sync :: ADB -> IO Bool sync adb = withForeignPtr (unTCADB adb) c_tcadbsync -- | Optimize the storage of an abstract database object. optimize :: ADB -> String -> IO Bool optimize adb params = withForeignPtr (unTCADB adb) $ (withCString params) . c_tcadboptimize -- | Remove all records of an abstract database object. vanish :: ADB -> IO Bool vanish adb = withForeignPtr (unTCADB adb) c_tcadbvanish -- | Copy the database file of an abstract database object. copy :: ADB -> String -> IO Bool copy = copyHelper c_tcadbcopy unTCADB -- | Begin the transaction of an abstract database object. tranbegin :: ADB -> IO Bool tranbegin adb = withForeignPtr (unTCADB adb) c_tcadbtranbegin -- | Commit the transaction of an abstract database object. trancommit :: ADB -> IO Bool trancommit adb = withForeignPtr (unTCADB adb) c_tcadbtrancommit -- | Abort the transaction of an abstract database object. tranabort :: ADB -> IO Bool tranabort adb = withForeignPtr (unTCADB adb) c_tcadbtranabort -- | Get the file path of an abstract database object. path :: ADB -> IO (Maybe String) path = pathHelper c_tcadbpath unTCADB -- | Get the number of records of an abstract database object. rnum :: ADB -> IO Word64 rnum adb = withForeignPtr (unTCADB adb) c_tcadbrnum -- | Get the size of the database of an abstract database object. size :: ADB -> IO Word64 size adb = withForeignPtr (unTCADB adb) c_tcadbsize -- | Call a versatile function for miscellaneous operations of an -- abstract database object. misc :: (Storable a, Storable b, Sequence q1, Sequence q2) => ADB -> String -> q1 a -> IO (q2 b) misc adb name args = withForeignPtr (unTCADB adb) $ \adb' -> withCString name $ \name' -> withList args $ \args' -> do ret <- c_tcadbmisc adb' name' args' peekList' ret tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/ADB/000077500000000000000000000000001126071621700223205ustar00rootroot00000000000000tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/ADB/C.hsc000066400000000000000000000067541126071621700232150ustar00rootroot00000000000000{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} module Database.TokyoCabinet.ADB.C where import Data.Word import Foreign.Ptr import Foreign.C.Types import Foreign.C.String import Database.TokyoCabinet.List.C (LIST) #include data ADB' foreign import ccall safe "tcadbnew" c_tcadbnew :: IO (Ptr ADB') foreign import ccall safe "tcadbdel" c_tcadbdel :: Ptr ADB' -> IO () foreign import ccall safe "&tcadbdel" tcadbFinalizer :: FunPtr (Ptr ADB' -> IO ()) foreign import ccall safe "tcadbopen" c_tcadbopen :: Ptr ADB' -> CString -> IO Bool foreign import ccall safe "tcadbclose" c_tcadbclose :: Ptr ADB' -> IO Bool foreign import ccall safe "tcadbput" c_tcadbput :: Ptr ADB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tcadbput2" c_tcadbput2 :: Ptr ADB' -> CString -> CString -> IO Bool foreign import ccall safe "tcadbputkeep" c_tcadbputkeep :: Ptr ADB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tcadbputkeep2" c_tcadbputkeep2 :: Ptr ADB' -> CString -> CString -> IO Bool foreign import ccall safe "tcadbputcat" c_tcadbputcat :: Ptr ADB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tcadbputcat2" c_tcadbputcat2 :: Ptr ADB' -> CString -> CString -> IO Bool foreign import ccall safe "tcadbout" c_tcadbout :: Ptr ADB' -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tcadbout2" c_tcadbout2 :: Ptr ADB' -> CString -> IO Bool foreign import ccall safe "tcadbget" c_tcadbget :: Ptr ADB' -> Ptr Word8 -> CInt -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tcadbget2" c_tcadbget2 :: Ptr ADB' -> CString -> IO CString foreign import ccall safe "tcadbvsiz" c_tcadbvsiz :: Ptr ADB' -> Ptr Word8 -> CInt -> IO CInt foreign import ccall safe "tcadbvsiz2" c_tcadbvsiz2 :: Ptr ADB' -> CString -> IO CInt foreign import ccall safe "tcadbiterinit" c_tcadbiterinit :: Ptr ADB' -> IO Bool foreign import ccall safe "tcadbiternext" c_tcadbiternext :: Ptr ADB' -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tcadbiternext2" c_tcadbiternext2 :: Ptr ADB' -> IO CString foreign import ccall safe "tcadbfwmkeys" c_tcadbfwmkeys :: Ptr ADB' -> Ptr Word8 -> CInt -> CInt -> IO (Ptr LIST) foreign import ccall safe "tcadbfwmkeys2" c_tcadbfwmkeys2 :: Ptr ADB' -> CString -> CInt -> IO (Ptr LIST) foreign import ccall safe "tcadbaddint" c_tcadbaddint :: Ptr ADB' -> Ptr Word8 -> CInt -> CInt -> IO CInt foreign import ccall safe "tcadbadddouble" c_tcadbadddouble :: Ptr ADB' -> Ptr Word8 -> CInt -> CDouble -> IO CDouble foreign import ccall safe "tcadbsync" c_tcadbsync :: Ptr ADB' -> IO Bool foreign import ccall safe "tcadboptimize" c_tcadboptimize :: Ptr ADB' -> CString -> IO Bool foreign import ccall safe "tcadbvanish" c_tcadbvanish :: Ptr ADB' -> IO Bool foreign import ccall safe "tcadbcopy" c_tcadbcopy :: Ptr ADB' -> CString -> IO Bool foreign import ccall safe "tcadbtranbegin" c_tcadbtranbegin :: Ptr ADB' -> IO Bool foreign import ccall safe "tcadbtrancommit" c_tcadbtrancommit :: Ptr ADB' -> IO Bool foreign import ccall safe "tcadbtranabort" c_tcadbtranabort :: Ptr ADB' -> IO Bool foreign import ccall safe "tcadbpath" c_tcadbpath :: Ptr ADB' -> IO CString foreign import ccall safe "tcadbrnum" c_tcadbrnum :: Ptr ADB' -> IO Word64 foreign import ccall safe "tcadbsize" c_tcadbsize :: Ptr ADB' -> IO Word64 foreign import ccall safe "tcadbmisc" c_tcadbmisc :: Ptr ADB' -> CString -> Ptr LIST -> IO (Ptr LIST) tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/Associative.hs000066400000000000000000000026301126071621700245410ustar00rootroot00000000000000module Database.TokyoCabinet.Associative where import Data.Maybe import Foreign.Ptr import Foreign.ForeignPtr import Database.TokyoCabinet.Map import Database.TokyoCabinet.Map.C import Database.TokyoCabinet.Storable class Associative a where withMap :: (Storable k, Storable v) => a k v -> (Ptr MAP -> IO b) -> IO b peekMap' :: (Storable k, Storable v) => Ptr MAP -> IO (a k v) newtype AssocList k v = AssocList { unAssocList :: [(k, v)] } deriving (Eq, Ord, Show) instance Associative AssocList where withMap (AssocList alist) action = do m <- new mapM_ (uncurry $ put m) alist result <- withForeignPtr (unMap m) action delete m return result peekMap' ptr | ptr == nullPtr = return (AssocList []) peekMap' ptr = do m <- Map `fmap` newForeignPtr tcmapFinalizer ptr iterinit m AssocList `fmap` accumulate m [] where accumulate m acc = do val <- iternext m case val of Just k -> do (Just v) <- get m k ((k, v):) `fmap` accumulate m acc _ -> return acc instance Associative Map where withMap m action = withForeignPtr (unMap m) action peekMap' ptr | ptr == nullPtr = new peekMap' ptr = Map `fmap` newForeignPtr tcmapFinalizer ptr tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/BDB.hs000066400000000000000000000317641126071621700226700ustar00rootroot00000000000000-- | Interface to B+ tree based DBM. See also, -- for details module Database.TokyoCabinet.BDB ( -- $doc -- * Constructors BDB , ECODE(..) , OpenMode(..) , TuningOption(..) , CMP(..) -- * Basic API (tokyocabinet.idl compliant) , new , delete , ecode , errmsg , tune , setcache , setxmsiz , setcmpfunc , open , close , put , putkeep , putcat , putdup , putlist , out , outlist , get , getlist , vnum , vsiz , range , fwmkeys , addint , adddouble , sync , optimize , vanish , copy , tranbegin , trancommit , tranabort , path , rnum , fsiz ) where import Data.Int import Data.Word import Data.ByteString (ByteString) import Data.ByteString.Unsafe (unsafePackCStringLen) import Foreign.Ptr import Foreign.ForeignPtr import Foreign.Storable (peek) import Foreign.Marshal (alloca) import Database.TokyoCabinet.Error import Database.TokyoCabinet.BDB.C import Database.TokyoCabinet.List.C import Database.TokyoCabinet.Internal import Database.TokyoCabinet.Storable import Database.TokyoCabinet.Sequence -- $doc -- Example -- -- @ -- import Control.Monad -- import Database.TokyoCabinet.BDB -- import qualified Database.TokyoCabinet.BDB.Cursor as C -- @ -- -- @ -- main :: IO () -- main = -- do bdb <- new -- -- open the database -- open bdb \"casket.tcb\" [OWRITER, OCREAT] >>= err bdb -- -- store records -- puts bdb [ (\"foo\", \"hop\"), (\"bar\", \"step\"), (\"baz\", \"jump\") ] >>= -- err bdb . (all id) -- -- retrieve records -- get bdb \"foo\" >>= maybe (error \"something goes wrong\") putStrLn -- -- traverse records -- cur <- C.new bdb -- C.first cur >>= err bdb -- iter cur >>= putStrLn . show -- -- close the database -- close bdb >>= err bdb -- where -- puts :: BDB -> [(String, String)] -> IO [Bool] -- puts bdb = mapM (uncurry $ put bdb) -- @ -- -- @ -- err :: BDB -> Bool -> IO () -- err bdb = flip unless $ ecode bdb >>= error . show -- @ -- -- @ -- iter :: C.BDBCUR -> IO [(String, String)] -- iter cur = do -- [key, value] <- sequence [C.key cur, C.val cur] -- case (key, value) of -- (Just k, Just v) -> C.next cur >> iter cur >>= return . ((k,v):) -- _ -> return [] -- @ -- data CMP = CMPLEXICAL | CMPDECIMAL | CMPINT32 | CMPINT64 | CMP (ByteString -> ByteString -> Ordering) -- | Create a B+ tree database object. new :: IO BDB new = BDB `fmap` (c_tcbdbnew >>= newForeignPtr tcbdbFinalizer) -- | Free BDB resource forcibly. -- BDB is kept by ForeignPtr, so Haskell runtime GC cleans up memory for -- almost situation. Most always, you don't need to call this. -- After call this, you must not touch BDB object. Its behavior is undefined. delete :: BDB -> IO () delete bdb = finalizeForeignPtr (unTCBDB bdb) -- | Return the last happened error code. ecode :: BDB -> IO ECODE ecode bdb = cintToError `fmap` withForeignPtr (unTCBDB bdb) c_tcbdbecode -- | Set the tuning parameters. tune :: BDB -- ^ BDB object -> Int32 -- ^ the number of members in each leaf page. -> Int32 -- ^ the number of members in each non-leaf page. -> Int64 -- ^ the number of elements of the bucket array. -> Int8 -- ^ the size of record alignment by power of 2. -> Int8 -- ^ the maximum number of elements of the free block -- pool by power of 2. -> [TuningOption] -- ^ tuning options -> IO Bool -- ^ if successful, the return value is True. tune bdb lmemb nmemb bnum apow fpow opts = withForeignPtr (unTCBDB bdb) $ \bdb' -> c_tcbdbtune bdb' lmemb nmemb bnum apow fpow (combineTuningOption opts) -- | Set the caching parameters. setcache :: BDB -- ^ BDB object -> Int32 -- ^ the maximum number of leaf nodes to be cached. -> Int32 -- ^ the maximum number of non-leaf nodes to be cached. -> IO Bool -- ^ if successful, the return value is True. setcache bdb lcnum ncnum = withForeignPtr (unTCBDB bdb) $ \bdb' -> c_tcbdbsetcache bdb' lcnum ncnum -- | Set the size of extra mapped memory. setxmsiz :: BDB -> Int64 -> IO Bool setxmsiz bdb xmsiz = withForeignPtr (unTCBDB bdb) $ \bdb' -> c_tcbdbsetxmsiz bdb' xmsiz -- | Set the custom comparison function of a B+ tree database object. setcmpfunc :: BDB -> CMP -> IO Bool setcmpfunc bdb CMPLEXICAL = withForeignPtr (unTCBDB bdb) $ flip c_tcbdbsetcmpfunc c_tccmplexical setcmpfunc bdb CMPDECIMAL = withForeignPtr (unTCBDB bdb) $ flip c_tcbdbsetcmpfunc c_tccmpdecimal setcmpfunc bdb CMPINT32 = withForeignPtr (unTCBDB bdb) $ flip c_tcbdbsetcmpfunc c_tccmpint32 setcmpfunc bdb CMPINT64 = withForeignPtr (unTCBDB bdb) $ flip c_tcbdbsetcmpfunc c_tccmpint64 setcmpfunc bdb (CMP func) = withForeignPtr (unTCBDB bdb) $ \bdb' -> do cmpfunc <- mkCMP mycmpfunc c_tcbdbsetcmpfunc bdb' cmpfunc where mycmpfunc :: TCCMP' mycmpfunc k1buf k1siz k2buf k2siz _ = do key1 <- unsafePackCStringLen (k1buf, fromIntegral k1siz) key2 <- unsafePackCStringLen (k2buf, fromIntegral k2siz) case func key1 key2 of LT -> return (-1) EQ -> return 0 GT -> return 1 -- | Open BDB database file. open :: BDB -> String -> [OpenMode] -> IO Bool open = openHelper c_tcbdbopen unTCBDB combineOpenMode -- | Close the database file. close :: BDB -> IO Bool close bdb = withForeignPtr (unTCBDB bdb) c_tcbdbclose -- | Stora a record (key-value pair) on BDB. Key and value type must -- be instance of Storable class. Usually, we can use `String', -- `ByteString' for key, `String', `ByteString', `Int', `Double' for -- value. put :: (Storable k, Storable v) => BDB -> k -> v -> IO Bool put = putHelper c_tcbdbput unTCBDB -- | Store a new record. If a record with the same key exists in the -- database, this function has no effect. putkeep :: (Storable k, Storable v) => BDB -> k -> v -> IO Bool putkeep = putHelper c_tcbdbputkeep unTCBDB -- | Concatenate a value at the end of the existing record. putcat :: (Storable k, Storable v) => BDB -> k -> v -> IO Bool putcat = putHelper c_tcbdbputcat unTCBDB -- | Store a record with allowing duplication of keys. putdup :: (Storable k, Storable v) => BDB -> k -> v -> IO Bool putdup = putHelper c_tcbdbputdup unTCBDB -- | Store records with allowing duplication of keys. putlist :: (Storable k, Storable v, Sequence q) => BDB -> k -> q v -> IO Bool putlist bdb key vals = withForeignPtr (unTCBDB bdb) $ \bdb' -> withList vals $ \tcls -> withPtrLen key $ \(kbuf, ksize) -> alloca $ \sizbuf -> do num <- c_tclistnum tcls putlist' bdb' (kbuf, ksize) tcls sizbuf num where putlist' bdb' (kbuf, ksize) tcls sizbuf = put' 0 where put' n num | n < num = do vbuf <- c_tclistval tcls n sizbuf vsize <- fromIntegral `fmap` peek sizbuf res <- c_tcbdbputdup bdb' kbuf ksize vbuf vsize if res then put' (n+1) num else return False | otherwise = return True -- | Delete a record. If the key of duplicated records is specified, -- the first one is deleted. out :: (Storable k) => BDB -> k -> IO Bool out = outHelper c_tcbdbout unTCBDB -- | Delete records. If the key of duplicated records is specified, -- all of them are deleted. outlist :: (Storable k) => BDB -> k -> IO Bool outlist = outHelper c_tcbdbout3 unTCBDB -- | Return the value of record. If the key of duplicated records is -- specified, the first one is returned. get :: (Storable k, Storable v) => BDB -> k -> IO (Maybe v) get = getHelper c_tcbdbget unTCBDB -- | Retrieve records. getlist :: (Storable k, Storable v, Sequence q) => BDB -> k -> IO (q v) getlist bdb key = withForeignPtr (unTCBDB bdb) $ \bdb' -> withPtrLen key $ \(kbuf, ksize) -> do ptr <- c_tcbdbget4 bdb' kbuf ksize if ptr == nullPtr then empty else peekList' ptr -- | Return the number of records corresponding to a key. vnum :: (Storable k) => BDB -> k -> IO (Maybe Int) vnum bdb key = withForeignPtr (unTCBDB bdb) $ \bdb' -> withPtrLen key $ \(kbuf, ksize) -> do res <- c_tcbdbvnum bdb' kbuf ksize return $ if res == 0 then Nothing else Just $ fromIntegral res -- | Return the size of the value of a record. If the key of duplicated -- records is specified, the first one is selected. vsiz :: (Storable k) => BDB -> k -> IO (Maybe Int) vsiz = vsizHelper c_tcbdbvsiz unTCBDB -- | Return list of keys in the specified range. range :: (Storable k, Sequence q) => BDB -- ^ BDB object -> Maybe k -- ^ the key of the beginning border. If it is -- Nothing, the first record in the database is -- specified. -> Bool -- ^ whether the beginning border is inclusive or not. -> Maybe k -- ^ the key of the ending border. If it is Nothing, -- the last record is specified. -> Bool -- ^ whether the ending border is inclusive or not. -> Int -- ^ the maximum number of keys to be fetched. If it -- is negative value, no limit is specified. -> IO (q k) -- ^ keys in the specified range. range bdb bkey binc ekey einc maxn = withForeignPtr (unTCBDB bdb) $ \bdb' -> withPtrLen' bkey $ \(bkbuf, bksiz) -> withPtrLen' ekey $ \(ekbuf, eksiz) -> c_tcbdbrange bdb' bkbuf bksiz binc ekbuf eksiz einc (fromIntegral maxn) >>= peekList' where withPtrLen' (Just key) action = withPtrLen key action withPtrLen' Nothing action = action (nullPtr, 0) -- | Return list of forward matched keys. fwmkeys :: (Storable k1, Storable k2, Sequence q) => BDB -- ^ BDB object -> k1 -- ^ search string -> Int -- ^ the maximum number of keys to be fetched. If it -- is negative value, no limit is specified. -> IO (q k2) -- ^ keys matches specified string (in forward matching). fwmkeys = fwmHelper c_tcbdbfwmkeys unTCBDB -- | Increment the corresponding value. (The value specified by a key -- is treated as integer.) addint :: (Storable k) => BDB -- ^ BDB object. -> k -- ^ Key. -> Int -- ^ Amount of increment. -> IO (Maybe Int) -- ^ If successful, a new value is returned. addint = addHelper c_tcbdbaddint unTCBDB fromIntegral fromIntegral (== cINT_MIN) -- | Increment the corresponding value. (The value specified by a key -- is treated as double.) adddouble :: (Storable k) => BDB -- ^ BDB object. -> k -- ^ Key. -> Double -- ^ Amount of increment. -> IO (Maybe Double) -- ^ If successful, a new value is returned. adddouble = addHelper c_tcbdbadddouble unTCBDB realToFrac realToFrac isNaN -- | Synchronize updated contents of a database object with the file -- and the device. sync :: BDB -> IO Bool sync bdb = withForeignPtr (unTCBDB bdb) c_tcbdbsync -- | Optimize the file of a B+ tree database object. optimize :: BDB -> Int32 -- ^ the number of members in each leaf page. -> Int32 -- ^ the number of members in each non-leaf page. -> Int64 -- ^ the number of elements of the bucket array. -> Int8 -- ^ the size of record alignment by power of 2. -> Int8 -- ^ the maximum number of elements of the free block -- pool by power of 2. -> [TuningOption] -- ^ tuning options -> IO Bool -- ^ if successful, the return value is True. optimize bdb lmemb nmemb bnum apow fpow opts = withForeignPtr (unTCBDB bdb) $ \bdb' -> c_tcbdboptimize bdb' lmemb nmemb bnum apow fpow (combineTuningOption opts) -- | Delete all records. vanish :: BDB -> IO Bool vanish bdb = withForeignPtr (unTCBDB bdb) c_tcbdbvanish -- | Copy the database file. copy :: BDB -> String -> IO Bool copy = copyHelper c_tcbdbcopy unTCBDB -- | Begin the transaction. tranbegin :: BDB -> IO Bool tranbegin bdb = withForeignPtr (unTCBDB bdb) c_tcbdbtranbegin -- | Commit the transaction. trancommit :: BDB -> IO Bool trancommit bdb = withForeignPtr (unTCBDB bdb) c_tcbdbtrancommit -- | Abort the transaction. tranabort :: BDB -> IO Bool tranabort bdb = withForeignPtr (unTCBDB bdb) c_tcbdbtranabort -- | Return the file path of currentry opened database. path :: BDB -> IO (Maybe String) path = pathHelper c_tcbdbpath unTCBDB -- | Return the number of records in the database. rnum :: BDB -> IO Word64 rnum bdb = withForeignPtr (unTCBDB bdb) c_tcbdbrnum -- | Return the size of the database file. fsiz :: BDB -> IO Word64 fsiz bdb = withForeignPtr (unTCBDB bdb) c_tcbdbfsiz tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/BDB/000077500000000000000000000000001126071621700223215ustar00rootroot00000000000000tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/BDB/C.hsc000066400000000000000000000150301126071621700232010ustar00rootroot00000000000000{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} module Database.TokyoCabinet.BDB.C where #include import Foreign.Ptr import Foreign.ForeignPtr import Foreign.C.Types import Foreign.C.String import Data.Int import Data.Word import Data.Bits import Database.TokyoCabinet.List.C (LIST) data BDB = BDB { unTCBDB :: !(ForeignPtr BDB') } data OpenMode = OREADER | OWRITER | OCREAT | OTRUNC | ONOLCK | OLCKNB | OTSYNC deriving (Eq, Ord, Show) openModeToCInt :: OpenMode -> CInt openModeToCInt OREADER = #const BDBOREADER openModeToCInt OWRITER = #const BDBOWRITER openModeToCInt OCREAT = #const BDBOCREAT openModeToCInt OTRUNC = #const BDBOTRUNC openModeToCInt ONOLCK = #const BDBONOLCK openModeToCInt OLCKNB = #const BDBOLCKNB openModeToCInt OTSYNC = #const BDBOTSYNC combineOpenMode :: [OpenMode] -> CInt combineOpenMode = foldr ((.|.) . openModeToCInt) 0 data TuningOption = TLARGE | TDEFLATE | TBZIP | TTCBS | TEXCODEC deriving (Eq, Ord, Show) tuningOptionToWord8 :: TuningOption -> Word8 tuningOptionToWord8 TLARGE = #const BDBTLARGE tuningOptionToWord8 TDEFLATE = #const BDBTDEFLATE tuningOptionToWord8 TBZIP = #const BDBTBZIP tuningOptionToWord8 TTCBS = #const BDBTTCBS tuningOptionToWord8 TEXCODEC = #const BDBTEXCODEC combineTuningOption :: [TuningOption] -> Word8 combineTuningOption = foldr ((.|.) . tuningOptionToWord8) 0 type TCCMP' = Ptr CChar -> CInt -> Ptr CChar -> CInt -> Ptr Word8 -> IO CInt data BDB' foreign import ccall safe "tcbdbnew" c_tcbdbnew :: IO (Ptr BDB') foreign import ccall safe "tcbdbdel" c_tcbdbdel :: Ptr BDB' -> IO () foreign import ccall safe "&tcbdbdel" tcbdbFinalizer :: FunPtr (Ptr BDB' -> IO ()) foreign import ccall safe "tcbdbecode" c_tcbdbecode :: Ptr BDB' -> IO CInt foreign import ccall safe "tcbdbsetmutex" c_tcbdbsetmutex :: Ptr BDB' -> IO Bool foreign import ccall safe "tcbdbsetcmpfunc" c_tcbdbsetcmpfunc :: Ptr BDB' -> FunPtr TCCMP' -> IO Bool foreign import ccall safe "tcbdbtune" c_tcbdbtune :: Ptr BDB' -> Int32 -> Int32 -> Int64 -> Int8 -> Int8 -> Word8 -> IO Bool foreign import ccall safe "tcbdbsetcache" c_tcbdbsetcache :: Ptr BDB' -> Int32 -> Int32 -> IO Bool foreign import ccall safe "tcbdbsetxmsiz" c_tcbdbsetxmsiz :: Ptr BDB' -> Int64 -> IO Bool foreign import ccall safe "tcbdbopen" c_tcbdbopen :: Ptr BDB' -> CString -> CInt -> IO Bool foreign import ccall safe "tcbdbclose" c_tcbdbclose :: Ptr BDB' -> IO Bool foreign import ccall safe "tcbdbput" c_tcbdbput :: Ptr BDB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tcbdbput2" c_tcbdbput2 :: Ptr BDB' -> CString -> CString -> IO Bool foreign import ccall safe "tcbdbputkeep" c_tcbdbputkeep :: Ptr BDB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tcbdbputkeep2" c_tcbdbputkeep2 :: Ptr BDB' -> CString -> CString -> IO Bool foreign import ccall safe "tcbdbputcat" c_tcbdbputcat :: Ptr BDB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tcbdbputcat2" c_tcbdbputcat2 :: Ptr BDB' -> CString -> CString -> IO Bool foreign import ccall safe "tcbdbputdup" c_tcbdbputdup :: Ptr BDB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tcbdbputdup2" c_tcbdbputdup2 :: Ptr BDB' -> CString -> CString -> IO Bool foreign import ccall safe "tcbdbputdup3" c_tcbdbputdup3 :: Ptr BDB' -> Ptr Word8 -> CInt -> Ptr LIST -> IO Bool foreign import ccall safe "tcbdbout" c_tcbdbout :: Ptr BDB' -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tcbdbout2" c_tcbdbout2 :: Ptr BDB' -> CString -> IO Bool foreign import ccall safe "tcbdbout3" c_tcbdbout3 :: Ptr BDB' -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tcbdbget" c_tcbdbget :: Ptr BDB' -> Ptr Word8 -> CInt -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tcbdbget2" c_tcbdbget2 :: Ptr BDB' -> CString -> IO CString foreign import ccall safe "tcbdbget3" c_tcbdbget3 :: Ptr BDB' -> Ptr Word8 -> CInt -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tcbdbget4" c_tcbdbget4 :: Ptr BDB' -> Ptr Word8 -> CInt -> IO (Ptr LIST) foreign import ccall safe "tcbdbvnum" c_tcbdbvnum :: Ptr BDB' -> Ptr Word8 -> CInt -> IO CInt foreign import ccall safe "tcbdbvnum2" c_tcbdbvnum2 :: Ptr BDB' -> CString -> IO CInt foreign import ccall safe "tcbdbvsiz" c_tcbdbvsiz :: Ptr BDB' -> Ptr Word8 -> CInt -> IO CInt foreign import ccall safe "tcbdbvsiz2" c_tcbdbvsiz2 :: Ptr BDB' -> CString -> IO CInt foreign import ccall safe "tcbdbrange" c_tcbdbrange :: Ptr BDB' -> Ptr Word8 -> CInt -> Bool -> Ptr Word8 -> CInt -> Bool -> CInt -> IO (Ptr LIST) foreign import ccall safe "tcbdbrange2" c_tcbdbrange2 :: Ptr BDB' -> CString -> Bool -> CString -> Bool -> CInt -> IO (Ptr LIST) foreign import ccall safe "tcbdbfwmkeys" c_tcbdbfwmkeys :: Ptr BDB' -> Ptr Word8 -> CInt -> CInt -> IO (Ptr LIST) foreign import ccall safe "tcbdbfwmkeys2" c_tcbdbfwmkeys2 :: Ptr BDB' -> CString -> CInt -> IO (Ptr LIST) foreign import ccall safe "tcbdbaddint" c_tcbdbaddint :: Ptr BDB' -> Ptr Word8 -> CInt -> CInt -> IO CInt foreign import ccall safe "tcbdbadddouble" c_tcbdbadddouble :: Ptr BDB' -> Ptr Word8 -> CInt -> CDouble -> IO CDouble foreign import ccall safe "tcbdbsync" c_tcbdbsync :: Ptr BDB' -> IO Bool foreign import ccall safe "tcbdboptimize" c_tcbdboptimize :: Ptr BDB' -> Int32 -> Int32 -> Int64 -> Int8 -> Int8 -> Word8 -> IO Bool foreign import ccall safe "tcbdbvanish" c_tcbdbvanish :: Ptr BDB' -> IO Bool foreign import ccall safe "tcbdbcopy" c_tcbdbcopy :: Ptr BDB' -> CString -> IO Bool foreign import ccall safe "tcbdbtranbegin" c_tcbdbtranbegin :: Ptr BDB' -> IO Bool foreign import ccall safe "tcbdbtrancommit" c_tcbdbtrancommit :: Ptr BDB' -> IO Bool foreign import ccall safe "tcbdbtranabort" c_tcbdbtranabort :: Ptr BDB' -> IO Bool foreign import ccall safe "tcbdbpath" c_tcbdbpath :: Ptr BDB' -> IO CString foreign import ccall safe "tcbdbrnum" c_tcbdbrnum :: Ptr BDB' -> IO Word64 foreign import ccall safe "tcbdbfsiz" c_tcbdbfsiz :: Ptr BDB' -> IO Word64 foreign import ccall safe "tcutil.h &tccmplexical" c_tccmplexical :: FunPtr TCCMP' foreign import ccall safe "tcutil.h &tccmpdecimal" c_tccmpdecimal :: FunPtr TCCMP' foreign import ccall safe "tcutil.h &tccmpint32" c_tccmpint32 :: FunPtr TCCMP' foreign import ccall safe "tcutil.h &tccmpint64" c_tccmpint64 :: FunPtr TCCMP' foreign import ccall "wrapper" mkCMP :: TCCMP' -> IO (FunPtr TCCMP') tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/BDB/Cursor.hs000066400000000000000000000045221126071621700241350ustar00rootroot00000000000000{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} module Database.TokyoCabinet.BDB.Cursor ( CursorPutMode(..) , new , delete , first , last , jump , prev , next , put , out , key , val , BDBCUR ) where import Prelude hiding (last) import Database.TokyoCabinet.BDB.C import Database.TokyoCabinet.BDB.Cursor.C import qualified Database.TokyoCabinet.Storable as S import Foreign.ForeignPtr import Foreign.Marshal (alloca) import Foreign.Storable (peek) import Foreign.Marshal.Utils (maybePeek) data BDBCUR = BDBCUR !(ForeignPtr CUR) BDB unTCBDBCUR :: BDBCUR -> ForeignPtr CUR unTCBDBCUR (BDBCUR cur _) = cur new :: BDB -> IO BDBCUR new bdb = withForeignPtr (unTCBDB bdb) $ \bdb' -> do cur <- c_tcbdbcurnew bdb' flip BDBCUR bdb `fmap` newForeignPtr tcbdbcurFinalizer cur delete :: BDBCUR -> IO () delete cur = finalizeForeignPtr (unTCBDBCUR cur) first :: BDBCUR -> IO Bool first cur = withForeignPtr (unTCBDBCUR cur) c_tcbdbcurfirst last :: BDBCUR -> IO Bool last cur = withForeignPtr (unTCBDBCUR cur) c_tcbdbcurlast jump :: (S.Storable k) => BDBCUR -> k -> IO Bool jump cur k = withForeignPtr (unTCBDBCUR cur) $ \cur' -> S.withPtrLen k $ \(kbuf, ksiz) -> c_tcbdbcurjump cur' kbuf ksiz prev :: BDBCUR -> IO Bool prev cur = withForeignPtr (unTCBDBCUR cur) c_tcbdbcurprev next :: BDBCUR -> IO Bool next cur = withForeignPtr (unTCBDBCUR cur) c_tcbdbcurnext put :: (S.Storable v) => BDBCUR -> v -> CursorPutMode -> IO Bool put cur v mode = withForeignPtr (unTCBDBCUR cur) $ \cur' -> S.withPtrLen v $ \(vbuf, vsiz) -> c_tcbdbcurput cur' vbuf vsiz (cpToCInt mode) out :: BDBCUR -> IO Bool out cur = withForeignPtr (unTCBDBCUR cur) c_tcbdbcurout key :: (S.Storable k) => BDBCUR -> IO (Maybe k) key cur = withForeignPtr (unTCBDBCUR cur) $ \cur' -> alloca $ \sizbuf -> do vbuf <- c_tcbdbcurkey cur' sizbuf vsiz <- fromIntegral `fmap` peek sizbuf flip maybePeek vbuf $ \vbuf' -> S.peekPtrLen (vbuf', vsiz) val :: (S.Storable v) => BDBCUR -> IO (Maybe v) val cur = withForeignPtr (unTCBDBCUR cur) $ \cur' -> alloca $ \sizbuf -> do vbuf <- c_tcbdbcurval cur' sizbuf vsiz <- fromIntegral `fmap` peek sizbuf flip maybePeek vbuf $ \vbuf' -> S.peekPtrLen (vbuf', vsiz) tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/BDB/Cursor/000077500000000000000000000000001126071621700235765ustar00rootroot00000000000000tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/BDB/Cursor/C.hsc000066400000000000000000000042051126071621700244600ustar00rootroot00000000000000{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} module Database.TokyoCabinet.BDB.Cursor.C where import Database.TokyoCabinet.BDB.C import Foreign.Ptr import Foreign.C.Types import Foreign.C.String import Data.Word #include data CursorPutMode = CPCURRENT | CPBEFORE | CPAFTER deriving (Eq, Ord, Show) cpToCInt :: CursorPutMode -> CInt cpToCInt CPCURRENT = #const BDBCPCURRENT cpToCInt CPBEFORE = #const BDBCPBEFORE cpToCInt CPAFTER = #const BDBCPAFTER data CUR foreign import ccall safe "tcbdbcurnew" c_tcbdbcurnew :: Ptr BDB' -> IO (Ptr CUR) foreign import ccall safe "tcbdbcurdel" c_tcbdbcurdel :: Ptr CUR -> IO () foreign import ccall safe "&tcbdbcurdel" tcbdbcurFinalizer :: FunPtr (Ptr CUR -> IO ()) foreign import ccall safe "tcbdbcurfirst" c_tcbdbcurfirst :: Ptr CUR -> IO Bool foreign import ccall safe "tcbdbcurlast" c_tcbdbcurlast :: Ptr CUR -> IO Bool foreign import ccall safe "tcbdbcurjump" c_tcbdbcurjump :: Ptr CUR -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tcbdbcurjump2" c_tcbdbcurjump2 :: Ptr CUR -> CString -> IO Bool foreign import ccall safe "tcbdbcurprev" c_tcbdbcurprev :: Ptr CUR -> IO Bool foreign import ccall safe "tcbdbcurnext" c_tcbdbcurnext :: Ptr CUR -> IO Bool foreign import ccall safe "tcbdbcurput" c_tcbdbcurput :: Ptr CUR -> Ptr Word8 -> CInt -> CInt -> IO Bool foreign import ccall safe "tcbdbcurput2" c_tcbdbcurput2 :: Ptr CUR -> CString -> CInt -> IO Bool foreign import ccall safe "tcbdbcurout" c_tcbdbcurout :: Ptr CUR -> IO Bool foreign import ccall safe "tcbdbcurkey" c_tcbdbcurkey :: Ptr CUR -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tcbdbcurkey2" c_tcbdbcurkey2 :: Ptr CUR -> IO CString foreign import ccall safe "tcbdbcurkey3" c_tcbdbcurkey3 :: Ptr CUR -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tcbdbcurval" c_tcbdbcurval :: Ptr CUR -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tcbdbcurval2" c_tcbdbcurval2 :: Ptr CUR -> IO CString foreign import ccall safe "tcbdbcurval3" c_tcbdbcurval3 :: Ptr CUR -> Ptr CInt -> IO (Ptr Word8) tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/Error.hsc000066400000000000000000000071241126071621700235260ustar00rootroot00000000000000{-# LANGUAGE CPP, ForeignFunctionInterface #-} module Database.TokyoCabinet.Error ( -- * Error code ECODE(..) -- * Utility function , errmsg , cintToError , errorToCInt -- * Other constants , cINT_MIN ) where import Foreign import Foreign.C.Types import Foreign.C.String #include -- | Represents error data ECODE = ESUCCESS | -- ^ success ETHREAD | -- ^ threading error EINVALID | -- ^ invalid operation ENOFILE | -- ^ file not found ENOPERM | -- ^ no permission EMETA | -- ^ invalid meta data ERHEAD | -- ^ invalid record header EOPEN | -- ^ open error ECLOSE | -- ^ close error ETRUNC | -- ^ trunc error ESYNC | -- ^ sync error ESTAT | -- ^ stat error ESEEK | -- ^ seek error EREAD | -- ^ read error EWRITE | -- ^ write error EMMAP | -- ^ mmap error ELOCK | -- ^ lock error EUNLINK | -- ^ unlink error ERENAME | -- ^ rename error EMKDIR | -- ^ mkdir error ERMDIR | -- ^ rmdir error EKEEP | -- ^ existing record ENOREC | -- ^ no record found EMISC -- ^ miscellaneous error deriving (Eq, Ord) instance Show ECODE where show e = errmsg e ++ " (code:" ++ show (errorToCInt e) ++ ")" errorToCInt :: ECODE -> CInt errorToCInt ESUCCESS = #const TCESUCCESS errorToCInt ETHREAD = #const TCETHREAD errorToCInt EINVALID = #const TCEINVALID errorToCInt ENOFILE = #const TCENOFILE errorToCInt ENOPERM = #const TCENOPERM errorToCInt EMETA = #const TCEMETA errorToCInt ERHEAD = #const TCERHEAD errorToCInt EOPEN = #const TCEOPEN errorToCInt ECLOSE = #const TCECLOSE errorToCInt ETRUNC = #const TCETRUNC errorToCInt ESYNC = #const TCESYNC errorToCInt ESTAT = #const TCESTAT errorToCInt ESEEK = #const TCESEEK errorToCInt EREAD = #const TCEREAD errorToCInt EWRITE = #const TCEWRITE errorToCInt EMMAP = #const TCEMMAP errorToCInt ELOCK = #const TCELOCK errorToCInt EUNLINK = #const TCEUNLINK errorToCInt ERENAME = #const TCERENAME errorToCInt EMKDIR = #const TCEMKDIR errorToCInt ERMDIR = #const TCERMDIR errorToCInt EKEEP = #const TCEKEEP errorToCInt ENOREC = #const TCENOREC errorToCInt EMISC = #const TCEMISC cintToError :: CInt -> ECODE cintToError #{const TCESUCCESS} = ESUCCESS cintToError #{const TCETHREAD} = ETHREAD cintToError #{const TCEINVALID} = EINVALID cintToError #{const TCENOFILE} = ENOFILE cintToError #{const TCENOPERM} = ENOPERM cintToError #{const TCEMETA} = EMETA cintToError #{const TCERHEAD} = ERHEAD cintToError #{const TCEOPEN} = EOPEN cintToError #{const TCECLOSE} = ECLOSE cintToError #{const TCETRUNC} = ETRUNC cintToError #{const TCESYNC} = ESYNC cintToError #{const TCESTAT} = ESTAT cintToError #{const TCESEEK} = ESEEK cintToError #{const TCEREAD} = EREAD cintToError #{const TCEWRITE} = EWRITE cintToError #{const TCEMMAP} = EMMAP cintToError #{const TCELOCK} = ELOCK cintToError #{const TCEUNLINK} = EUNLINK cintToError #{const TCERENAME} = ERENAME cintToError #{const TCEMKDIR} = EMKDIR cintToError #{const TCERMDIR} = ERMDIR cintToError #{const TCEKEEP} = EKEEP cintToError #{const TCENOREC} = ENOREC cintToError #{const TCEMISC} = EMISC cintToError _ = error "unknown error code" cINT_MIN :: CInt cINT_MIN = #const INT_MIN -- | Convert error code to message string. errmsg :: ECODE -> String errmsg = unsafePerformIO . peekCString . c_tcerrmsg . errorToCInt foreign import ccall "tcerrmsg" c_tcerrmsg :: CInt -> CString tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/FDB.hs000066400000000000000000000204561126071621700226700ustar00rootroot00000000000000-- | Interface to Fixed-length DBM. See also, -- for details module Database.TokyoCabinet.FDB ( -- $doc -- * Constructors FDB , ECODE(..) , OpenMode(..) , ID(..) -- * Basic API (tokyocabinet.idl compliant) , new , delete , ecode , errmsg , tune , open , close , put , putkeep , putcat , out , get , vsiz , iterinit , iternext , range , fwmkeys , addint , adddouble , sync , optimize , vanish , copy , path , rnum , fsiz ) where import Database.TokyoCabinet.Error import Database.TokyoCabinet.FDB.C import Database.TokyoCabinet.FDB.Key import Database.TokyoCabinet.Internal import Database.TokyoCabinet.Sequence import Database.TokyoCabinet.Storable import Foreign.Ptr import Foreign.ForeignPtr import Foreign.C.Types import Foreign.Storable (peek) import Foreign.Marshal (alloca, free) import Foreign.Marshal.Array (peekArray) import Foreign.Marshal.Utils (maybePeek) import Data.Int import Data.Word import Control.Exception -- $doc -- Example -- -- @ -- import Control.Monad -- import Database.TokyoCabinet.FDB -- @ -- -- @ -- main = do fdb <- new -- -- open the database -- open fdb \"casket.tcf\" [OWRITER, OCREAT] >>= err fdb -- -- store records -- puts fdb [(1, \"one\"), (12, \"twelve\"), (144, \"one forty four\")] >>= -- err fdb . (all id) -- -- retrieve records -- get fdb (1 :: Int) >>= maybe (error \"something goes wrong\") putStrLn -- -- close the database -- close fdb >>= err fdb -- where -- puts :: FDB -> [(Int, String)] -> IO [Bool] -- puts fdb = mapM (uncurry $ put fdb) -- @ -- -- @ -- err :: FDB -> Bool -> IO () -- err fdb = flip unless $ ecode fdb >>= error . show -- @ -- data FDB = FDB { unTCFDB :: !(ForeignPtr FDB') } -- | Create a Fixed-length database object. new :: IO FDB new = FDB `fmap` (c_tcfdbnew >>= newForeignPtr tcfdbFinalizer) -- | Free FDB resource forcibly. -- FDB is kept by ForeignPtr, so Haskell runtime GC cleans up memory for -- almost situation. Most always, you don't need to call this. -- After call this, you must not touch FDB object. Its behavior is undefined. delete :: FDB -> IO () delete fdb = finalizeForeignPtr $ unTCFDB fdb -- | Return the last happened error code. ecode :: FDB -> IO ECODE ecode fdb = withForeignPtr (unTCFDB fdb) $ \fdb' -> cintToError `fmap` c_tcfdbecode fdb' -- | Set the tuning parameters. tune :: FDB -- ^ FDB object. -> Int32 -- ^ the width of the value of each record. -> Int64 -- ^ the limit size of the database file. -> IO Bool -- ^ if successful, the return value is True. tune fdb width limsiz = withForeignPtr (unTCFDB fdb) $ \fdb' -> c_tcfdbtune fdb' width limsiz -- | Open FDB database file. open :: FDB -> String -> [OpenMode] -> IO Bool open = openHelper c_tcfdbopen unTCFDB combineOpenMode -- | Close the database file. close :: FDB -> IO Bool close fdb = withForeignPtr (unTCFDB fdb) c_tcfdbclose type FunPut' = Ptr FDB' -> Int64 -> Ptr Word8 -> CInt -> IO Bool putHelper' :: (Key k, Storable v) => FunPut' -> FDB -> k -> v -> IO Bool putHelper' func fdb key val = withForeignPtr (unTCFDB fdb) $ \fdb' -> withPtrLen val $ \(vbuf, vsize) -> do key' <- keyToInt key func fdb' key' vbuf vsize -- | Stora a record (key-value pair) on FDB. Key type must be -- instance of Key class. Value type must be instance of Storable. put :: (Key k, Storable v) => FDB -> k -> v -> IO Bool put = putHelper' c_tcfdbput -- | Store a new record. If a record with the same key exists in the -- database, this function has no effect. putkeep :: (Key k, Storable v) => FDB -> k -> v -> IO Bool putkeep = putHelper' c_tcfdbputkeep -- | Concatenate a value at the end of the existing record. putcat :: (Key k, Storable v) => FDB -> k -> v -> IO Bool putcat = putHelper' c_tcfdbputcat -- | Delete a record. out :: (Key k) => FDB -> k -> IO Bool out fdb key = withForeignPtr (unTCFDB fdb) $ \fdb' -> c_tcfdbout fdb' =<< keyToInt key -- | Return the value of record. get :: (Key k, Storable v) => FDB -> k -> IO (Maybe v) get fdb key = withForeignPtr (unTCFDB fdb) $ \fdb' -> alloca $ \sizbuf -> do key' <- keyToInt key vbuf <- c_tcfdbget fdb' key' sizbuf vsize <- peek sizbuf flip maybePeek vbuf $ \vbuf' -> peekPtrLen (vbuf', vsize) -- | Return the byte size of value in a record. vsiz :: (Key k) => FDB -> k -> IO (Maybe Int) vsiz fdb key = withForeignPtr (unTCFDB fdb) $ \fdb' -> do vsize <- c_tcfdbvsiz fdb' =<< keyToInt key return $ if vsize == (-1) then Nothing else Just (fromIntegral vsize) -- | Initialize the iterator of a FDB object. iterinit :: FDB -> IO Bool iterinit fdb = withForeignPtr (unTCFDB fdb) c_tcfdbiterinit -- | Return the next key of the iterator of a FDB object. iternext :: (Key k) => FDB -> IO (Maybe k) iternext fdb = withForeignPtr (unTCFDB fdb) $ \fdb' -> do i <- c_tcfdbiternext fdb' return $ if i == 0 then Nothing else Just (fromID $ ID i) -- | Return list of keys in the specified range. range :: (Key k1, Key k2) => FDB -- ^ FDB object -> k1 -- ^ the lower limit of the range. -> k1 -- ^ the upper limit of the range. -> Int -- ^ the maximum number of keys to be fetched. -> IO [k2] -- ^ keys in the specified range. range fdb lower upper maxn = withForeignPtr (unTCFDB fdb) $ \fdb' -> alloca $ \sizbuf -> do [l, u] <- mapM keyToInt [lower, upper] rp <- c_tcfdbrange fdb' l u (fromIntegral maxn) sizbuf size <- fromIntegral `fmap` peek sizbuf keys <- peekArray size rp free rp return $ map (fromID . ID) keys -- | Return list of forward matched keys. fwmkeys :: (Storable k1, Storable k2, Sequence q) => FDB -> k1 -> Int -> IO (q k2) fwmkeys fdb k maxn = smap fromString =<< fwmkeys' fdb k maxn where fwmkeys' = fwmHelper c_tcfdbrange4 unTCFDB -- | Increment the corresponding value. (The value specified by a key -- is treated as integer.) addint :: (Key k) => FDB -> k -> Int -> IO (Maybe Int) addint fdb key num = withForeignPtr (unTCFDB fdb) $ \fdb' -> do key' <- keyToInt key sumval <- c_tcfdbaddint fdb' key' (fromIntegral num) return $ if sumval == cINT_MIN then Nothing else Just $ fromIntegral sumval -- | Increment the corresponding value. (The value specified by a key -- is treated as double.) adddouble :: (Key k) => FDB -> k -> Double -> IO (Maybe Double) adddouble fdb key num = withForeignPtr (unTCFDB fdb) $ \fdb' -> do key' <- keyToInt key sumval <- c_tcfdbadddouble fdb' key' (realToFrac num) return $ if isNaN sumval then Nothing else Just $ realToFrac sumval -- | Synchronize updated contents of a database object with the file -- and the device. sync :: FDB -> IO Bool sync fdb = withForeignPtr (unTCFDB fdb) c_tcfdbsync -- | Optimize the file of a Hash database object. optimize :: FDB -> Int32 -> Int64 -> IO Bool optimize fdb width limsiz = withForeignPtr (unTCFDB fdb) $ \fdb' -> c_tcfdboptimize fdb' width limsiz -- | Delete all records. vanish :: FDB -> IO Bool vanish fdb = withForeignPtr (unTCFDB fdb) c_tcfdbvanish -- | Copy the database file. copy :: FDB -> String -> IO Bool copy = copyHelper c_tcfdbcopy unTCFDB -- | Return the file path of currentry opened database. path :: FDB -> IO (Maybe String) path = pathHelper c_tcfdbpath unTCFDB -- | Return the number of records in the database. rnum :: FDB -> IO Word64 rnum fdb = withForeignPtr (unTCFDB fdb) c_tcfdbrnum -- | Return the size of the database file. fsiz :: FDB -> IO Word64 fsiz fdb = withForeignPtr (unTCFDB fdb) c_tcfdbfsiz keyToInt :: (Key k) => k -> IO Int64 keyToInt i = catchJust selector (evaluate (unID . toID $ i)) handler where selector :: ErrorCall -> Maybe () selector e = if show e == "Prelude.read: no parse" then Just () else Nothing handler _ = error "Database.TokyoCabinet.FDB: invalid key" tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/FDB/000077500000000000000000000000001126071621700223255ustar00rootroot00000000000000tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/FDB/C.hsc000066400000000000000000000130331126071621700232060ustar00rootroot00000000000000{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} module Database.TokyoCabinet.FDB.C where import Foreign.Ptr import Foreign.C.Types import Foreign.C.String import Data.Int import Data.Word import Data.Bits import Database.TokyoCabinet.List.C (LIST) #include data OpenMode = OREADER | OWRITER | OCREAT | OTRUNC | ONOLCK | OLCKNB deriving (Eq, Ord, Show) openModeToCInt :: OpenMode -> CInt openModeToCInt OREADER = #const FDBOREADER openModeToCInt OWRITER = #const FDBOWRITER openModeToCInt OCREAT = #const FDBOCREAT openModeToCInt OTRUNC = #const FDBOTRUNC openModeToCInt ONOLCK = #const FDBONOLCK openModeToCInt OLCKNB = #const FDBOLCKNB combineOpenMode :: [OpenMode] -> CInt combineOpenMode = foldr ((.|.) . openModeToCInt) 0 data ID = IDMIN | IDPREV | IDMAX | IDNEXT | ID Int64 deriving (Eq, Ord) instance Show ID where show IDMIN = "min" show IDPREV = "prev" show IDMAX = "max" show IDNEXT = "next" show (ID i) = show i unID :: ID -> Int64 unID IDMIN = #const FDBIDMIN unID IDPREV = #const FDBIDPREV unID IDMAX = #const FDBIDMAX unID IDNEXT = #const FDBIDNEXT unID (ID int) = int data FDB' foreign import ccall safe "tcfdberrmsg" c_tcfdberrmsg :: CInt -> CString foreign import ccall safe "tcfdbnew" c_tcfdbnew :: IO (Ptr FDB') foreign import ccall safe "tcfdbdel" c_tcfdbdel :: Ptr FDB' -> IO () foreign import ccall safe "&tcfdbdel" tcfdbFinalizer :: FunPtr (Ptr FDB' -> IO ()) foreign import ccall safe "tcfdbecode" c_tcfdbecode :: Ptr FDB' -> IO CInt foreign import ccall safe "tcfdbsetmutex" c_tcfdbsetmutex :: Ptr FDB' -> IO Bool foreign import ccall safe "tcfdbtune" c_tcfdbtune :: Ptr FDB' -> Int32 -> Int64 -> IO Bool foreign import ccall safe "tcfdbopen" c_tcfdbopen :: Ptr FDB' -> CString -> CInt -> IO Bool foreign import ccall safe "tcfdbclose" c_tcfdbclose :: Ptr FDB' -> IO Bool foreign import ccall safe "tcfdbput" c_tcfdbput :: Ptr FDB' -> Int64 -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tcfdbput2" c_tcfdbput2 :: Ptr FDB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tcfdbput3" c_tcfdbput3 :: Ptr FDB' -> CString -> CString -> IO Bool foreign import ccall safe "tcfdbputkeep" c_tcfdbputkeep :: Ptr FDB' -> Int64 -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tcfdbputkeep2" c_tcfdbputkeep2 :: Ptr FDB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tcfdbputkeep3" c_tcfdbputkeep3 :: Ptr FDB' -> CString -> CString -> IO Bool foreign import ccall safe "tcfdbputcat" c_tcfdbputcat :: Ptr FDB' -> Int64 -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tcfdbputcat2" c_tcfdbputcat2 :: Ptr FDB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tcfdbputcat3" c_tcfdbputcat3 :: Ptr FDB' -> CString -> CString -> IO Bool foreign import ccall safe "tcfdbout" c_tcfdbout :: Ptr FDB' -> Int64 -> IO Bool foreign import ccall safe "tcfdbout2" c_tcfdbout2 :: Ptr FDB' -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tcfdbout3" c_tcfdbout3 :: Ptr FDB' -> CString -> IO Bool foreign import ccall safe "tcfdbget" c_tcfdbget :: Ptr FDB' -> Int64 -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tcfdbget2" c_tcfdbget2 :: Ptr FDB' -> Ptr Word8 -> CInt -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tcfdbget3" c_tcfdbget3 :: Ptr FDB' -> CString -> IO CString foreign import ccall safe "tcfdbget4" c_tcfdbget4 :: Ptr FDB' -> Int64 -> Ptr Word8 -> CInt -> IO CInt foreign import ccall safe "tcfdbvsiz" c_tcfdbvsiz :: Ptr FDB' -> Int64 -> IO CInt foreign import ccall safe "tcfdbvsiz2" c_tcfdbvsiz2 :: Ptr FDB' -> Ptr Word8 -> CInt -> IO CInt foreign import ccall safe "tcfdbvsiz3" c_tcfdbvsiz3 :: Ptr FDB' -> CString -> IO CInt foreign import ccall safe "tcfdbiterinit" c_tcfdbiterinit :: Ptr FDB' -> IO Bool foreign import ccall safe "tcfdbiternext" c_tcfdbiternext :: Ptr FDB' -> IO Int64 foreign import ccall safe "tcfdbiternext2" c_tcfdbiternext2 :: Ptr FDB' -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tcfdbiternext3" c_tcfdbiternext3 :: Ptr FDB' -> IO CString foreign import ccall safe "tcfdbrange" c_tcfdbrange :: Ptr FDB' -> Int64 -> Int64 -> CInt -> Ptr CInt -> IO (Ptr Int64) foreign import ccall safe "tcfdbrange2" c_tcfdbrange2 :: Ptr FDB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> CInt -> IO (Ptr LIST) foreign import ccall safe "tcfdbrange3" c_tcfdbrange3 :: Ptr FDB' -> CString -> CString -> CInt -> IO (Ptr LIST) foreign import ccall safe "tcfdbrange4" c_tcfdbrange4 :: Ptr FDB' -> Ptr Word8 -> CInt -> CInt -> IO (Ptr LIST) foreign import ccall safe "tcfdbrange5" c_tcfdbrange5 :: Ptr FDB' -> Ptr Word8 -> CInt -> IO (Ptr LIST) foreign import ccall safe "tcfdbaddint" c_tcfdbaddint :: Ptr FDB' -> Int64 -> CInt -> IO CInt foreign import ccall safe "tcfdbadddouble" c_tcfdbadddouble :: Ptr FDB' -> Int64 -> CDouble -> IO CDouble foreign import ccall safe "tcfdbsync" c_tcfdbsync :: Ptr FDB' -> IO Bool foreign import ccall safe "tcfdboptimize" c_tcfdboptimize :: Ptr FDB' -> Int32 -> Int64 -> IO Bool foreign import ccall safe "tcfdbvanish" c_tcfdbvanish :: Ptr FDB' -> IO Bool foreign import ccall safe "tcfdbcopy" c_tcfdbcopy :: Ptr FDB' -> CString -> IO Bool foreign import ccall safe "tcfdbpath" c_tcfdbpath :: Ptr FDB' -> IO CString foreign import ccall safe "tcfdbrnum" c_tcfdbrnum :: Ptr FDB' -> IO Word64 foreign import ccall safe "tcfdbfsiz" c_tcfdbfsiz :: Ptr FDB' -> IO Word64 tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/FDB/Key.hs000066400000000000000000000023551126071621700234160ustar00rootroot00000000000000{-# LANGUAGE TypeSynonymInstances #-} module Database.TokyoCabinet.FDB.Key (Key(..), ID(..)) where import Database.TokyoCabinet.FDB.C (ID(..), unID) import Data.Int import Data.Word class Key a where toID :: a -> ID fromID :: ID -> a instance Key Int where toID = ID . fromIntegral fromID = fromIntegral . unID instance Key Int8 where toID = ID . fromIntegral fromID = fromIntegral . unID instance Key Int16 where toID = ID . fromIntegral fromID = fromIntegral . unID instance Key Int32 where toID = ID . fromIntegral fromID = fromIntegral . unID instance Key Int64 where toID = ID fromID = fromIntegral . unID instance Key Word8 where toID = ID . fromIntegral fromID = fromIntegral . unID instance Key Word16 where toID = ID . fromIntegral fromID = fromIntegral . unID instance Key Word32 where toID = ID . fromIntegral fromID = fromIntegral . unID instance Key Word64 where toID = ID . fromIntegral fromID = fromIntegral . unID instance Key ID where toID = id fromID = id instance Key String where toID "min" = IDMIN toID "max" = IDMAX toID "prev" = IDPREV toID "next" = IDNEXT toID idstr = ID (read idstr) fromID = show . unID tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/HDB.hs000066400000000000000000000175511126071621700226740ustar00rootroot00000000000000-- | Interface to Hash based DBM. See also, -- for details module Database.TokyoCabinet.HDB ( -- $doc -- * Constructors HDB , ECODE(..) , OpenMode(..) , TuningOption(..) -- * Basic API (tokyocabinet.idl compliant) , new , delete , ecode , errmsg , tune , setcache , setxmsiz , open , close , put , putkeep , putcat , putasync , out , get , vsiz , iterinit , iternext , fwmkeys , addint , adddouble , sync , optimize , vanish , copy , tranbegin , trancommit , tranabort , path , rnum , fsiz ) where import Foreign.ForeignPtr import Data.Int import Data.Word import Database.TokyoCabinet.HDB.C import Database.TokyoCabinet.Error import Database.TokyoCabinet.Internal import Database.TokyoCabinet.Sequence import Database.TokyoCabinet.Storable -- $doc -- Example -- -- @ -- import Control.Monad -- import Database.TokyoCabinet.HDB -- @ -- -- @ -- main = do hdb <- new -- -- open the database -- open hdb \"casket.tch\" [OWRITER, OCREAT] >>= err hdb -- -- store records -- puts hdb [(\"foo\", \"hop\"), (\"bar\", \"step\"), (\"baz\", \"jump\")] >>= -- err hdb . (all id) -- -- retrieve records -- get_print hdb \"foo\" -- -- traverse records -- iterinit hdb -- iter hdb >>= mapM_ (\k -> putStr (k++\":\") >> get_print hdb k) -- -- close the database -- close hdb >>= err hdb -- where -- puts :: HDB -> [(String, String)] -> IO [Bool] -- puts hdb = mapM (uncurry $ put hdb) -- @ -- -- @ -- get_print :: HDB -> String -> IO () -- get_print hdb key = get hdb key >>= -- maybe (error \"something goes wrong\") putStrLn -- @ -- -- @ -- err :: HDB -> Bool -> IO () -- err hdb = flip unless $ ecode hdb >>= error . show -- @ -- -- @ -- iter :: HDB -> IO [String] -- iter hdb = iternext hdb >>= -- maybe (return []) (\x -> return . (x:) =<< iter hdb) -- @ -- data HDB = HDB { unTCHDB :: !(ForeignPtr HDB') } -- | Create a Hash database object. new :: IO HDB new = HDB `fmap` (c_tchdbnew >>= newForeignPtr tchdbFinalizer) -- | Free HDB resource forcibly. -- HDB is kept by ForeignPtr, so Haskell runtime GC cleans up memory for -- almost situation. Most always, you don't need to call this. -- After call this, you must not touch HDB object. Its behavior is undefined. delete :: HDB -> IO () delete hdb = finalizeForeignPtr (unTCHDB hdb) -- | Return the last happened error code. ecode :: HDB -> IO ECODE ecode hdb = cintToError `fmap` withForeignPtr (unTCHDB hdb) c_tchdbecode -- | Set the tuning parameters. tune :: HDB -- ^ HDB object -> Int64 -- ^ the number of elements of the bucket array. -> Int8 -- ^ the size of record alignment by power of 2. -> Int8 -- ^ the maximum number of elements of the free block -- pool by power of 2. -> [TuningOption] -- ^ tuning options. -> IO Bool -- ^ if successful, the return value is True. tune hdb bnum apow fpow options = withForeignPtr (unTCHDB hdb) $ \p -> c_tchdbtune p bnum apow fpow (combineTuningOption options) -- | Set the caching parameters. setcache :: HDB -- ^ HDB object. -> Int32 -- ^ the maximum number of records to be cached. -> IO Bool -- ^ if successful, the return value is True. setcache hdb rcnum = withForeignPtr (unTCHDB hdb) (flip c_tchdbsetcache rcnum) -- | Set the size of extra mapped memory. setxmsiz :: HDB -> Int64 -> IO Bool setxmsiz hdb xmsiz = withForeignPtr (unTCHDB hdb) (flip c_tchdbsetxmsiz xmsiz) -- | Open a database file. open :: HDB -> String -> [OpenMode] -> IO Bool open = openHelper c_tchdbopen unTCHDB combineOpenMode -- | Close the database file. close :: HDB -> IO Bool close hdb = withForeignPtr (unTCHDB hdb) c_tchdbclose -- | Stora a record (key-value pair) on HDB. Key and value type must -- be instance of Storable class. Usually, we can use `String', -- `ByteString' for key, `String', `ByteString', `Int', `Double' for -- value. put :: (Storable k, Storable v) => HDB -> k -> v -> IO Bool put = putHelper c_tchdbput unTCHDB -- | Store a new record. If a record with the same key exists in the -- database, this function has no effect. putkeep :: (Storable k, Storable v) => HDB -> k -> v -> IO Bool putkeep = putHelper c_tchdbputkeep unTCHDB -- | Concatenate a value at the end of the existing record. putcat :: (Storable k, Storable v) => HDB -> k -> v -> IO Bool putcat = putHelper c_tchdbputcat unTCHDB -- | Store a record into a hash database object in asynchronous fashion. putasync :: (Storable k, Storable v) => HDB -> k -> v -> IO Bool putasync = putHelper c_tchdbputasync unTCHDB -- | Delete a record. out :: (Storable k) => HDB -> k -> IO Bool out = outHelper c_tchdbout unTCHDB -- | Return the value of record. get :: (Storable k, Storable v) => HDB -> k -> IO (Maybe v) get = getHelper c_tchdbget unTCHDB -- | Return the byte size of value in a record. vsiz :: (Storable k) => HDB -> k -> IO (Maybe Int) vsiz = vsizHelper c_tchdbvsiz unTCHDB -- | Initialize the iterator of a HDB object. iterinit :: HDB -> IO Bool iterinit hdb = withForeignPtr (unTCHDB hdb) c_tchdbiterinit -- | Return the next key of the iterator of a HDB object. iternext :: (Storable k) => HDB -> IO (Maybe k) iternext = iternextHelper c_tchdbiternext unTCHDB -- | Return list of forward matched keys. fwmkeys :: (Storable k1, Storable k2, Sequence q) => HDB -> k1 -> Int -> IO (q k2) fwmkeys = fwmHelper c_tchdbfwmkeys unTCHDB -- | Increment the corresponding value. (The value specified by a key -- is treated as integer.) addint :: (Storable k) => HDB -> k -> Int -> IO (Maybe Int) addint = addHelper c_tchdbaddint unTCHDB fromIntegral fromIntegral (== cINT_MIN) -- | Increment the corresponding value. (The value specified by a key -- is treated as double.) adddouble :: (Storable k) => HDB -> k -> Double -> IO (Maybe Double) adddouble = addHelper c_tchdbadddouble unTCHDB realToFrac realToFrac isNaN -- | Synchronize updated contents of a database object with the file -- and the device. sync :: HDB -> IO Bool sync hdb = withForeignPtr (unTCHDB hdb) c_tchdbsync -- | Optimize the file of a Hash database object. optimize :: HDB -- ^ HDB object -> Int64 -- ^ the number of elements of the bucket array. -> Int8 -- ^ the size of record alignment by power of 2. -> Int8 -- ^ the maximum number of elements of the free block -- pool by power of 2. -> [TuningOption] -- ^ tuning options. -> IO Bool -- ^ if successful, the return value is True. optimize hdb bnum apow fpow options = withForeignPtr (unTCHDB hdb) $ \p -> c_tchdboptimize p bnum apow fpow (combineTuningOption options) -- | Delete all records. vanish :: HDB -> IO Bool vanish hdb = withForeignPtr (unTCHDB hdb) c_tchdbvanish -- | Copy the database file. copy :: HDB -> String -> IO Bool copy = copyHelper c_tchdbcopy unTCHDB -- | Begin the transaction. tranbegin :: HDB -> IO Bool tranbegin hdb = withForeignPtr (unTCHDB hdb) c_tchdbtranbegin -- | Commit the transaction. trancommit :: HDB -> IO Bool trancommit hdb = withForeignPtr (unTCHDB hdb) c_tchdbtrancommit -- | Abort the transaction. tranabort :: HDB -> IO Bool tranabort hdb = withForeignPtr (unTCHDB hdb) c_tchdbtranabort -- | Return the file path of currentry opened database. path :: HDB -> IO (Maybe String) path = pathHelper c_tchdbpath unTCHDB -- | Return the number of records in the database. rnum :: HDB -> IO Word64 rnum hdb = withForeignPtr (unTCHDB hdb) c_tchdbrnum -- | Return the size of the database file. fsiz :: HDB -> IO Word64 fsiz hdb = withForeignPtr (unTCHDB hdb) c_tchdbfsiz tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/HDB/000077500000000000000000000000001126071621700223275ustar00rootroot00000000000000tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/HDB/C.hsc000066400000000000000000000114441126071621700232140ustar00rootroot00000000000000{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} module Database.TokyoCabinet.HDB.C where import Foreign.Ptr import Foreign.C.Types import Foreign.C.String import Data.Int import Data.Word import Data.Bits import Database.TokyoCabinet.List.C (LIST) #include data OpenMode = OREADER | OWRITER | OCREAT | OTRUNC | ONOLCK | OLCKNB | OTSYNC deriving (Eq, Ord, Show) openModeToCInt :: OpenMode -> CInt openModeToCInt OREADER = #const HDBOREADER openModeToCInt OWRITER = #const HDBOWRITER openModeToCInt OCREAT = #const HDBOCREAT openModeToCInt OTRUNC = #const HDBOTRUNC openModeToCInt ONOLCK = #const HDBONOLCK openModeToCInt OLCKNB = #const HDBOLCKNB openModeToCInt OTSYNC = #const HDBOTSYNC combineOpenMode :: [OpenMode] -> CInt combineOpenMode = foldr ((.|.) . openModeToCInt) 0 data TuningOption = TLARGE | TDEFLATE | TBZIP | TTCBS | TEXCODEC deriving (Eq, Ord, Show) tuningOptionToWord8 :: TuningOption -> Word8 tuningOptionToWord8 TLARGE = #const HDBTLARGE tuningOptionToWord8 TDEFLATE = #const HDBTDEFLATE tuningOptionToWord8 TBZIP = #const HDBTBZIP tuningOptionToWord8 TTCBS = #const HDBTTCBS tuningOptionToWord8 TEXCODEC = #const HDBTEXCODEC combineTuningOption :: [TuningOption] -> Word8 combineTuningOption = foldr ((.|.) . tuningOptionToWord8) 0 data HDB' foreign import ccall "&tchdbdel" tchdbFinalizer :: FunPtr (Ptr HDB' -> IO ()) foreign import ccall safe "tchdbnew" c_tchdbnew :: IO (Ptr HDB') foreign import ccall safe "tchdbdel" c_tchdbdel :: Ptr HDB' -> IO () foreign import ccall safe "tchdbecode" c_tchdbecode :: Ptr HDB' -> IO CInt foreign import ccall safe "tchdbtune" c_tchdbtune :: Ptr HDB' -> Int64 -> Int8 -> Int8 -> Word8 -> IO Bool foreign import ccall safe "tchdbsetcache" c_tchdbsetcache :: Ptr HDB' -> Int32 -> IO Bool foreign import ccall safe "tchdbsetxmsiz" c_tchdbsetxmsiz :: Ptr HDB' -> Int64 -> IO Bool foreign import ccall safe "tchdbopen" c_tchdbopen :: Ptr HDB' -> CString -> CInt -> IO Bool foreign import ccall safe "tchdbclose" c_tchdbclose :: Ptr HDB' -> IO Bool foreign import ccall safe "tchdbput" c_tchdbput :: Ptr HDB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tchdbput2" c_tchdbput2 :: Ptr HDB' -> CString -> CString -> IO Bool foreign import ccall safe "tchdbputkeep" c_tchdbputkeep :: Ptr HDB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tchdbputkeep2" c_tchdbputkeep2 :: Ptr HDB' -> CString -> CString -> IO Bool foreign import ccall safe "tchdbputcat" c_tchdbputcat :: Ptr HDB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tchdbputcat2" c_tchdbputcat2 :: Ptr HDB' -> CString -> CString -> IO Bool foreign import ccall safe "tchdbputasync" c_tchdbputasync :: Ptr HDB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tchdbout" c_tchdbout :: Ptr HDB' -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tchdbout2" c_tchdbout2 :: Ptr HDB' -> CString -> IO Bool foreign import ccall safe "tchdbget" c_tchdbget :: Ptr HDB' -> Ptr Word8 -> CInt -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tchdbget2" c_tchdbget2 :: Ptr HDB' -> CString -> IO CString foreign import ccall safe "tchdbvsiz" c_tchdbvsiz :: Ptr HDB' -> Ptr Word8 -> CInt -> IO CInt foreign import ccall safe "tchdbiterinit" c_tchdbiterinit :: Ptr HDB' -> IO Bool foreign import ccall safe "tchdbiternext" c_tchdbiternext :: Ptr HDB' -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tchdbiternext2" c_tchdbiternext2 :: Ptr HDB' -> IO CString foreign import ccall safe "tchdbfwmkeys" c_tchdbfwmkeys :: Ptr HDB' -> Ptr Word8 -> CInt -> CInt -> IO (Ptr LIST) foreign import ccall safe "tchdbaddint" c_tchdbaddint :: Ptr HDB' -> Ptr Word8 -> CInt -> CInt -> IO CInt foreign import ccall safe "tchdbadddouble" c_tchdbadddouble :: Ptr HDB' -> Ptr Word8 -> CInt -> CDouble -> IO CDouble foreign import ccall safe "tchdbsync" c_tchdbsync :: Ptr HDB' -> IO Bool foreign import ccall safe "tchdboptimize" c_tchdboptimize :: Ptr HDB' -> Int64 -> Int8 -> Int8 -> Word8 -> IO Bool foreign import ccall safe "tchdbvanish" c_tchdbvanish :: Ptr HDB' -> IO Bool foreign import ccall safe "tchdbcopy" c_tchdbcopy :: Ptr HDB' -> CString -> IO Bool foreign import ccall safe "tchdbtranbegin" c_tchdbtranbegin :: Ptr HDB' -> IO Bool foreign import ccall safe "tchdbtrancommit" c_tchdbtrancommit :: Ptr HDB' -> IO Bool foreign import ccall safe "tchdbtranabort" c_tchdbtranabort :: Ptr HDB' -> IO Bool foreign import ccall safe "tchdbpath" c_tchdbpath :: Ptr HDB' -> IO CString foreign import ccall safe "tchdbrnum" c_tchdbrnum :: Ptr HDB' -> IO Word64 foreign import ccall safe "tchdbfsiz" c_tchdbfsiz :: Ptr HDB' -> IO Word64 tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/Internal.hs000066400000000000000000000116661126071621700240540ustar00rootroot00000000000000module Database.TokyoCabinet.Internal where import Database.TokyoCabinet.List.C import Database.TokyoCabinet.Storable import Database.TokyoCabinet.Sequence import Foreign.Ptr import Foreign.ForeignPtr import Foreign.C.Types import Foreign.C.String import Foreign.Storable (peek) import Foreign.Marshal (alloca, copyBytes, mallocBytes) import Foreign.Marshal.Utils (maybePeek) import Data.Word type Lifter ptr tcdb = Ptr ptr -> tcdb type UnLifter tcdb fptr = tcdb -> ForeignPtr fptr type Combiner mode c_mode = [mode] -> c_mode type Caster a b = a -> b type Checker a = a -> Bool type FunOpen p c_mode = Ptr p -> CString -> c_mode -> IO Bool type FunPath p = Ptr p -> IO CString type FunCopy p = Ptr p -> CString -> IO Bool type FunPut p r = Ptr p -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO r type FunGet p = Ptr p -> Ptr Word8 -> CInt -> Ptr CInt -> IO (Ptr Word8) type FunOut p = Ptr p -> Ptr Word8 -> CInt -> IO Bool type FunAdd p n = Ptr p -> Ptr Word8 -> CInt -> n -> IO n type FunFwm p = Ptr p -> Ptr Word8 -> CInt -> CInt -> IO (Ptr LIST) type FunVsiz p = Ptr p -> Ptr Word8 -> CInt -> IO CInt type FunIterNext p = Ptr p -> Ptr CInt -> IO (Ptr Word8) openHelper :: FunOpen p c_mode -> UnLifter tcdb p -> Combiner mode c_mode -> tcdb -> String -> [mode] -> IO Bool openHelper opener unlifter combiner tcdb name modes = withForeignPtr (unlifter tcdb) $ \db -> withCString name $ \c_name -> opener db c_name (combiner modes) pathHelper :: FunPath p -> UnLifter tcdb p -> tcdb -> IO (Maybe String) pathHelper c_path unlifter tcdb = withForeignPtr (unlifter tcdb) $ \db -> c_path db >>= (maybePeek peekCString) copyHelper :: FunCopy p -> UnLifter tcdb p -> tcdb -> String -> IO Bool copyHelper c_copy unlifter tcdb fpath = withForeignPtr (unlifter tcdb) $ \db -> withCString fpath (c_copy db) putHelper :: (Storable a, Storable b) => FunPut p r -> UnLifter tcdb p -> tcdb -> a -> b -> IO r putHelper c_put unlifter tcdb key val = withForeignPtr (unlifter tcdb) $ \db -> withPtrLen key $ \(kbuf, ksize) -> withPtrLen val $ \(vbuf, vsize) -> c_put db kbuf ksize vbuf vsize getHelper :: (Storable a, Storable b) => FunGet p -> UnLifter tcdb p -> tcdb -> a -> IO (Maybe b) getHelper c_get unlifter tcdb key = withForeignPtr (unlifter tcdb) $ \db -> withPtrLen key $ \(kbuf, ksiz) -> alloca $ \sizbuf -> do vbuf <- c_get db kbuf ksiz sizbuf flip maybePeek vbuf $ \vp -> do siz <- peek sizbuf peekPtrLen (vp, siz) getHelper' :: (Storable a, Storable b) => FunGet p -> UnLifter tcdb p -> tcdb -> a -> IO (Maybe b) getHelper' c_get unlifter tcdb key = withForeignPtr (unlifter tcdb) $ \db -> withPtrLen key $ \(kbuf, ksiz) -> alloca $ \sizbuf -> do vbuf <- c_get db kbuf ksiz sizbuf flip maybePeek vbuf $ \vp -> do siz <- peek sizbuf buf <- mallocBytes (fromIntegral siz) copyBytes buf vp (fromIntegral siz) peekPtrLen (buf, siz) outHelper :: (Storable a) => FunOut p -> UnLifter tcdb p -> tcdb -> a -> IO Bool outHelper c_out unlifter tcdb key = withForeignPtr (unlifter tcdb) $ \db -> withPtrLen key $ \(kbuf, ksize) -> c_out db kbuf ksize addHelper :: (Storable a) => FunAdd p n -> UnLifter tcdb p -> Caster hv n -> Caster n hv -> Checker n -> tcdb -> a -> hv -> IO (Maybe hv) addHelper c_add unlifter cast_in cast_out check tcdb key num = withForeignPtr (unlifter tcdb) $ \db -> withPtrLen key $ \(kbuf, ksiz) -> do sumval <- c_add db kbuf ksiz (cast_in num) return $ if check sumval then Nothing else Just $ cast_out sumval fwmHelper :: (Storable a, Storable b, Sequence q) => FunFwm p -> UnLifter tcdb p -> tcdb -> a -> Int -> IO (q b) fwmHelper c_fwm unlifter tcdb key maxn = withForeignPtr (unlifter tcdb) $ \db -> withPtrLen key $ \(kbuf, ksiz) -> c_fwm db kbuf ksiz (fromIntegral maxn) >>= peekList' vsizHelper :: (Storable a) => FunVsiz p -> UnLifter tcdb p -> tcdb -> a -> IO (Maybe Int) vsizHelper c_vsiz unlifter tcdb key = withForeignPtr (unlifter tcdb) $ \db -> withPtrLen key $ \(kbuf, ksiz) -> do vsize <- c_vsiz db kbuf ksiz return $ if vsize == -1 then Nothing else Just (fromIntegral vsize) iternextHelper :: (Storable k) => FunIterNext p -> UnLifter tcdb p -> tcdb -> IO (Maybe k) iternextHelper c_iternext unlifter tcdb = withForeignPtr (unlifter tcdb) $ \p -> alloca $ \sizbuf -> do vbuf <- c_iternext p sizbuf flip maybePeek vbuf $ \vp -> do siz <- peek sizbuf peekPtrLen (vp, siz) tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/List.hs000066400000000000000000000112101126071621700231740ustar00rootroot00000000000000module Database.TokyoCabinet.List ( new , new2 , copy , delete , len , get , push , pop , unshift , shift , insert , remove , over , sort , lsearch , bsearch , clear , dump , load , List ) where import Foreign.Ptr import Foreign.ForeignPtr import Foreign.Storable (peek) import Foreign.Marshal (alloca, free, mallocBytes) import Foreign.Marshal.Utils (maybePeek, copyBytes) import Database.TokyoCabinet.List.C import Database.TokyoCabinet.Storable import Data.ByteString.Unsafe import qualified Data.ByteString as B new :: IO (List a) new = c_tclistnew >>= newForeignPtr tclistFinalizer >>= return . List new2 :: Int -> IO (List a) new2 n = do l <- c_tclistnew2 (fromIntegral n) p <- newForeignPtr tclistFinalizer l return $ List p copy :: List a -> IO (List a) copy tcls = withForeignPtr (unTCList tcls) $ \p -> do l <- c_tclistdup p List `fmap` newForeignPtr tclistFinalizer l delete :: List a -> IO () delete tcls = finalizeForeignPtr (unTCList tcls) len :: List a -> IO Int len tcls = withForeignPtr (unTCList tcls) $ \p -> do n <- c_tclistnum p return $ fromIntegral n get :: (Storable a) => List a -> Int -> IO (Maybe a) get tcls index = withForeignPtr (unTCList tcls) $ \p -> alloca $ \sizbuf -> do vbuf <- c_tclistval p (fromIntegral index) sizbuf flip maybePeek vbuf $ \vp -> do siz <- peek sizbuf buf <- mallocBytes (fromIntegral siz) copyBytes buf vp (fromIntegral siz) peekPtrLen (buf, fromIntegral siz) push :: (Storable a) => List a -> a -> IO () push tcls val = withForeignPtr (unTCList tcls) $ \p -> withPtrLen val $ \(vbuf, vsiz) -> c_tclistpush p (castPtr vbuf) (fromIntegral vsiz) pop :: (Storable a) => List a -> IO (Maybe a) pop tcls = withForeignPtr (unTCList tcls) $ \p -> alloca $ \sizbuf -> do vbuf <- c_tclistpop p sizbuf flip maybePeek vbuf $ \vp -> do siz <- peek sizbuf peekPtrLen (vp, fromIntegral siz) unshift :: (Storable a) => List a -> a -> IO () unshift tcls val = withForeignPtr (unTCList tcls) $ \p -> withPtrLen val $ \(vbuf, vsiz) -> c_tclistunshift p (castPtr vbuf) (fromIntegral vsiz) shift :: (Storable a) => List a -> IO (Maybe a) shift tcls = withForeignPtr (unTCList tcls) $ \p -> alloca $ \sizbuf -> do vbuf <- c_tclistshift p sizbuf flip maybePeek vbuf $ \vp -> do siz <- peek sizbuf peekPtrLen (vp, fromIntegral siz) insert :: (Storable a) => List a -> Int -> a -> IO () insert tcls index val = withForeignPtr (unTCList tcls) $ \p -> withPtrLen val $ \(vbuf, vsiz) -> c_tclistinsert p (fromIntegral index) (castPtr vbuf) (fromIntegral vsiz) remove :: (Storable a) => List a -> Int -> IO (Maybe a) remove tcls index = withForeignPtr (unTCList tcls) $ \p -> alloca $ \sizbuf -> do vbuf <- c_tclistremove p (fromIntegral index) sizbuf flip maybePeek vbuf $ \vp -> do siz <- peek sizbuf peekPtrLen (vp, fromIntegral siz) over :: (Storable a) => List a -> Int -> a -> IO () over tcls index val = withForeignPtr (unTCList tcls) $ \p -> withPtrLen val $ \(vbuf, vsiz) -> c_tclistover p (fromIntegral index) (castPtr vbuf) (fromIntegral vsiz) sort :: List a -> IO () sort tcls = withForeignPtr (unTCList tcls) c_tclistsort lsearch :: (Storable a) => List a -> a -> IO Int lsearch tcls key = withForeignPtr (unTCList tcls) $ \p -> withPtrLen key $ \(kbuf, ksiz) -> fmap fromIntegral $ c_tclistlsearch p (castPtr kbuf) (fromIntegral ksiz) bsearch :: (Storable a) => List a -> a -> IO Int bsearch tcls key = withForeignPtr (unTCList tcls) $ \p -> withPtrLen key $ \(kbuf, ksiz) -> fmap fromIntegral $ c_tclistbsearch p (castPtr kbuf) (fromIntegral ksiz) clear :: List a -> IO () clear tcls = withForeignPtr (unTCList tcls) c_tclistclear dump :: List a -> IO B.ByteString dump tcls = withForeignPtr (unTCList tcls) $ \p -> alloca $ \sizbuf -> do c_str <- c_tclistdump p sizbuf size <- fromIntegral `fmap` peek sizbuf unsafePackCStringFinalizer (castPtr c_str) size (free c_str) load :: B.ByteString -> IO (List a) load bytes = unsafeUseAsCStringLen bytes $ \(buf, siz) -> do tclis <- c_tclistload (castPtr buf) (fromIntegral siz) List `fmap` newForeignPtr tclistFinalizer tclis tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/List/000077500000000000000000000000001126071621700226455ustar00rootroot00000000000000tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/List/C.hs000066400000000000000000000054771126071621700234000ustar00rootroot00000000000000{-# INCLUDE #-} {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} module Database.TokyoCabinet.List.C where import Data.Word import Foreign.Ptr import Foreign.C.Types import Foreign.C.String import Foreign.ForeignPtr data List a = List { unTCList :: !(ForeignPtr LIST) } data LIST foreign import ccall safe "tclistnew" c_tclistnew :: IO (Ptr LIST) foreign import ccall safe "tclistnew2" c_tclistnew2 :: CInt -> IO (Ptr LIST) foreign import ccall safe "tclistdup" c_tclistdup :: Ptr LIST -> IO (Ptr LIST) foreign import ccall safe "tclistdel" c_tclistdel :: Ptr LIST -> IO () foreign import ccall "&tclistdel" tclistFinalizer :: FunPtr (Ptr LIST -> IO ()) foreign import ccall safe "tclistnum" c_tclistnum :: Ptr LIST -> IO CInt foreign import ccall safe "tclistval" c_tclistval :: Ptr LIST -> CInt -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tclistval2" c_tclistval2 :: Ptr LIST -> CInt -> IO CString foreign import ccall safe "tclistpush" c_tclistpush :: Ptr LIST -> Ptr Word8 -> CInt -> IO () foreign import ccall safe "tclistpush2" c_tclistpush2 :: Ptr LIST -> CString -> IO () foreign import ccall safe "tclistpop" c_tclistpop :: Ptr LIST -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tclistpop2" c_tclistpop2 :: Ptr LIST -> IO CString foreign import ccall safe "tclistunshift" c_tclistunshift :: Ptr LIST -> Ptr Word8 -> CInt -> IO () foreign import ccall safe "tclistunshift2" c_tclistunshift2 :: Ptr LIST -> Ptr Word8 -> IO () foreign import ccall safe "tclistshift" c_tclistshift :: Ptr LIST -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tclistshift2" c_tclistshift2 :: Ptr LIST -> IO CString foreign import ccall safe "tclistinsert" c_tclistinsert :: Ptr LIST -> CInt -> Ptr Word8 -> CInt -> IO () foreign import ccall safe "tclistinsert2" c_tclistinsert2 :: Ptr LIST -> CInt -> Ptr Word8 -> IO () foreign import ccall safe "tclistremove" c_tclistremove :: Ptr LIST -> CInt -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tclistremove2" c_tclistremove2 :: Ptr LIST -> CInt -> IO CString foreign import ccall safe "tclistover" c_tclistover :: Ptr LIST -> CInt -> Ptr Word8 -> CInt -> IO () foreign import ccall safe "tclistover2" c_tclistover2 :: Ptr LIST -> CInt -> CString -> IO () foreign import ccall safe "tclistsort" c_tclistsort :: Ptr LIST -> IO () foreign import ccall safe "tclistlsearch" c_tclistlsearch :: Ptr LIST -> Ptr Word8 -> CInt -> IO CInt foreign import ccall safe "tclistbsearch" c_tclistbsearch :: Ptr LIST -> Ptr Word8 -> CInt -> IO CInt foreign import ccall safe "tclistclear" c_tclistclear :: Ptr LIST -> IO () foreign import ccall safe "tclistdump" c_tclistdump :: Ptr LIST -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tclistload" c_tclistload :: Ptr Word8 -> CInt -> IO (Ptr LIST) tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/Map.hs000066400000000000000000000073011126071621700230040ustar00rootroot00000000000000module Database.TokyoCabinet.Map ( new , new2 , dup , delete , put , putkeep , putcat , out , get , move , iterinit , iternext , rnum , msiz , keys , vals , addint , adddouble , clear , cutfront , dump , load , Map ) where import Database.TokyoCabinet.Map.C import Database.TokyoCabinet.Storable import Database.TokyoCabinet.Sequence import Database.TokyoCabinet.Internal import Database.TokyoCabinet.Error (cINT_MIN) import Data.Word import Foreign.Ptr import Foreign.ForeignPtr import Foreign.Storable (peek) import Foreign.Marshal (alloca, mallocBytes, free) import Foreign.Marshal.Utils (maybePeek, copyBytes) import Data.ByteString (ByteString) import Data.ByteString.Unsafe ( unsafeUseAsCStringLen , unsafePackCStringFinalizer ) new :: IO (Map k v) new = Map `fmap` (c_tcmapnew >>= newForeignPtr tcmapFinalizer) new2 :: Word32 -> IO (Map k v) new2 num = Map `fmap` (c_tcmapnew2 num >>= newForeignPtr tcmapFinalizer) dup :: Map k v -> IO (Map k v) dup m = withForeignPtr (unMap m) $ \m' -> Map `fmap` (c_tcmapdup m' >>= newForeignPtr tcmapFinalizer) delete :: Map k v -> IO () delete m = finalizeForeignPtr (unMap m) put :: (Storable k, Storable v) => Map k v -> k -> v -> IO () put = putHelper c_tcmapput unMap putkeep :: (Storable k, Storable v) => Map k v -> k -> v -> IO Bool putkeep = putHelper c_tcmapputkeep unMap putcat :: (Storable k, Storable v) => Map k v -> k -> v -> IO () putcat = putHelper c_tcmapputcat unMap out :: (Storable k) => Map k v -> k -> IO Bool out = outHelper c_tcmapout unMap get :: (Storable k, Storable v) => Map k v -> k -> IO (Maybe v) get = getHelper' c_tcmapget unMap move :: (Storable k) => Map k v -> k -> Bool -> IO Bool move m key hd = withForeignPtr (unMap m) $ \m' -> withPtrLen key $ \(kbuf, ksiz) -> c_tcmapmove m' kbuf ksiz hd iterinit :: Map k v -> IO () iterinit m = withForeignPtr (unMap m) c_tcmapiterinit iternext :: (Storable k) => Map k v -> IO (Maybe k) iternext m = withForeignPtr (unMap m) $ \p -> alloca $ \sizbuf -> do vbuf <- c_tcmapiternext p sizbuf flip maybePeek vbuf $ \vp -> do siz <- peek sizbuf buf <- mallocBytes (fromIntegral siz) copyBytes buf vp (fromIntegral siz) peekPtrLen (buf, siz) rnum :: Map k v -> IO Word64 rnum m = withForeignPtr (unMap m) c_tcmaprnum msiz :: Map k v -> IO Word64 msiz m = withForeignPtr (unMap m) c_tcmapmsiz keys :: (Storable k) => Map k v -> IO [k] keys m = withForeignPtr (unMap m) $ (>>= peekList') . c_tcmapkeys vals :: (Storable v) => Map k v -> IO [v] vals m = withForeignPtr (unMap m) $ (>>= peekList') . c_tcmapvals addint :: (Storable k) => Map k v -> k -> Int -> IO (Maybe Int) addint = addHelper c_tcmapaddint unMap fromIntegral fromIntegral (== cINT_MIN) adddouble :: (Storable k) => Map k v -> k -> Double -> IO (Maybe Double) adddouble = addHelper c_tcmapadddouble unMap realToFrac realToFrac isNaN clear :: Map k v -> IO () clear m = withForeignPtr (unMap m) c_tcmapclear cutfront :: Map k v -> Int -> IO () cutfront m num = withForeignPtr (unMap m) $ flip c_tcmapcutfront (fromIntegral num) dump :: Map k v -> IO ByteString dump m = withForeignPtr (unMap m) $ \m' -> alloca $ \sizbuf -> do buf <- c_tcmapdump m' sizbuf size <- fromIntegral `fmap` peek sizbuf unsafePackCStringFinalizer (castPtr buf) size (free buf) load :: ByteString -> IO (Map k v) load bytes = unsafeUseAsCStringLen bytes $ \(buf, siz) -> do m <- c_tcmapload (castPtr buf) (fromIntegral siz) Map `fmap` newForeignPtr tcmapFinalizer m tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/Map/000077500000000000000000000000001126071621700224475ustar00rootroot00000000000000tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/Map/C.hs000066400000000000000000000060541126071621700231720ustar00rootroot00000000000000{-# INCLUDE #-} {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} module Database.TokyoCabinet.Map.C where import Data.Word import Foreign.Ptr import Foreign.C.Types import Foreign.C.String import Foreign.ForeignPtr import Database.TokyoCabinet.List.C data Map k v = Map { unMap :: !(ForeignPtr MAP) } data MAP foreign import ccall safe "tcmapnew" c_tcmapnew :: IO (Ptr MAP) foreign import ccall safe "tcmapnew2" c_tcmapnew2 :: Word32 -> IO (Ptr MAP) foreign import ccall safe "tcmapdup" c_tcmapdup :: Ptr MAP -> IO (Ptr MAP) foreign import ccall safe "tcmapdel" c_tcmapdel :: Ptr MAP -> IO () foreign import ccall safe "&tcmapdel" tcmapFinalizer :: FunPtr (Ptr MAP -> IO ()) foreign import ccall safe "tcmapput" c_tcmapput :: Ptr MAP -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO () foreign import ccall safe "tcmapput2" c_tcmapput2 :: Ptr MAP -> CString -> CString -> IO () foreign import ccall safe "tcmapputkeep" c_tcmapputkeep :: Ptr MAP -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tcmapputkeep2" c_tcmapputkeep2 :: Ptr MAP -> CString -> CString -> IO Bool foreign import ccall safe "tcmapputcat" c_tcmapputcat :: Ptr MAP -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO () foreign import ccall safe "tcmapputcat2" c_tcmapputcat2 :: Ptr MAP -> CString -> CString -> IO () foreign import ccall safe "tcmapout" c_tcmapout :: Ptr MAP -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tcmapout2" c_tcmapout2 :: Ptr MAP -> CString -> IO Bool foreign import ccall safe "tcmapget" c_tcmapget :: Ptr MAP -> Ptr Word8 -> CInt -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tcmapget2" c_tcmapget2 :: Ptr MAP -> CString -> IO CString foreign import ccall safe "tcmapmove" c_tcmapmove :: Ptr MAP -> Ptr Word8 -> CInt -> Bool -> IO Bool foreign import ccall safe "tcmapmove2" c_tcmapmove2 :: Ptr MAP -> CString -> Bool -> IO Bool foreign import ccall safe "tcmapiterinit" c_tcmapiterinit :: Ptr MAP -> IO () foreign import ccall safe "tcmapiternext" c_tcmapiternext :: Ptr MAP -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tcmapiternext2" c_tcmapiternext2 :: Ptr MAP -> IO CString foreign import ccall safe "tcmaprnum" c_tcmaprnum :: Ptr MAP -> IO Word64 foreign import ccall safe "tcmapmsiz" c_tcmapmsiz :: Ptr MAP -> IO Word64 foreign import ccall safe "tcmapkeys" c_tcmapkeys :: Ptr MAP -> IO (Ptr LIST) foreign import ccall safe "tcmapvals" c_tcmapvals :: Ptr MAP -> IO (Ptr LIST) foreign import ccall safe "tcmapaddint" c_tcmapaddint :: Ptr MAP -> Ptr Word8 -> CInt -> CInt -> IO CInt foreign import ccall safe "tcmapadddouble" c_tcmapadddouble :: Ptr MAP -> Ptr Word8 -> CInt -> CDouble -> IO CDouble foreign import ccall safe "tcmapclear" c_tcmapclear :: Ptr MAP -> IO () foreign import ccall safe "tcmapcutfront" c_tcmapcutfront :: Ptr MAP -> CInt -> IO () foreign import ccall safe "tcmapdump" c_tcmapdump :: Ptr MAP -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tcmapload" c_tcmapload :: Ptr Word8 -> CInt -> IO (Ptr MAP) tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/Sequence.hs000066400000000000000000000044641126071621700240460ustar00rootroot00000000000000module Database.TokyoCabinet.Sequence where import Foreign.Ptr import Foreign.Storable (peek) import Foreign.Marshal (alloca, mallocBytes, copyBytes) import Foreign.ForeignPtr import Database.TokyoCabinet.List.C import Database.TokyoCabinet.Storable class Sequence a where withList :: (Storable s) => a s -> (Ptr LIST -> IO b) -> IO b peekList' :: (Storable s) => Ptr LIST -> IO (a s) empty :: (Storable s) => IO (a s) smap :: (Storable s1, Storable s2) => (s1 -> s2) -> a s1 -> IO (a s2) instance Sequence List where withList xs action = withForeignPtr (unTCList xs) action peekList' tcls = List `fmap` newForeignPtr tclistFinalizer tcls empty = List `fmap` (c_tclistnew >>= newForeignPtr tclistFinalizer) smap f tcls = withForeignPtr (unTCList tcls) $ \tcls' -> alloca $ \sizbuf -> do num <- c_tclistnum tcls' vals <- c_tclistnew loop tcls' 0 num sizbuf vals where loop tcls' n num sizbuf acc | n < num = do vbuf <- c_tclistval tcls' n sizbuf vsiz <- peek sizbuf buf <- mallocBytes (fromIntegral vsiz) copyBytes buf vbuf (fromIntegral vsiz) val <- f `fmap` peekPtrLen (buf, vsiz) withPtrLen val $ uncurry (c_tclistpush acc) loop tcls' (n+1) num sizbuf acc | otherwise = List `fmap` newForeignPtr tclistFinalizer acc instance Sequence [] where withList xs action = do list <- c_tclistnew mapM_ (push list) xs result <- action list c_tclistdel list return result where push list val = withPtrLen val $ uncurry (c_tclistpush list) peekList' tcls = do vals <- peekList'' tcls [] c_tclistdel tcls return vals where peekList'' lis acc = alloca $ \sizbuf -> do val <- c_tclistpop lis sizbuf siz <- peek sizbuf if val == nullPtr then return acc else do elm <- peekPtrLen (val, siz) peekList'' lis (elm:acc) empty = return [] smap f = return . (map f) tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/Storable.hs000066400000000000000000000134431126071621700240460ustar00rootroot00000000000000module Database.TokyoCabinet.Storable where import Data.Int import Data.Char import Data.Word import Foreign.Ptr import Foreign.C.Types import Foreign.C.String import Foreign.Marshal (peekArray, free) import Foreign.Marshal.Array (withArray) import Data.ByteString.Unsafe import qualified Foreign.Storable as F import qualified Data.ByteString.Char8 as C import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as LC import qualified Foreign.Marshal.Utils as U type PtrLen = (Ptr Word8, CInt) liftPL :: (a -> (CStringLen -> IO b) -> IO b) -> a -> (PtrLen -> IO b) -> IO b liftPL f val action = f val $ \(buf, siz) -> action (castPtr buf, fromIntegral siz) class (Show a, Read a) => Storable a where withPtrLen :: a -> (PtrLen -> IO b) -> IO b withPtrLenL :: [a] -> (PtrLen -> IO b) -> IO b peekPtrLenL :: PtrLen -> a -> IO [a] peekPtrLen :: PtrLen -> IO a toInt64 :: a -> Int64 toInt64L :: [a] -> Int64 fromString :: String -> a fromStringL :: String -> [a] toInt64 = read . show toInt64L = read . concatMap show fromString = read fromStringL = (:[]) . fromString withPtrLenL = undefined peekPtrLenL = undefined instance Storable C.ByteString where withPtrLen = liftPL unsafeUseAsCStringLen peekPtrLen (p, len) = unsafePackCStringFinalizer p (fromIntegral len) (free p) toInt64 = read . C.unpack fromString = C.pack instance Storable L.ByteString where withPtrLen = liftPL unsafeUseAsCStringLen . C.concat . L.toChunks peekPtrLen (p, len) = do xs <- peekArray (fromIntegral len) p free p return $ L.pack xs toInt64 = read . LC.unpack fromString = LC.pack withPtrLenForFStorable :: (F.Storable a) => a -> (PtrLen -> IO b) -> IO b withPtrLenForFStorable n f = U.with n $ \p -> f (castPtr p, fromIntegral $ F.sizeOf n) peekPtrLenForFStorable :: (F.Storable a) => PtrLen -> IO a peekPtrLenForFStorable (p, _) = do val <- F.peek (castPtr p) free p return val withPtrLenLForFStorable :: (F.Storable a) => [a] -> (PtrLen -> IO b) -> IO b withPtrLenLForFStorable xs f = withArray xs $ \p -> f (castPtr p, fromIntegral $ (F.sizeOf $ head xs) * length xs) peekPtrLenLForFStorable :: (F.Storable a) => PtrLen -> a -> IO [a] peekPtrLenLForFStorable (p, size) x = do peekArray (fromIntegral size `div` (F.sizeOf x)) (castPtr p) instance Storable Char where withPtrLen = withPtrLenForFStorable peekPtrLen = peekPtrLenForFStorable withPtrLenL = liftPL withCStringLen peekPtrLenL (buf, siz) _ = do val <- peekCStringLen (castPtr buf, fromIntegral siz) free buf return val toInt64 c | isDigit c = fromIntegral $ digitToInt c toInt64 c | otherwise = fromIntegral $ ord c toInt64L cs = read cs fromString str = read ('\'':str ++ "'") fromStringL = id instance Storable CInt where withPtrLen = withPtrLenForFStorable peekPtrLen = peekPtrLenForFStorable withPtrLenL = withPtrLenLForFStorable peekPtrLenL = peekPtrLenLForFStorable instance Storable Int where withPtrLen = withPtrLenForFStorable peekPtrLen = peekPtrLenForFStorable withPtrLenL = withPtrLenLForFStorable peekPtrLenL = peekPtrLenLForFStorable instance Storable CDouble where withPtrLen = withPtrLenForFStorable peekPtrLen = peekPtrLenForFStorable withPtrLenL = withPtrLenLForFStorable peekPtrLenL = peekPtrLenLForFStorable instance Storable Double where withPtrLen = withPtrLenForFStorable peekPtrLen = peekPtrLenForFStorable withPtrLenL = withPtrLenLForFStorable peekPtrLenL = peekPtrLenLForFStorable instance Storable CFloat where withPtrLen = withPtrLenForFStorable peekPtrLen = peekPtrLenForFStorable withPtrLenL = withPtrLenLForFStorable peekPtrLenL = peekPtrLenLForFStorable instance Storable Float where withPtrLen = withPtrLenForFStorable peekPtrLen = peekPtrLenForFStorable withPtrLenL = withPtrLenLForFStorable peekPtrLenL = peekPtrLenLForFStorable instance Storable Int8 where withPtrLen = withPtrLenForFStorable peekPtrLen = peekPtrLenForFStorable withPtrLenL = withPtrLenLForFStorable peekPtrLenL = peekPtrLenLForFStorable instance Storable Int16 where withPtrLen = withPtrLenForFStorable peekPtrLen = peekPtrLenForFStorable withPtrLenL = withPtrLenLForFStorable peekPtrLenL = peekPtrLenLForFStorable instance Storable Int32 where withPtrLen = withPtrLenForFStorable peekPtrLen = peekPtrLenForFStorable withPtrLenL = withPtrLenLForFStorable peekPtrLenL = peekPtrLenLForFStorable instance Storable Int64 where withPtrLen = withPtrLenForFStorable peekPtrLen = peekPtrLenForFStorable withPtrLenL = withPtrLenLForFStorable peekPtrLenL = peekPtrLenLForFStorable instance Storable Word8 where withPtrLen = withPtrLenForFStorable peekPtrLen = peekPtrLenForFStorable withPtrLenL = withPtrLenLForFStorable peekPtrLenL = peekPtrLenLForFStorable instance Storable Word16 where withPtrLen = withPtrLenForFStorable peekPtrLen = peekPtrLenForFStorable withPtrLenL = withPtrLenLForFStorable peekPtrLenL = peekPtrLenLForFStorable instance Storable Word32 where withPtrLen = withPtrLenForFStorable peekPtrLen = peekPtrLenForFStorable withPtrLenL = withPtrLenLForFStorable peekPtrLenL = peekPtrLenLForFStorable instance Storable Word64 where withPtrLen = withPtrLenForFStorable peekPtrLen = peekPtrLenForFStorable withPtrLenL = withPtrLenLForFStorable peekPtrLenL = peekPtrLenLForFStorable instance (F.Storable a, Storable a) => Storable [a] where withPtrLen = withPtrLenL peekPtrLen xs = peekPtrLenL xs undefined toInt64 = toInt64L fromString = fromStringL tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/TDB.hs000066400000000000000000000240671126071621700227100ustar00rootroot00000000000000-- | Interface to the table database. See also, -- for details module Database.TokyoCabinet.TDB ( -- $doc TDB , ECODE(..) , OpenMode(..) , TuningOption(..) , IndexType(..) , AssocList(..) , new , delete , ecode , errmsg , tune , setcache , setxmsiz , open , close , put , put' , putkeep , putkeep' , putcat , putcat' , out , get , get' , vsiz , iterinit , iternext , fwmkeys , addint , adddouble , sync , optimize , vanish , copy , tranbegin , trancommit , tranabort , path , rnum , fsiz , setindex , genuid ) where import Database.TokyoCabinet.Map.C import Database.TokyoCabinet.TDB.C import Database.TokyoCabinet.Error import Database.TokyoCabinet.Internal import Database.TokyoCabinet.Storable import Database.TokyoCabinet.Associative import Database.TokyoCabinet.Sequence import Data.Int import Data.Word import Foreign.Ptr import Foreign.ForeignPtr import Foreign.C.Types import Foreign.C.String -- $doc -- Example -- -- @ -- import Control.Monad (unless) -- import Database.TokyoCabinet.TDB -- import Database.TokyoCabinet.TDB.Query hiding (new) -- import qualified Database.TokyoCabinet.Map as M -- import qualified Database.TokyoCabinet.TDB.Query as Q (new) -- @ -- -- @ -- data Profile = Profile { name :: String -- , age :: Int } deriving Show -- @ -- -- @ -- insertProfile :: TDB -> Profile -> IO Bool -- insertProfile tdb profile = -- do m <- M.new -- M.put m \"name\" (name profile) -- M.put m \"age\" (show . age $ profile) -- Just pk <- genuid tdb -- put tdb (show pk) m -- @ -- -- @ -- main :: IO () -- main = do t <- new -- open t \"foo.tct\" [OWRITER, OCREAT] >>= err t -- @ -- -- @ -- mapM_ (insertProfile t) [ Profile \"tom\" 23 -- , Profile \"bob\" 24 -- , Profile \"alice\" 20 ] -- @ -- -- @ -- q <- Q.new t -- addcond q \"age\" QCNUMGE \"23\" -- setorder q \"name\" QOSTRASC -- proc q $ \pk cols -> do -- Just name <- M.get cols \"name\" -- putStrLn name -- M.put cols \"name\" (name ++ \"!\") -- return (QPPUT cols) -- @ -- -- @ -- close t >>= err t -- return () -- where -- err tdb = flip unless $ ecode tdb >>= error . show -- @ -- -- | Create the new table database object. new :: IO TDB new = TDB `fmap` (c_tctdbnew >>= newForeignPtr tctdbFinalizer) -- | Free object resource forcibly. delete :: TDB -> IO () delete tdb = finalizeForeignPtr (unTCTDB tdb) -- | Get the last happened error code. ecode :: TDB -> IO ECODE ecode tdb = cintToError `fmap` withForeignPtr (unTCTDB tdb) c_tctdbecode -- | Set the tuning parameters. tune :: TDB -- ^ TDB object -> Int64 -- ^ the number of elements of the bucket array -> Int8 -- ^ the size of record alignment by power of 2 -> Int8 -- ^ the maximum number of elements of the free block pool by power of 2 -> [TuningOption] -- ^ options -> IO Bool -- ^ if successful, the return value is True. tune tdb bnum apow fpow opts = withForeignPtr (unTCTDB tdb) $ \tdb' -> c_tctdbtune tdb' bnum apow fpow (combineTuningOption opts) -- | Set the caching parameters of a table database object. setcache :: TDB -- ^ TDB object -> Int32 -- ^ the maximum number of records to be cached -> Int32 -- ^ the maximum number of leaf nodes to be cached -> Int32 -- ^ the maximum number of non-leaf nodes to be cached -> IO Bool -- ^ if successful, the return value is True. setcache tdb rcnum lcnum ncnum = withForeignPtr (unTCTDB tdb) $ \tdb' -> c_tctdbsetcache tdb' rcnum lcnum ncnum -- | Set the size of the extra mapped memory of a table database object. setxmsiz :: TDB -- ^ TDB object -> Int64 -- ^ the size of the extra mapped memory -> IO Bool -- ^ if successful, the return value is True. setxmsiz tdb xmsiz = withForeignPtr (unTCTDB tdb) (flip c_tctdbsetxmsiz xmsiz) -- | Open the table database file open :: TDB -> String -> [OpenMode] -> IO Bool open = openHelper c_tctdbopen unTCTDB combineOpenMode -- | Open the database file close :: TDB -> IO Bool close tdb = withForeignPtr (unTCTDB tdb) c_tctdbclose type FunPut' = Ptr TDB' -> Ptr Word8 -> CInt -> Ptr MAP -> IO Bool putHelper' :: (Storable k, Storable v, Associative m) => FunPut' -> TDB -> v -> m k v -> IO Bool putHelper' c_putfunc tdb key vals = withForeignPtr (unTCTDB tdb) $ \tdb' -> withPtrLen key $ \(kbuf, ksize) -> withMap vals $ c_putfunc tdb' kbuf ksize -- | Store a record into a table database object. put :: (Storable k, Storable v, Associative m) => TDB -> v -> m k v -> IO Bool put = putHelper' c_tctdbput -- | Store a string record into a table database object with a zero -- separated column string. put' :: (Storable k, Storable v) => TDB -> k -> v -> IO Bool put' = putHelper c_tctdbput2 unTCTDB -- | Store a new record into a table database object. putkeep :: (Storable k, Storable v, Associative m) => TDB -> v -> m k v -> IO Bool putkeep = putHelper' c_tctdbputkeep -- | Store a new string record into a table database object with a -- zero separated column string. putkeep' :: (Storable k, Storable v) => TDB -> k -> v -> IO Bool putkeep' = putHelper c_tctdbputkeep2 unTCTDB -- | Concatenate columns of the existing record in a table database object. putcat :: (Storable k, Storable v, Associative m) => TDB -> v -> m k v -> IO Bool putcat = putHelper' c_tctdbputcat -- | Concatenate columns in a table database object with a zero -- separated column string. putcat' :: (Storable k, Storable v) => TDB -> k -> v -> IO Bool putcat' = putHelper c_tctdbputcat2 unTCTDB -- | Remove a record of a table database object. out :: (Storable k) => TDB -> k -> IO Bool out = outHelper c_tctdbout unTCTDB -- | Retrieve a record in a table database object. get :: (Storable k, Storable v, Associative m) => TDB -> k -> IO (m k v) get tdb key = withForeignPtr (unTCTDB tdb) $ \tdb' -> withPtrLen key $ \(kbuf, ksize) -> c_tctdbget tdb' kbuf ksize >>= peekMap' -- | Retrieve a record in a table database object as a zero separated -- column string. get' :: (Storable k, Storable v) => TDB -> k -> IO (Maybe v) get' = getHelper c_tctdbget2 unTCTDB -- | Get the size of the value of a record in a table database object. vsiz :: (Storable k) => TDB -> k -> IO (Maybe Int) vsiz = vsizHelper c_tctdbvsiz unTCTDB -- | Initialize the iterator of a table database object. iterinit :: TDB -> IO Bool iterinit tdb = withForeignPtr (unTCTDB tdb) c_tctdbiterinit -- | Get the next primary key of the iterator of a table database object. iternext :: (Storable k) => TDB -> IO (Maybe k) iternext = iternextHelper c_tctdbiternext unTCTDB -- | Get forward matching primary keys in a table database object. fwmkeys :: (Storable k1, Storable k2, Sequence q) => TDB -> k1 -> Int -> IO (q k2) fwmkeys = fwmHelper c_tctdbfwmkeys unTCTDB -- | Add an integer to a column of a record in a table database object. addint :: (Storable k) => TDB -> k -> Int -> IO (Maybe Int) addint = addHelper c_tctdbaddint unTCTDB fromIntegral fromIntegral (== cINT_MIN) -- | Add a real number to a column of a record in a table database object. adddouble :: (Storable k) => TDB -> k -> Double -> IO (Maybe Double) adddouble = addHelper c_tctdbadddouble unTCTDB realToFrac realToFrac isNaN -- | Synchronize updated contents of a table database object with the -- file and the device. sync :: TDB -> IO Bool sync tdb = withForeignPtr (unTCTDB tdb) c_tctdbsync -- | Optimize the file of a table database object. optimize :: TDB -- ^ TDB object -> Int64 -- ^ the number of elements of the bucket array -> Int8 -- ^ the size of record alignment by power of 2 -> Int8 -- ^ the maximum number of elements of the free block pool by power of 2 -> [TuningOption] -- ^ options -> IO Bool -- ^ if successful, the return value is True. optimize tdb bnum apow fpow opts = withForeignPtr (unTCTDB tdb) $ \tdb' -> c_tctdboptimize tdb' bnum apow fpow (combineTuningOption opts) -- | Remove all records of a table database object. vanish :: TDB -> IO Bool vanish tdb = withForeignPtr (unTCTDB tdb) c_tctdbvanish -- | Copy the database file of a table database object. copy :: TDB -- ^ TDB object -> String -- ^ new file path -> IO Bool -- ^ if successful, the return value is True copy = copyHelper c_tctdbcopy unTCTDB -- | Begin the transaction of a table database object. tranbegin :: TDB -> IO Bool tranbegin tdb = withForeignPtr (unTCTDB tdb) c_tctdbtranbegin -- | Commit the transaction of a table database object. trancommit :: TDB -> IO Bool trancommit tdb = withForeignPtr (unTCTDB tdb) c_tctdbtrancommit -- | Abort the transaction of a table database object. tranabort :: TDB -> IO Bool tranabort tdb = withForeignPtr (unTCTDB tdb) c_tctdbtranabort -- | Get the file path of a table database object. path :: TDB -> IO (Maybe String) path = pathHelper c_tctdbpath unTCTDB -- | Get the number of records of a table database object. rnum :: TDB -> IO Word64 rnum tdb = withForeignPtr (unTCTDB tdb) c_tctdbrnum -- | Get the size of the database file of a table database object. fsiz :: TDB -> IO Word64 fsiz tdb = withForeignPtr (unTCTDB tdb) c_tctdbfsiz -- | Set a column index to a table database object. setindex :: TDB -> String -> IndexType -> IO Bool setindex tdb name itype = withForeignPtr (unTCTDB tdb) $ \tdb' -> withCString name $ \c_name -> c_tctdbsetindex tdb' c_name (indexTypeToCInt itype) -- | Generate a unique ID number of a table database object. genuid :: TDB -> IO (Maybe Int64) genuid tdb = withForeignPtr (unTCTDB tdb) $ \tdb' -> do uid <- c_tctdbgenuid tdb' return $ if uid == (-1) then Nothing else Just uid tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/TDB/000077500000000000000000000000001126071621700223435ustar00rootroot00000000000000tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/TDB/C.hsc000066400000000000000000000153611126071621700232320ustar00rootroot00000000000000{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} module Database.TokyoCabinet.TDB.C where import Data.Int import Data.Word import Data.Bits import Foreign.Ptr import Foreign.ForeignPtr import Foreign.C.Types import Foreign.C.String import Database.TokyoCabinet.Map.C import Database.TokyoCabinet.List.C #include -- | Represents open mode data OpenMode = OREADER | -- ^ read only mode OWRITER | -- ^ write mode OCREAT | -- ^ if this value is included in open mode list, `open -- function' creates a new database if not exist. OTRUNC | -- ^ creates a new database regardless if one exists ONOLCK | -- ^ open the database file without file locking OLCKNB | -- ^ open the database file with locking performed -- without blocking. OTSYNC -- ^ every transaction synchronizes updated contents -- with the device deriving (Eq, Ord, Show) data TuningOption = TLARGE | TDEFLATE | TBZIP | TTCBS | TEXCODEC deriving (Eq, Ord, Show) -- | Represents the index type data IndexType = ITLEXICAL | -- ^ for lexical string ITDECIMAL | -- ^ for decimal string ITOPT | -- ^ the index is optimized ITVOID | -- ^ the index is removed ITKEEP IndexType -- ^ if the index exists, setindex function merely returns failure deriving (Eq, Ord, Show) openModeToCInt :: OpenMode -> CInt openModeToCInt OREADER = #const TDBOREADER openModeToCInt OWRITER = #const TDBOWRITER openModeToCInt OCREAT = #const TDBOCREAT openModeToCInt OTRUNC = #const TDBOTRUNC openModeToCInt ONOLCK = #const TDBONOLCK openModeToCInt OLCKNB = #const TDBOLCKNB openModeToCInt OTSYNC = #const TDBOTSYNC tuningOptionToWord8 :: TuningOption -> Word8 tuningOptionToWord8 TLARGE = #const TDBTLARGE tuningOptionToWord8 TDEFLATE = #const TDBTDEFLATE tuningOptionToWord8 TBZIP = #const TDBTBZIP tuningOptionToWord8 TTCBS = #const TDBTTCBS tuningOptionToWord8 TEXCODEC = #const TDBTEXCODEC indexTypeToCInt :: IndexType -> CInt indexTypeToCInt ITLEXICAL = #const TDBITLEXICAL indexTypeToCInt ITDECIMAL = #const TDBITDECIMAL indexTypeToCInt ITOPT = #const TDBITOPT indexTypeToCInt ITVOID = #const TDBITVOID indexTypeToCInt (ITKEEP ixt) = (#const TDBITKEEP) .|. (indexTypeToCInt ixt) combineOpenMode :: [OpenMode] -> CInt combineOpenMode = foldr ((.|.) . openModeToCInt) 0 combineTuningOption :: [TuningOption] -> Word8 combineTuningOption = foldr ((.|.) . tuningOptionToWord8) 0 data TDB = TDB { unTCTDB :: !(ForeignPtr TDB') } data TDB' foreign import ccall safe "tctdbnew" c_tctdbnew :: IO (Ptr TDB') foreign import ccall safe "tctdbdel" c_tctdbdel :: Ptr TDB' -> IO () foreign import ccall safe "&tctdbdel" tctdbFinalizer :: FunPtr (Ptr TDB' -> IO ()) foreign import ccall safe "tctdbecode" c_tctdbecode :: Ptr TDB' -> IO CInt foreign import ccall safe "tctdbsetmutex" c_tctdbsetmutex :: Ptr TDB' -> IO Bool foreign import ccall safe "tctdbtune" c_tctdbtune :: Ptr TDB' -> Int64 -> Int8 -> Int8 -> Word8 -> IO Bool foreign import ccall safe "tctdbsetcache" c_tctdbsetcache :: Ptr TDB' -> Int32 -> Int32 -> Int32 -> IO Bool foreign import ccall safe "tctdbsetxmsiz" c_tctdbsetxmsiz :: Ptr TDB' -> Int64 -> IO Bool foreign import ccall safe "tctdbopen" c_tctdbopen :: Ptr TDB' -> CString -> CInt -> IO Bool foreign import ccall safe "tctdbclose" c_tctdbclose :: Ptr TDB' -> IO Bool foreign import ccall safe "tctdbput" c_tctdbput :: Ptr TDB' -> Ptr Word8 -> CInt -> Ptr MAP -> IO Bool foreign import ccall safe "tctdbput2" c_tctdbput2 :: Ptr TDB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tctdbput3" c_tctdbput3 :: Ptr TDB' -> CString -> CString -> IO Bool foreign import ccall safe "tctdbputkeep" c_tctdbputkeep :: Ptr TDB' -> Ptr Word8 -> CInt -> Ptr MAP -> IO Bool foreign import ccall safe "tctdbputkeep2" c_tctdbputkeep2 :: Ptr TDB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tctdbputkeep3" c_tctdbputkeep3 :: Ptr TDB' -> CString -> CString -> IO Bool foreign import ccall safe "tctdbputcat" c_tctdbputcat :: Ptr TDB' -> Ptr Word8 -> CInt -> Ptr MAP -> IO Bool foreign import ccall safe "tctdbputcat2" c_tctdbputcat2 :: Ptr TDB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tctdbputcat3" c_tctdbputcat3 :: Ptr TDB' -> CString -> CString -> IO Bool foreign import ccall safe "tctdbout" c_tctdbout :: Ptr TDB' -> Ptr Word8 -> CInt -> IO Bool foreign import ccall safe "tctdbout2" c_tctdbout2 :: Ptr TDB' -> CString -> IO Bool foreign import ccall safe "tctdbget" c_tctdbget :: Ptr TDB' -> Ptr Word8 -> CInt -> IO (Ptr MAP) foreign import ccall safe "tctdbget2" c_tctdbget2 :: Ptr TDB' -> Ptr Word8 -> CInt -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tctdbget3" c_tctdbget3 :: Ptr TDB' -> CString -> IO CString foreign import ccall safe "tctdbvsiz" c_tctdbvsiz :: Ptr TDB' -> Ptr Word8 -> CInt -> IO CInt foreign import ccall safe "tctdbvsiz2" c_tctdbvsiz2 :: Ptr TDB' -> CString -> IO CInt foreign import ccall safe "tctdbiterinit" c_tctdbiterinit :: Ptr TDB' -> IO Bool foreign import ccall safe "tctdbiternext" c_tctdbiternext :: Ptr TDB' -> Ptr CInt -> IO (Ptr Word8) foreign import ccall safe "tctdbiternext2" c_tctdbiternext2 :: Ptr TDB' -> IO CString foreign import ccall safe "tctdbfwmkeys" c_tctdbfwmkeys :: Ptr TDB' -> Ptr Word8 -> CInt -> CInt -> IO (Ptr LIST) foreign import ccall safe "tctdbfwmkeys2" c_tctdbfwmkeys2 :: Ptr TDB' -> CString -> CInt -> IO (Ptr LIST) foreign import ccall safe "tctdbaddint" c_tctdbaddint :: Ptr TDB' -> Ptr Word8 -> CInt -> CInt -> IO CInt foreign import ccall safe "tctdbadddouble" c_tctdbadddouble :: Ptr TDB' -> Ptr Word8 -> CInt -> CDouble -> IO CDouble foreign import ccall safe "tctdbsync" c_tctdbsync :: Ptr TDB' -> IO Bool foreign import ccall safe "tctdboptimize" c_tctdboptimize :: Ptr TDB' -> Int64 -> Int8 -> Int8 -> Word8 -> IO Bool foreign import ccall safe "tctdbvanish" c_tctdbvanish :: Ptr TDB' -> IO Bool foreign import ccall safe "tctdbcopy" c_tctdbcopy :: Ptr TDB' -> CString -> IO Bool foreign import ccall safe "tctdbtranbegin" c_tctdbtranbegin :: Ptr TDB' -> IO Bool foreign import ccall safe "tctdbtrancommit" c_tctdbtrancommit :: Ptr TDB' -> IO Bool foreign import ccall safe "tctdbtranabort" c_tctdbtranabort :: Ptr TDB' -> IO Bool foreign import ccall safe "tctdbpath" c_tctdbpath :: Ptr TDB' -> IO CString foreign import ccall safe "tctdbrnum" c_tctdbrnum :: Ptr TDB' -> IO Word64 foreign import ccall safe "tctdbfsiz" c_tctdbfsiz :: Ptr TDB' -> IO Word64 foreign import ccall safe "tctdbsetindex" c_tctdbsetindex :: Ptr TDB' -> CString -> CInt -> IO Bool foreign import ccall safe "tctdbgenuid" c_tctdbgenuid :: Ptr TDB' -> IO Int64 tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/TDB/Query.hs000066400000000000000000000102741126071621700240100ustar00rootroot00000000000000module Database.TokyoCabinet.TDB.Query ( Condition(..) , OrderType(..) , PostTreatment(..) , new , delete , addcond , setorder , setlimit , search , searchout , hint , proc ) where import Data.Word import Foreign.C.String import Foreign.Ptr import Foreign.ForeignPtr import Foreign.Storable (pokeByteOff, peek) import Foreign.Marshal (mallocBytes, alloca) import Foreign.Marshal.Utils (copyBytes) import Database.TokyoCabinet.Storable import Database.TokyoCabinet.Sequence import Database.TokyoCabinet.Associative import Database.TokyoCabinet.Map.C import Database.TokyoCabinet.TDB.C import Database.TokyoCabinet.TDB.Query.C -- | Create a query object. new :: TDB -> IO TDBQRY new tdb = withForeignPtr (unTCTDB tdb) $ \tdb' -> flip TDBQRY tdb `fmap` (c_tctdbqrynew tdb' >>= newForeignPtr tctdbqryFinalizer) -- | Free object resource forcibly. delete :: TDBQRY -> IO () delete qry = finalizeForeignPtr (unTDBQRY qry) -- | Add a narrowing condition to a query object. addcond :: (Storable k, Storable v) => TDBQRY -> k -> Condition -> v -> IO () addcond qry name op expr = withForeignPtr (unTDBQRY qry) $ \qry' -> withPtrLen name $ \(name', nlen) -> withPtrLen expr $ \(expr', elen) -> do pokeByteOff name' (fromIntegral nlen) (0 :: Word8) pokeByteOff expr' (fromIntegral elen) (0 :: Word8) c_tctdbqryaddcond qry' (castPtr name') (condToCInt op) (castPtr expr') -- | Set the order of a query object. setorder :: (Storable k) => TDBQRY -> k -> OrderType -> IO () setorder qry name otype = withForeignPtr (unTDBQRY qry) $ \qry' -> withPtrLen name $ \(name', nlen) -> do pokeByteOff name' (fromIntegral nlen) (0 :: Word8) c_tctdbqrysetorder qry' (castPtr name') (orderToCInt otype) -- | Set the limit number of records of the result of a query object. setlimit :: TDBQRY -> Int -> Int -> IO () setlimit qry maxn skip = withForeignPtr (unTDBQRY qry) $ \qry' -> c_tctdbqrysetlimit qry' (fromIntegral maxn) (fromIntegral skip) -- | Execute the search of a query object. The return value is a list -- object of the primary keys of the corresponding records. search :: (Storable k, Sequence q) => TDBQRY -> IO (q k) search qry = withForeignPtr (unTDBQRY qry) $ (>>= peekList') . c_tctdbqrysearch -- | Remove each record corresponding to a query object. searchout :: TDBQRY -> IO Bool searchout qry = withForeignPtr (unTDBQRY qry) c_tctdbqrysearchout hint :: TDBQRY -> IO String hint qry = withForeignPtr (unTDBQRY qry) $ \qry' -> c_tctdbqryhint qry' >>= peekCString -- | Process each record corresponding to a query object. proc :: (Storable k, Storable v, Associative m) => TDBQRY -- ^ Query object. -> (v -> m k v -> IO (PostTreatment m k v)) -- ^ the iterator -- function called -- for each record. -> IO Bool -- ^ If successful, the return value is true, else, it is false. proc qry callback = withForeignPtr (unTDBQRY qry) $ \qry' -> do cb <- mkProc proc' c_tctdbqryproc qry' cb nullPtr where proc' :: TDBQRYPROC' proc' pkbuf pksiz m _ = do let siz = fromIntegral pksiz pbuf <- mallocBytes siz copyBytes pbuf pkbuf siz pkey <- peekPtrLen (pbuf, pksiz) pt <- c_tcmapdup m >>= peekMap' >>= callback pkey case pt of QPPUT m' -> withMap m' (flip copyMap m) _ -> return () return (ptToCInt pt) copyMap :: Ptr MAP -> Ptr MAP -> IO () copyMap msrc mdist = do c_tcmapclear mdist c_tcmapiterinit msrc storeKeyValue msrc mdist storeKeyValue :: Ptr MAP -> Ptr MAP -> IO () storeKeyValue msrc mdist = alloca $ \sizbuf -> do kbuf <- c_tcmapiternext msrc sizbuf if kbuf == nullPtr then return () else do ksiz <- peek sizbuf vbuf <- c_tcmapget msrc kbuf ksiz sizbuf vsiz <- peek sizbuf c_tcmapput mdist kbuf ksiz vbuf vsiz storeKeyValue msrc mdist tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/TDB/Query/000077500000000000000000000000001126071621700234505ustar00rootroot00000000000000tokyocabinet-haskell-0.0.5/Database/TokyoCabinet/TDB/Query/C.hsc000066400000000000000000000064251126071621700243400ustar00rootroot00000000000000{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} module Database.TokyoCabinet.TDB.Query.C where import Data.Word import Data.Bits import Foreign.Ptr import Foreign.ForeignPtr import Foreign.C.Types import Foreign.C.String import Database.TokyoCabinet.TDB.C import Database.TokyoCabinet.Map.C import Database.TokyoCabinet.List.C #include data Condition = QCSTREQ | QCSTRINC | QCSTRBW | QCSTREW | QCSTRAND | QCSTROR | QCSTROREQ | QCSTRRX | QCNUMEQ | QCNUMGT | QCNUMGE | QCNUMLT | QCNUMLE | QCNUMBT | QCNUMOREQ | QCNEGATE Condition | QCNOIDX Condition deriving (Eq, Ord, Show) data OrderType = QOSTRASC | QOSTRDESC | QONUMASC | QONUMDESC deriving (Eq, Ord, Show) data PostTreatment m k v = QPPUT (m k v) | QPOUT | QPNOP | QPSTOP deriving (Eq, Ord, Show) condToCInt :: Condition -> CInt condToCInt QCSTREQ = #const TDBQCSTREQ condToCInt QCSTRINC = #const TDBQCSTRINC condToCInt QCSTRBW = #const TDBQCSTRBW condToCInt QCSTREW = #const TDBQCSTREW condToCInt QCSTRAND = #const TDBQCSTRAND condToCInt QCSTROR = #const TDBQCSTROR condToCInt QCSTROREQ = #const TDBQCSTROREQ condToCInt QCSTRRX = #const TDBQCSTRRX condToCInt QCNUMEQ = #const TDBQCNUMEQ condToCInt QCNUMGT = #const TDBQCNUMGT condToCInt QCNUMGE = #const TDBQCNUMGE condToCInt QCNUMLT = #const TDBQCNUMLT condToCInt QCNUMLE = #const TDBQCNUMLE condToCInt QCNUMBT = #const TDBQCNUMBT condToCInt QCNUMOREQ = #const TDBQCNUMOREQ condToCInt (QCNEGATE c) = (#const TDBQCNEGATE) .|. (condToCInt c) condToCInt (QCNOIDX c) = (#const TDBQCNOIDX) .|. (condToCInt c) orderToCInt :: OrderType -> CInt orderToCInt QOSTRASC = #const TDBQOSTRASC orderToCInt QOSTRDESC = #const TDBQOSTRDESC orderToCInt QONUMASC = #const TDBQONUMASC orderToCInt QONUMDESC = #const TDBQONUMDESC ptToCInt :: PostTreatment m k v -> CInt ptToCInt QPNOP = 0 ptToCInt QPOUT = #const TDBQPOUT ptToCInt QPSTOP = #const TDBQPSTOP ptToCInt (QPPUT _) = #const TDBQPPUT data TDBQRY = TDBQRY { unTDBQRY :: !(ForeignPtr QRY) , unTDBOBJ :: TDB } data QRY foreign import ccall safe "tctdbqrynew" c_tctdbqrynew :: Ptr TDB' -> IO (Ptr QRY) foreign import ccall safe "tctdbqrydel" c_tctdbqrydel :: Ptr QRY -> IO () foreign import ccall safe "&tctdbqrydel" tctdbqryFinalizer :: FunPtr (Ptr QRY -> IO ()) foreign import ccall safe "tctdbqryaddcond" c_tctdbqryaddcond :: Ptr QRY -> CString -> CInt -> CString -> IO () foreign import ccall safe "tctdbqrysetorder" c_tctdbqrysetorder :: Ptr QRY -> CString -> CInt -> IO () foreign import ccall safe "tctdbqrysetlimit" c_tctdbqrysetlimit :: Ptr QRY -> CInt -> CInt -> IO () foreign import ccall safe "tctdbqrysearch" c_tctdbqrysearch :: Ptr QRY -> IO (Ptr LIST) foreign import ccall safe "tctdbqrysearchout" c_tctdbqrysearchout :: Ptr QRY -> IO Bool foreign import ccall safe "tctdbqryhint" c_tctdbqryhint :: Ptr QRY -> IO CString type TDBQRYPROC' = Ptr Word8 -> CInt -> Ptr MAP -> Ptr Word8 -> IO CInt foreign import ccall safe "tctdbqryproc" c_tctdbqryproc :: Ptr QRY -> FunPtr TDBQRYPROC' -> Ptr Word8 -> IO Bool foreign import ccall "wrapper" mkProc :: TDBQRYPROC' -> IO (FunPtr TDBQRYPROC') tokyocabinet-haskell-0.0.5/LICENSE000066400000000000000000000027141126071621700166440ustar00rootroot00000000000000Copyright (c) 2009, Tom Tsuruhara 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. * The names of contributors may not 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. tokyocabinet-haskell-0.0.5/Setup.hs000066400000000000000000000010321126071621700172630ustar00rootroot00000000000000import Distribution.Simple import Distribution.PackageDescription import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..)) import System.Cmd (system) import System.FilePath main = defaultMainWithHooks $ simpleUserHooks { runTests = myTestRunner } myTestRunner :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO () myTestRunner _ _ pkg_descr lbi = mapM_ (system . path) $ executables pkg_descr where path exec = let name = (dropExtension . exeName) exec in (buildDir lbi) name name tokyocabinet-haskell-0.0.5/examples/000077500000000000000000000000001126071621700174515ustar00rootroot00000000000000tokyocabinet-haskell-0.0.5/examples/TCRError.hs000066400000000000000000000033551126071621700214550ustar00rootroot00000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} module TCRError where import Control.Monad.Reader import Control.Monad.Error import Database.TokyoCabinet ( TCM , runTCM , new , OpenMode(..) , TCDB , HDB , BDB , FDB ) import Database.TokyoCabinet.Storable import qualified Database.TokyoCabinet as TC newtype TCRError tc e a = TCRError { runTCRError :: ErrorT e (ReaderT tc TCM) a} deriving (Monad, MonadReader tc, MonadError e) runTCRE :: TCRError tc e a -> tc -> TCM (Either e a) runTCRE = runReaderT . runErrorT . runTCRError liftT :: (Error e) => TCM a -> TCRError tc e a liftT = TCRError . lift . lift open :: (TCDB tc) => String -> [OpenMode] -> TCRError tc String () open name mode = do tc <- ask res <- liftT $ TC.open tc name mode if res then return () else throwError "open failed" close :: (TCDB tc) => TCRError tc String () close = ask >>= liftT . TC.close >>= \res -> if res then return () else throwError "close failed" put :: (TCDB tc) => String -> String -> TCRError tc String () put key val = do tc <- ask res <- liftT $ TC.put tc key val if res then return () else throwError "put failed" get :: (TCDB tc) => String -> TCRError tc String (Maybe String) get key = do tc <- ask liftT $ TC.get tc key kvstore :: (TCDB tc) => [(String, String)] -> TCRError tc String () kvstore kv = do open "abcd.tch" [OREADER] mapM_ (uncurry put) kv close main :: IO () main = runTCM $ do h <- new :: TCM BDB let kv = [("foo", "100"), ("bar", "200")] flip runTCRE h $ catchError (kvstore kv) (\e -> error e) >> return () tokyocabinet-haskell-0.0.5/examples/TCReader.hs000066400000000000000000000027271126071621700214460ustar00rootroot00000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} module TCReader where import Database.TokyoCabinet.Storable import Control.Monad import Control.Monad.Reader import Database.TokyoCabinet ( TCM , TCDB , HDB , BDB , FDB , new , runTCM , OpenMode(..) ) import qualified Database.TokyoCabinet as TC newtype TCReader tc a = TCReader { runTCR :: ReaderT tc TCM a } deriving (Monad, MonadReader tc) runTCReader :: TCReader tc a -> tc -> TCM a runTCReader = runReaderT . runTCR open :: (TCDB tc) => String -> [OpenMode] -> TCReader tc Bool open name mode = do tc <- ask TCReader $ lift (TC.open tc name mode) close :: (TCDB tc) => TCReader tc Bool close = ask >>= (TCReader . lift . TC.close) get :: (Storable k, Storable v, TCDB tc) => k -> TCReader tc (Maybe v) get key = do tc <- ask TCReader $ lift (TC.get tc key) put :: (Storable k, Storable v, TCDB tc) => k -> v -> TCReader tc Bool put key val = do tc <- ask TCReader $ lift (TC.put tc key val) kvstore :: (Storable k, Storable v, TCDB tc) => [(k, v)] -> TCReader tc Bool kvstore kv = do open "abcd.tch" [OWRITER, OCREAT] mapM_ (uncurry put) kv close main :: IO () main = runTCM $ do h <- new :: TCM HDB let kv =[ ("foo", 112) , ("bar", 200) , ("baz", 300) ] :: [(String, Int)] runTCReader (kvstore kv) h >> return () tokyocabinet-haskell-0.0.5/examples/myapp1.hs000066400000000000000000000011771126071621700212220ustar00rootroot00000000000000import System import MyApp1.TokyoCabinet main :: IO () main = do args <- getArgs case head args of "-h" -> (new :: IO HDB) >>= main' "-b" -> (new :: IO BDB) >>= main' "-f" -> (new :: IO FDB) >>= main' _ -> putStrLn "./myapp1 [-h|-b|-f]" where main' tc = do let ext = defaultExtension tc v <- flip runTCM tc $ do open ("foo" ++ ext) [OWRITER, OCREAT] put "100" "bar" putcat "100" "bar" v <- get "100" close return v print (v :: Maybe String) tokyocabinet-haskell-0.0.5/examples/myapp2.hs000066400000000000000000000011101126071621700212060ustar00rootroot00000000000000import MyApp2.TokyoCabinet import Control.Monad.Trans import Control.Monad.Error main :: IO () main = do h <- new :: IO HDB let ext = defaultExtension h v <- flip runTCM h $ do open ("foo" ++ ext) [OWRITER, OCREAT] put "100" "foo" -- throwError EMISC v <- get "100" close return v `catchError` const (close >> fail "oops") case v of Left e -> putStrLn (show e) Right v' -> putStrLn (show (v' :: Maybe String)) tokyocabinet-haskell-0.0.5/examples/simple.hs000066400000000000000000000012161126071621700212760ustar00rootroot00000000000000import Database.TokyoCabinet import Data.ByteString.Char8 (ByteString, pack) putsample :: String -> [(ByteString, ByteString)] -> TCM Bool putsample file kv = do tc <- new :: TCM HDB open tc file [OWRITER, OCREAT] mapM (uncurry $ put tc) kv close tc getsample :: String -> ByteString -> TCM (Maybe ByteString) getsample file key = do tc <- new :: TCM HDB open tc file [OREADER] val <- get tc key close tc return val main = runTCM (do putsample "foo.tch" [(pack "foo", pack "bar")] getsample "foo.tch" (pack "foo")) >>= maybe (return ()) (putStrLn . show) tokyocabinet-haskell-0.0.5/examples/tcadb.hs000066400000000000000000000022011126071621700210550ustar00rootroot00000000000000import Control.Monad import Database.TokyoCabinet.ADB main = do adb <- new -- open the abstract database object -- "+" means that the database will be an on-memory tree database open adb "+" >>= err adb "open failed" -- store records puts adb [("foo", "hop"), ("bar", "step"), ("baz", "jump")] >>= err adb "put failed" . (all id) -- retrieve records get_print adb "foo" -- traverse records iterinit adb iter adb >>= mapM_ (\k -> putStr (k++":") >> get_print adb k) -- close the database close adb >>= err adb "close failed" where puts :: ADB -> [(String, String)] -> IO [Bool] puts adb = mapM (uncurry $ put adb) get_print :: ADB -> String -> IO () get_print adb key = get adb key >>= maybe (error "something goes wrong") putStrLn err :: ADB -> String -> Bool -> IO () err adb msg = flip unless $ error msg iter :: ADB -> IO [String] iter adb = iternext adb >>= maybe (return []) (\x -> return . (x:) =<< iter adb) tokyocabinet-haskell-0.0.5/examples/tcbdb.hs000066400000000000000000000021051126071621700210610ustar00rootroot00000000000000import Control.Monad import Database.TokyoCabinet.BDB import qualified Database.TokyoCabinet.BDB.Cursor as C main :: IO () main = do bdb <- new -- open the database open bdb "casket.tcb" [OWRITER, OCREAT] >>= err bdb -- store records puts bdb [ ("foo", "hop"), ("bar", "step"), ("baz", "jump") ] >>= err bdb . (all id) -- retrieve records get bdb "foo" >>= maybe (error "something goes wrong") putStrLn -- traverse records cur <- C.new bdb C.first cur >>= err bdb iter cur >>= putStrLn . show -- close the database close bdb >>= err bdb where puts :: BDB -> [(String, String)] -> IO [Bool] puts bdb = mapM (uncurry $ put bdb) err :: BDB -> Bool -> IO () err bdb = flip unless $ ecode bdb >>= error . show iter :: C.BDBCUR -> IO [(String, String)] iter cur = do [key, value] <- sequence [C.key cur, C.val cur] case (key, value) of (Just k, Just v) -> C.next cur >> iter cur >>= return . ((k,v):) _ -> return [] tokyocabinet-haskell-0.0.5/examples/tcfdb.hs000066400000000000000000000012471126071621700210730ustar00rootroot00000000000000import Control.Monad import Database.TokyoCabinet.FDB main = do fdb <- new -- open the database open fdb "casket.tcf" [OWRITER, OCREAT] >>= err fdb -- store records puts fdb [(1, "one"), (12, "twelve"), (144, "one forty four")] >>= err fdb . (all id) -- retrieve records get fdb (1 :: Int) >>= maybe (error "something goes wrong") putStrLn -- close the database close fdb >>= err fdb where puts :: FDB -> [(Int, String)] -> IO [Bool] puts fdb = mapM (uncurry $ put fdb) err :: FDB -> Bool -> IO () err fdb = flip unless $ ecode fdb >>= error . show tokyocabinet-haskell-0.0.5/examples/tchdb.hs000066400000000000000000000020311126071621700210650ustar00rootroot00000000000000import Control.Monad import Database.TokyoCabinet.HDB main = do hdb <- new -- open the database open hdb "casket.tch" [OWRITER, OCREAT] >>= err hdb -- store records puts hdb [("foo", "hop"), ("bar", "step"), ("baz", "jump")] >>= err hdb . (all id) -- retrieve records get_print hdb "foo" -- traverse records iterinit hdb iter hdb >>= mapM_ (\k -> putStr (k++":") >> get_print hdb k) -- close the database close hdb >>= err hdb where puts :: HDB -> [(String, String)] -> IO [Bool] puts hdb = mapM (uncurry $ put hdb) get_print :: HDB -> String -> IO () get_print hdb key = get hdb key >>= maybe (error "something goes wrong") putStrLn err :: HDB -> Bool -> IO () err hdb = flip unless $ ecode hdb >>= error . show iter :: HDB -> IO [String] iter hdb = iternext hdb >>= maybe (return []) (\x -> return . (x:) =<< iter hdb) tokyocabinet-haskell-0.0.5/examples/tctdb.hs000066400000000000000000000022501126071621700211040ustar00rootroot00000000000000import Control.Monad (unless) import Database.TokyoCabinet.TDB import Database.TokyoCabinet.TDB.Query hiding (new) import qualified Database.TokyoCabinet.Map as M import qualified Database.TokyoCabinet.TDB.Query as Q (new) data Profile = Profile { name :: String , age :: Int } deriving Show insertProfile :: TDB -> Profile -> IO Bool insertProfile tdb profile = do m <- M.new M.put m "name" (name profile) M.put m "age" (show . age $ profile) Just pk <- genuid tdb put tdb (show pk) m main :: IO () main = do t <- new open t "foo.tct" [OWRITER, OCREAT] >>= err t mapM_ (insertProfile t) [ Profile "tom" 23 , Profile "bob" 24 , Profile "alice" 20 ] q <- Q.new t addcond q "age" QCNUMGE "23" setorder q "name" QOSTRASC proc q $ \pk cols -> do Just name <- M.get cols "name" putStrLn name M.put cols "name" (name ++ "!") return (QPPUT cols) close t >>= err t return () where err tdb = flip unless $ ecode tdb >>= error . show tokyocabinet-haskell-0.0.5/examples/withTC.hs000066400000000000000000000006541126071621700212140ustar00rootroot00000000000000module Main where import Control.Monad.Trans import Control.Exception import Database.TokyoCabinet withTokyoCabinet :: (TCDB a) => String -> (a -> TCM b) -> TCM b withTokyoCabinet fname action = liftIO $ bracket (runTCM open') (runTCM . close') (runTCM . action) where open' = do tc <- new open tc fname [OREADER, OWRITER, OCREAT] return tc close' tc = close tc tokyocabinet-haskell-0.0.5/tokyocabinet-haskell.cabal000066400000000000000000000042371126071621700227410ustar00rootroot00000000000000Name: tokyocabinet-haskell Version: 0.0.5 Cabal-Version: >= 1.6 License: BSD3 License-File: LICENSE Author: Tom Tsuruhara Maintainer: tom.lpsd@gmail.com Homepage: http://tom-lpsd.github.com/tokyocabinet-haskell/ Stability: experimental Category: Database Synopsis: Haskell binding of Tokyo Cabinet Extra-source-files: examples/*.hs Changes Description: Bindings to Tokyo Cabinet library. Tokyo Cabinet is a modern implementation of DBM. For more about Tokyo Cabinet, see . This package provides `tokyocabinet.idl compliant' naive interfaces. See, . Tested-With: GHC Build-Type: Simple Source-Repository head type: git location: git://github.com/tom-lpsd/tokyocabinet-haskell.git Flag BuildTest Description: make tests and install it if True Default: False Library Build-Depends: base >= 4.0, bytestring >= 0.9, mtl >= 1.1 Exposed-modules: Database.TokyoCabinet Database.TokyoCabinet.HDB Database.TokyoCabinet.HDB.C Database.TokyoCabinet.ADB Database.TokyoCabinet.ADB.C Database.TokyoCabinet.BDB Database.TokyoCabinet.BDB.C Database.TokyoCabinet.BDB.Cursor Database.TokyoCabinet.BDB.Cursor.C Database.TokyoCabinet.FDB Database.TokyoCabinet.FDB.C Database.TokyoCabinet.FDB.Key Database.TokyoCabinet.TDB Database.TokyoCabinet.TDB.C Database.TokyoCabinet.TDB.Query Database.TokyoCabinet.TDB.Query.C Database.TokyoCabinet.Error Database.TokyoCabinet.Map Database.TokyoCabinet.Map.C Database.TokyoCabinet.List Database.TokyoCabinet.List.C Database.TokyoCabinet.Storable Database.TokyoCabinet.Sequence Database.TokyoCabinet.Associative Other-modules: Database.TokyoCabinet.Internal Extensions: CPP, ForeignFunctionInterface, EmptyDataDecls, TypeSynonymInstances, GeneralizedNewtypeDeriving Extra-libraries: tokyocabinet Extra-lib-dirs: /usr/local/lib Include-dirs: /usr/local/include GHC-Options: -Wall