Vergara_Tech/mongodb
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Support for TTL

Browse source
This commit is contained in:
Ralph Morton 2015-06-19 18:26:38 +02:00
parent cb912cb952
commit 9087719087
1 changed files with 5 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
Database/MongoDB/Admin.hs
View file

@ -34,6 +34,7 @@ import Control.Applicative ((<$>))
import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent (forkIO, threadDelay)
import Control.Monad (forever, unless, liftM) import Control.Monad (forever, unless, liftM)
import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Maybe (maybeToList)
import Data.Set (Set) import Data.Set (Set)
import System.IO.Unsafe (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO)
@ -98,7 +99,8 @@ data Index = Index {
iKey :: Order, iKey :: Order,
iName :: IndexName, iName :: IndexName,
iUnique :: Bool, iUnique :: Bool,
iDropDups :: Bool iDropDups :: Bool,
iExpireAfterSeconds :: Maybe Int
} deriving (Show, Eq) } deriving (Show, Eq)
idxDocument :: Index -> Database -> Document idxDocument :: Index -> Database -> Document
@ -107,11 +109,11 @@ idxDocument Index{..} db = [
"key" =: iKey, "key" =: iKey,
"name" =: iName, "name" =: iName,
"unique" =: iUnique, "unique" =: iUnique,
"dropDups" =: iDropDups ] "dropDups" =: iDropDups ] ++ (maybeToList $ fmap ((=:) "expireAfterSeconds") iExpireAfterSeconds)
index :: Collection -> Order -> Index index :: Collection -> Order -> Index
-- ^ Spec of index of ordered keys on collection. Name is generated from keys. Unique and dropDups are False. -- ^ Spec of index of ordered keys on collection. Name is generated from keys. Unique and dropDups are False.
index coll keys = Index coll keys (genName keys) False False index coll keys = Index coll keys (genName keys) False False Nothing
genName :: Order -> IndexName genName :: Order -> IndexName
genName keys = T.intercalate "_" (map f keys) where genName keys = T.intercalate "_" (map f keys) where