Merge pull request #17 from ezyang/master
Convert to use hashtables, as Data.HashTable went away.
This commit is contained in:
commit
beee0c055b
4 changed files with 7 additions and 6 deletions
|
@ -35,7 +35,7 @@ import Data.IORef (IORef, newIORef, readIORef, writeIORef)
|
||||||
import Data.Set (Set)
|
import Data.Set (Set)
|
||||||
import System.IO.Unsafe (unsafePerformIO)
|
import System.IO.Unsafe (unsafePerformIO)
|
||||||
|
|
||||||
import qualified Data.HashTable as H
|
import qualified Data.HashTable.IO as H
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
|
|
||||||
import Control.Monad.Trans (MonadIO, liftIO)
|
import Control.Monad.Trans (MonadIO, liftIO)
|
||||||
|
@ -148,7 +148,7 @@ dropIndexes coll = do
|
||||||
|
|
||||||
-- *** Index cache
|
-- *** Index cache
|
||||||
|
|
||||||
type DbIndexCache = H.HashTable Database IndexCache
|
type DbIndexCache = H.BasicHashTable Database IndexCache
|
||||||
-- ^ Cache the indexes we create so repeatedly calling ensureIndex only hits database the first time. Clear cache every once in a while so if someone else deletes index we will recreate it on ensureIndex.
|
-- ^ Cache the indexes we create so repeatedly calling ensureIndex only hits database the first time. Clear cache every once in a while so if someone else deletes index we will recreate it on ensureIndex.
|
||||||
|
|
||||||
type IndexCache = IORef (Set (Collection, IndexName))
|
type IndexCache = IORef (Set (Collection, IndexName))
|
||||||
|
@ -156,7 +156,7 @@ type IndexCache = IORef (Set (Collection, IndexName))
|
||||||
dbIndexCache :: DbIndexCache
|
dbIndexCache :: DbIndexCache
|
||||||
-- ^ initialize cache and fork thread that clears it every 15 minutes
|
-- ^ initialize cache and fork thread that clears it every 15 minutes
|
||||||
dbIndexCache = unsafePerformIO $ do
|
dbIndexCache = unsafePerformIO $ do
|
||||||
table <- H.new (==) (H.hashString . T.unpack)
|
table <- H.new
|
||||||
_ <- forkIO . forever $ threadDelay 900000000 >> clearDbIndexCache
|
_ <- forkIO . forever $ threadDelay 900000000 >> clearDbIndexCache
|
||||||
return table
|
return table
|
||||||
{-# NOINLINE dbIndexCache #-}
|
{-# NOINLINE dbIndexCache #-}
|
||||||
|
|
|
@ -561,7 +561,7 @@ newCursor :: (MonadIO m, MonadBaseControl IO m) => Database -> Collection -> Bat
|
||||||
newCursor db col batchSize dBatch = do
|
newCursor db col batchSize dBatch = do
|
||||||
var <- newMVar dBatch
|
var <- newMVar dBatch
|
||||||
let cursor = Cursor (db <.> col) batchSize var
|
let cursor = Cursor (db <.> col) batchSize var
|
||||||
mkWeakMVar var (closeCursor cursor)
|
_ <- mkWeakMVar var (closeCursor cursor)
|
||||||
return cursor
|
return cursor
|
||||||
#if !MIN_VERSION_base(4,6,0)
|
#if !MIN_VERSION_base(4,6,0)
|
||||||
where mkWeakMVar = addMVarFinalizer
|
where mkWeakMVar = addMVarFinalizer
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
|
|
||||||
A pipeline closes itself when a read or write causes an error, so you can detect a broken pipeline by checking isClosed. It also closes itself when garbage collected, or you can close it explicitly. -}
|
A pipeline closes itself when a read or write causes an error, so you can detect a broken pipeline by checking isClosed. It also closes itself when garbage collected, or you can close it explicitly. -}
|
||||||
|
|
||||||
{-# LANGUAGE DoRec, RecordWildCards, NamedFieldPuns, ScopedTypeVariables #-}
|
{-# LANGUAGE RecursiveDo, RecordWildCards, NamedFieldPuns, ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
|
|
||||||
module System.IO.Pipeline (
|
module System.IO.Pipeline (
|
||||||
|
@ -69,7 +69,7 @@ newPipeline stream = do
|
||||||
rec
|
rec
|
||||||
let pipe = Pipeline{..}
|
let pipe = Pipeline{..}
|
||||||
listenThread <- forkIO (listen pipe)
|
listenThread <- forkIO (listen pipe)
|
||||||
mkWeakMVar vStream $ do
|
_ <- mkWeakMVar vStream $ do
|
||||||
killThread listenThread
|
killThread listenThread
|
||||||
closeStream stream
|
closeStream stream
|
||||||
return pipe
|
return pipe
|
||||||
|
|
|
@ -37,6 +37,7 @@ Library
|
||||||
, monad-control >= 0.3.1
|
, monad-control >= 0.3.1
|
||||||
, lifted-base >= 0.1.0.3
|
, lifted-base >= 0.1.0.3
|
||||||
, transformers-base >= 0.4.1
|
, transformers-base >= 0.4.1
|
||||||
|
, hashtables >= 1.1.2.0
|
||||||
|
|
||||||
Exposed-modules: Database.MongoDB
|
Exposed-modules: Database.MongoDB
|
||||||
Database.MongoDB.Admin
|
Database.MongoDB.Admin
|
||||||
|
|
Loading…
Reference in a new issue