Merge pull request #17 from ezyang/master

Convert to use hashtables, as Data.HashTable went away.
This commit is contained in:
Fedor Gogolev 2013-12-19 22:36:38 -08:00
commit beee0c055b
4 changed files with 7 additions and 6 deletions

View file

@ -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 #-}

View file

@ -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

View file

@ -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

View file

@ -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