~singpolyma/tokyocabinet-haskell

ref: af8273e0c45915ec74cbfdd088b21f12046c9de6 tokyocabinet-haskell/Database/TokyoCabinet/Associative.hs -rw-r--r-- 1.4 KiB View raw
af8273e0Stephen Paul Weber Let cabal know about the tests, and fix warnings 3 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
module Database.TokyoCabinet.Associative where

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