packages feed

tokyocabinet-haskell 0.0.1 → 0.0.2

raw patch · 12 files changed

+202/−123 lines, 12 files

Files

Database/TokyoCabinet.hs view
@@ -17,6 +17,7 @@ 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@@ -25,6 +26,7 @@ import qualified Database.TokyoCabinet.Error as E  import Data.Int+import Data.Word  -- $doc -- Basic Usage (sample code)@@ -145,11 +147,11 @@     iternext  :: (Storable v) => a -> TCM (Maybe v)      -- | Get forward matching keys.-    fwmkeys   :: (Storable k, Storable v) =>+    fwmkeys   :: (Storable k, Storable v, Sequence q) =>                  a   -- ^ database object               -> k   -- ^ search string               -> Int -- ^ the maximum number of keys to be fetched-              -> TCM [v] -- ^ result keys+              -> TCM (q v) -- ^ result keys      -- | Add an integer to a record.     addint    :: (Storable k) =>@@ -190,10 +192,10 @@     path      :: a -> TCM (Maybe String)      -- | Get the number of records.-    rnum      :: a -> TCM Int64+    rnum      :: a -> TCM Word64      -- | Get the size of the database file.-    size      :: a -> TCM Int64+    size      :: a -> TCM Word64      -- | Get the last happened error code.     ecode     :: a -> TCM E.ECODE
Database/TokyoCabinet/BDB.hs view
@@ -46,14 +46,19 @@     ) where  import Data.Int+import Data.Word  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 qualified Database.TokyoCabinet.Storable as S+import Database.TokyoCabinet.Storable+import Database.TokyoCabinet.Sequence  -- $doc -- Example@@ -155,57 +160,72 @@ -- be instance of Storable class.  Usually, we can use `String', -- `ByteString' for key, `String', `ByteString', `Int', `Double' for -- value.-put :: (S.Storable k, S.Storable v) => BDB -> k -> v -> IO Bool+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 :: (S.Storable k, S.Storable v) => BDB -> k -> v -> IO Bool+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 :: (S.Storable k, S.Storable v) => BDB -> k -> v -> IO Bool+putcat :: (Storable k, Storable v) => BDB -> k -> v -> IO Bool putcat = putHelper c_tcbdbputcat unTCBDB  -- | Store a record with allowing duplication of keys. -putdup :: (S.Storable k, S.Storable v) => BDB -> k -> v -> IO Bool+putdup :: (Storable k, Storable v) => BDB -> k -> v -> IO Bool putdup = putHelper c_tcbdbputdup unTCBDB  -- | Store records with allowing duplication of keys. -putlist :: (S.Storable k, S.Storable v) => BDB -> k -> [v] -> IO Bool-putlist bdb key vals = do-  and `fmap` mapM (putdup bdb key) vals+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 :: (S.Storable k) => BDB -> k -> IO Bool+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 :: (S.Storable k) => BDB -> k -> IO Bool+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 :: (S.Storable k, S.Storable v) => BDB -> k -> IO (Maybe v)+get :: (Storable k, Storable v) => BDB -> k -> IO (Maybe v) get = getHelper c_tcbdbget unTCBDB  -- | Retrieve records. -getlist :: (S.Storable k, S.Storable v) => BDB -> k -> IO [v]+getlist :: (Storable k, Storable v, Sequence q) => BDB -> k -> IO (q v) getlist bdb key =     withForeignPtr (unTCBDB bdb) $ \bdb' ->-        S.withPtrLen key $ \(kbuf, ksize) -> do+        withPtrLen key $ \(kbuf, ksize) -> do           ptr <- c_tcbdbget4 bdb' kbuf ksize           if ptr == nullPtr-            then return []-            else peekTCListAndFree ptr+            then empty+            else peekList' ptr  -- | Return the number of records corresponding to a key. -vnum :: (S.Storable k) => BDB -> k -> IO (Maybe Int)+vnum :: (Storable k) => BDB -> k -> IO (Maybe Int) vnum bdb key =     withForeignPtr (unTCBDB bdb) $ \bdb' ->-        S.withPtrLen key $ \(kbuf, ksize) -> do+        withPtrLen key $ \(kbuf, ksize) -> do             res <- c_tcbdbvnum bdb' kbuf ksize             return $ if res == 0                        then Nothing@@ -213,11 +233,11 @@  -- | Return the size of the value of a record. If the key of duplicated -- records is specified, the first one is selected.-vsiz :: (S.Storable k) => BDB -> k -> IO (Maybe Int)+vsiz :: (Storable k) => BDB -> k -> IO (Maybe Int) vsiz = vsizHelper c_tcbdbvsiz unTCBDB  -- | Return list of keys in the specified range.-range :: (S.Storable k) =>+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@@ -228,29 +248,29 @@       -> 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 [k]  -- ^ keys in the specified range.+      -> 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) >>= peekTCListAndFree+                             (fromIntegral maxn) >>= peekList'     where-      withPtrLen' (Just key) action = S.withPtrLen key action+      withPtrLen' (Just key) action = withPtrLen key action       withPtrLen' Nothing action = action (nullPtr, 0)  -- | Return list of forward matched keys.-fwmkeys :: (S.Storable k1, S.Storable k2) =>+fwmkeys :: (Storable k1, Storable k2, Sequence q) =>            BDB    -- ^ BDB object-        -> k1      -- ^ search string+        -> k1     -- ^ search string         -> Int    -- ^ the maximum number of keys to be fetched. If it                   -- is negative value, no limit is specified.-        -> IO [k2] -- ^ keys matches specified string (in forward matching).+        -> 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 :: (S.Storable k) =>+addint :: (Storable k) =>           BDB   -- ^ BDB object.        -> k     -- ^ Key.        -> Int   -- ^ Amount of increment.@@ -259,7 +279,7 @@  -- | Increment the corresponding value. (The value specified by a key -- is treated as double.)-adddouble :: (S.Storable k) =>+adddouble :: (Storable k) =>              BDB    -- ^ BDB object.           -> k      -- ^ Key.           -> Double -- ^ Amount of increment.@@ -311,9 +331,9 @@ path = pathHelper c_tcbdbpath unTCBDB  -- | Return the number of records in the database.-rnum :: BDB -> IO Int64+rnum :: BDB -> IO Word64 rnum bdb = withForeignPtr (unTCBDB bdb) c_tcbdbrnum  -- | Return the size of the database file.-fsiz :: BDB -> IO Int64+fsiz :: BDB -> IO Word64 fsiz bdb = withForeignPtr (unTCBDB bdb) c_tcbdbfsiz
Database/TokyoCabinet/BDB/C.hsc view
@@ -205,7 +205,7 @@   c_tcbdbpath :: Ptr BDB' -> IO CString  foreign import ccall safe "tcbdbrnum"-  c_tcbdbrnum :: Ptr BDB' -> IO Int64+  c_tcbdbrnum :: Ptr BDB' -> IO Word64  foreign import ccall safe "tcbdbfsiz"-  c_tcbdbfsiz :: Ptr BDB' -> IO Int64+  c_tcbdbfsiz :: Ptr BDB' -> IO Word64
Database/TokyoCabinet/FDB.hs view
@@ -41,7 +41,8 @@ import Database.TokyoCabinet.FDB.C import Database.TokyoCabinet.FDB.Key import Database.TokyoCabinet.Internal-import qualified Database.TokyoCabinet.Storable as S+import Database.TokyoCabinet.Sequence+import Database.TokyoCabinet.Storable  import Foreign.Ptr import Foreign.ForeignPtr@@ -123,25 +124,25 @@ close fdb = withForeignPtr (unTCFDB fdb) c_tcfdbclose  type FunPut' = Ptr FDB' -> Int64 -> Ptr Word8 -> CInt -> IO Bool-putHelper' :: (Key k, S.Storable v) => FunPut' -> FDB -> k -> v -> IO Bool+putHelper' :: (Key k, Storable v) => FunPut' -> FDB -> k -> v -> IO Bool putHelper' func fdb key val =     withForeignPtr (unTCFDB fdb) $ \fdb' ->-        S.withPtrLen val $ \(vbuf, vsize) -> do+        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, S.Storable v) => FDB -> k -> v -> IO Bool+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, S.Storable v) => FDB -> k -> v -> IO Bool+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, S.Storable v) => FDB -> k -> v -> IO Bool+putcat :: (Key k, Storable v) => FDB -> k -> v -> IO Bool putcat =  putHelper' c_tcfdbputcat  -- | Delete a record. @@ -151,14 +152,14 @@         c_tcfdbout fdb' =<< keyToInt key  -- | Return the value of record. -get :: (Key k, S.Storable v) => FDB -> k -> IO (Maybe v)+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' -> S.peekPtrLen (vbuf', vsize)+          flip maybePeek vbuf $ \vbuf' -> peekPtrLen (vbuf', vsize)  -- | Return the byte size of value in a record. vsiz :: (Key k) => FDB -> k -> IO (Maybe Int)@@ -200,8 +201,9 @@           return $ map (fromID . ID) keys  -- | Return list of forward matched keys.-fwmkeys :: (S.Storable k1, S.Storable k2) => FDB -> k1 -> Int -> IO [k2]-fwmkeys fdb k maxn = map S.fromString `fmap` fwmkeys' fdb k maxn+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@@ -249,11 +251,11 @@ path = pathHelper c_tcfdbpath unTCFDB  -- | Return the number of records in the database.-rnum :: FDB -> IO Int64+rnum :: FDB -> IO Word64 rnum fdb = withForeignPtr (unTCFDB fdb) c_tcfdbrnum  -- | Return the size of the database file.-fsiz :: FDB -> IO Int64+fsiz :: FDB -> IO Word64 fsiz fdb = withForeignPtr (unTCFDB fdb) c_tcfdbfsiz  keyToInt :: (Key k) => k -> IO Int64
Database/TokyoCabinet/FDB/C.hsc view
@@ -193,7 +193,7 @@   c_tcfdbpath :: Ptr FDB' -> IO CString  foreign import ccall safe "tcfdbrnum"-  c_tcfdbrnum :: Ptr FDB' -> IO Int64+  c_tcfdbrnum :: Ptr FDB' -> IO Word64  foreign import ccall safe "tcfdbfsiz"-  c_tcfdbfsiz :: Ptr FDB' -> IO Int64+  c_tcfdbfsiz :: Ptr FDB' -> IO Word64
Database/TokyoCabinet/HDB.hs view
@@ -49,11 +49,13 @@ import Foreign.Marshal.Utils (maybePeek)  import Data.Int+import Data.Word  import Database.TokyoCabinet.HDB.C import Database.TokyoCabinet.Error import Database.TokyoCabinet.Internal-import qualified Database.TokyoCabinet.Storable as S+import Database.TokyoCabinet.Sequence+import Database.TokyoCabinet.Storable  -- $doc -- Example@@ -151,32 +153,32 @@ -- be instance of Storable class.  Usually, we can use `String', -- `ByteString' for key, `String', `ByteString', `Int', `Double' for -- value.-put :: (S.Storable k, S.Storable v) => HDB -> k -> v -> IO Bool+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 :: (S.Storable k, S.Storable v) => HDB -> k -> v -> IO Bool+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 :: (S.Storable k, S.Storable v) => HDB -> k -> v -> IO Bool+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 :: (S.Storable k, S.Storable v) => HDB -> k -> v -> IO Bool+putasync :: (Storable k, Storable v) => HDB -> k -> v -> IO Bool putasync = putHelper c_tchdbputasync unTCHDB  -- | Delete a record.-out :: (S.Storable k) => HDB -> k -> IO Bool+out :: (Storable k) => HDB -> k -> IO Bool out = outHelper c_tchdbout unTCHDB  -- | Return the value of record. -get :: (S.Storable k, S.Storable v) => HDB -> k -> IO (Maybe v)+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 :: (S.Storable k) => HDB -> k -> IO (Maybe Int)+vsiz :: (Storable k) => HDB -> k -> IO (Maybe Int) vsiz = vsizHelper c_tchdbvsiz unTCHDB  -- | Initialize the iterator of a HDB object.@@ -184,27 +186,28 @@ iterinit hdb = withForeignPtr (unTCHDB hdb) c_tchdbiterinit  -- | Return the next key of the iterator of a HDB object.-iternext :: (S.Storable k) => HDB -> IO (Maybe k)+iternext :: (Storable k) => HDB -> IO (Maybe k) iternext hdb =     withForeignPtr (unTCHDB hdb) $ \p ->         alloca $ \sizbuf -> do             vbuf <- c_tchdbiternext p sizbuf             flip maybePeek vbuf $ \vp ->                 do siz <- peek sizbuf-                   S.peekPtrLen (vp, siz)+                   peekPtrLen (vp, siz)  -- | Return list of forward matched keys.-fwmkeys :: (S.Storable k1, S.Storable k2) => HDB -> k1 -> Int -> IO [k2]+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 :: (S.Storable k) => HDB -> k -> Int -> IO (Maybe Int)+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 :: (S.Storable k) => HDB -> k -> Double -> IO (Maybe 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@@ -249,9 +252,9 @@ path = pathHelper c_tchdbpath unTCHDB  -- | Return the number of records in the database.-rnum :: HDB -> IO Int64+rnum :: HDB -> IO Word64 rnum hdb = withForeignPtr (unTCHDB hdb) c_tchdbrnum  -- | Return the size of the database file.-fsiz :: HDB -> IO Int64+fsiz :: HDB -> IO Word64 fsiz hdb = withForeignPtr (unTCHDB hdb) c_tchdbfsiz
Database/TokyoCabinet/HDB/C.hsc view
@@ -161,7 +161,7 @@   c_tchdbpath :: Ptr HDB' -> IO CString  foreign import ccall safe "tchdbrnum"-  c_tchdbrnum :: Ptr HDB' -> IO Int64+  c_tchdbrnum :: Ptr HDB' -> IO Word64  foreign import ccall safe "tchdbfsiz"-  c_tchdbfsiz :: Ptr HDB' -> IO Int64+  c_tchdbfsiz :: Ptr HDB' -> IO Word64
Database/TokyoCabinet/Internal.hs view
@@ -2,6 +2,7 @@  import Database.TokyoCabinet.List.C import Database.TokyoCabinet.Storable+import Database.TokyoCabinet.Sequence  import Foreign.Ptr import Foreign.ForeignPtr@@ -13,21 +14,6 @@  import Data.Word -peekTCListAndFree :: (Storable a) => Ptr LIST -> IO [a]-peekTCListAndFree list = do-  vals <- peekTCList' list []-  c_tclistdel list-  return vals- where-   peekTCList' tclist acc = -       alloca $ \sizbuf ->-           do val <- c_tclistpop tclist sizbuf-              siz <- peek sizbuf-              if val == nullPtr-                then return acc-                else do elm <- peekPtrLen (val, siz)-                        peekTCList' tclist (elm:acc)- type Lifter ptr tcdb = Ptr ptr -> tcdb type UnLifter tcdb fptr = tcdb -> ForeignPtr fptr type Combiner mode c_mode = [mode] -> c_mode@@ -97,12 +83,12 @@                        else Just $ cast_out sumval  -fwmHelper :: (Storable a, Storable b) =>-             FunFwm p -> UnLifter tcdb p -> tcdb -> a -> Int -> IO [b]+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) >>= peekTCListAndFree+            c_fwm db kbuf ksiz (fromIntegral maxn) >>= peekList'  vsizHelper :: (Storable a) =>               FunVsiz p -> UnLifter tcdb p -> tcdb -> a -> IO (Maybe Int)
Database/TokyoCabinet/List.hs view
@@ -19,7 +19,7 @@     , clear     , dump     , load-    , TCList+    , List     ) where  import Foreign.Ptr@@ -29,38 +29,36 @@ import Foreign.Marshal.Utils (maybePeek, copyBytes)  import Database.TokyoCabinet.List.C-import qualified Database.TokyoCabinet.Storable as S+import Database.TokyoCabinet.Storable  import Data.ByteString.Unsafe import qualified Data.ByteString as B -data TCList = TCList { unTCList :: !(ForeignPtr LIST) }--new :: IO TCList-new = c_tclistnew >>= newForeignPtr tclistFinalizer >>= return . TCList+new :: IO (List a)+new = c_tclistnew >>= newForeignPtr tclistFinalizer >>= return . List -new2 :: Int -> IO TCList+new2 :: Int -> IO (List a) new2 n = do   l <- c_tclistnew2 (fromIntegral n)   p <- newForeignPtr tclistFinalizer l-  return $ TCList p+  return $ List p -copy :: TCList -> IO TCList+copy :: List a -> IO (List a) copy tcls =     withForeignPtr (unTCList tcls) $ \p -> do       l <- c_tclistdup p-      TCList `fmap` newForeignPtr tclistFinalizer l+      List `fmap` newForeignPtr tclistFinalizer l -delete :: TCList -> IO ()+delete :: List a -> IO () delete tcls = finalizeForeignPtr (unTCList tcls) -len :: TCList -> IO Int+len :: List a -> IO Int len tcls =     withForeignPtr (unTCList tcls) $ \p -> do         n <- c_tclistnum p         return $ fromIntegral n -get :: (S.Storable a) => TCList -> Int -> IO (Maybe a)+get :: (Storable a) => List a -> Int -> IO (Maybe a) get tcls index =     withForeignPtr (unTCList tcls) $ \p ->         alloca $ \sizbuf -> do@@ -69,82 +67,82 @@               do siz <- peek sizbuf                  buf <- mallocBytes (fromIntegral siz)                  copyBytes buf vp (fromIntegral siz)-                 S.peekPtrLen (buf, fromIntegral siz)+                 peekPtrLen (buf, fromIntegral siz) -push :: (S.Storable a) => TCList -> a -> IO ()+push :: (Storable a) => List a -> a -> IO () push tcls val =     withForeignPtr (unTCList tcls) $ \p ->-        S.withPtrLen val $ \(vbuf, vsiz) ->+        withPtrLen val $ \(vbuf, vsiz) ->             c_tclistpush p (castPtr vbuf) (fromIntegral vsiz) -pop :: (S.Storable a) => TCList -> IO (Maybe a)+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-               S.peekPtrLen (vp, fromIntegral siz)+               peekPtrLen (vp, fromIntegral siz) -unshift :: (S.Storable a) => TCList -> a -> IO ()+unshift :: (Storable a) => List a -> a -> IO () unshift tcls val =     withForeignPtr (unTCList tcls) $ \p ->-        S.withPtrLen val $ \(vbuf, vsiz) ->+        withPtrLen val $ \(vbuf, vsiz) ->             c_tclistunshift p (castPtr vbuf) (fromIntegral vsiz) -shift :: (S.Storable a) => TCList -> IO (Maybe a)+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-               S.peekPtrLen (vp, fromIntegral siz)+               peekPtrLen (vp, fromIntegral siz) -insert :: (S.Storable a) => TCList -> Int -> a -> IO ()+insert :: (Storable a) => List a -> Int -> a -> IO () insert tcls index val =     withForeignPtr (unTCList tcls) $ \p ->-        S.withPtrLen val $ \(vbuf, vsiz) ->+        withPtrLen val $ \(vbuf, vsiz) ->             c_tclistinsert p (fromIntegral index) (castPtr vbuf)                              (fromIntegral vsiz) -remove :: (S.Storable a) => TCList -> Int -> IO (Maybe a)+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-               S.peekPtrLen (vp, fromIntegral siz)+               peekPtrLen (vp, fromIntegral siz) -over :: (S.Storable a) => TCList -> Int -> a -> IO ()+over :: (Storable a) => List a -> Int -> a -> IO () over tcls index val =     withForeignPtr (unTCList tcls) $ \p ->-        S.withPtrLen val $ \(vbuf, vsiz) ->+        withPtrLen val $ \(vbuf, vsiz) ->             c_tclistover p (fromIntegral index) (castPtr vbuf)                            (fromIntegral vsiz) -sort :: TCList -> IO ()+sort :: List a -> IO () sort tcls = withForeignPtr (unTCList tcls) c_tclistsort -lsearch :: (S.Storable a) => TCList -> a -> IO Int+lsearch :: (Storable a) => List a -> a -> IO Int lsearch tcls key =     withForeignPtr (unTCList tcls) $ \p ->-        S.withPtrLen key $ \(kbuf, ksiz) ->+        withPtrLen key $ \(kbuf, ksiz) ->             fmap fromIntegral $                  c_tclistlsearch p (castPtr kbuf) (fromIntegral ksiz) -bsearch :: (S.Storable a) => TCList -> a -> IO Int+bsearch :: (Storable a) => List a -> a -> IO Int bsearch tcls key =     withForeignPtr (unTCList tcls) $ \p ->-        S.withPtrLen key $ \(kbuf, ksiz) ->+        withPtrLen key $ \(kbuf, ksiz) ->             fmap fromIntegral $                  c_tclistbsearch p (castPtr kbuf) (fromIntegral ksiz) -clear :: TCList -> IO ()+clear :: List a -> IO () clear tcls = withForeignPtr (unTCList tcls) c_tclistclear -dump :: TCList -> IO B.ByteString+dump :: List a -> IO B.ByteString dump tcls =     withForeignPtr (unTCList tcls) $ \p ->         alloca $ \sizbuf -> do@@ -152,8 +150,8 @@             size <- fromIntegral `fmap` peek sizbuf             unsafePackCStringFinalizer (castPtr c_str) size (free c_str) -load :: B.ByteString -> IO TCList+load :: B.ByteString -> IO (List a) load bytes =     unsafeUseAsCStringLen bytes $ \(buf, siz) -> do       tclis <- c_tclistload (castPtr buf) (fromIntegral siz)-      TCList `fmap` newForeignPtr tclistFinalizer tclis+      List `fmap` newForeignPtr tclistFinalizer tclis
Database/TokyoCabinet/List/C.hs view
@@ -7,6 +7,9 @@ import Foreign.Ptr import Foreign.C.Types import Foreign.C.String+import Foreign.ForeignPtr++data List a = List { unTCList :: !(ForeignPtr LIST) }  data LIST
+ Database/TokyoCabinet/Sequence.hs view
@@ -0,0 +1,63 @@+module 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.cabal view
@@ -1,6 +1,6 @@ Name:           tokyocabinet-haskell-Version:        0.0.1-Cabal-Version:  >= 1.6.0.2+Version:        0.0.2+Cabal-Version:  >= 1.2 License:        BSD3 License-File:   LICENSE Author:         Tom Tsuruhara@@ -38,6 +38,8 @@     Database.TokyoCabinet.List     Database.TokyoCabinet.List.C     Database.TokyoCabinet.Storable+    Database.TokyoCabinet.Sequence+   other-modules:     Database.TokyoCabinet.Internal   Extensions:           CPP, ForeignFunctionInterface,