createIndex
This commit is contained in:
parent
f173d9d0a7
commit
46839acdbc
2 changed files with 41 additions and 2 deletions
|
@ -45,6 +45,10 @@ module Database.MongoDB
|
||||||
-- * Cursor
|
-- * Cursor
|
||||||
Cursor,
|
Cursor,
|
||||||
allDocs, allDocs', finish, nextDoc,
|
allDocs, allDocs', finish, nextDoc,
|
||||||
|
-- * Index
|
||||||
|
Key, Unique,
|
||||||
|
Direction(..),
|
||||||
|
createIndex,
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
|
@ -363,7 +367,7 @@ countMatching :: Connection -> FullCollection -> Selector -> IO Int64
|
||||||
countMatching c col sel = do
|
countMatching c col sel = do
|
||||||
let (db, col') = splitFullCol col
|
let (db, col') = splitFullCol col
|
||||||
res <- runCommand c db $ toBsonDoc [("count", toBson col'),
|
res <- runCommand c db $ toBsonDoc [("count", toBson col'),
|
||||||
("query", BsonObject sel)]
|
("query", toBson sel)]
|
||||||
return $ fromBson $ fromJust $ BSON.lookup "n" res
|
return $ fromBson $ fromJust $ BSON.lookup "n" res
|
||||||
|
|
||||||
-- | Delete documents matching /Selector/ from the given /FullCollection/.
|
-- | Delete documents matching /Selector/ from the given /FullCollection/.
|
||||||
|
@ -610,6 +614,40 @@ finish cur = do
|
||||||
writeIORef (curClosed cur) True
|
writeIORef (curClosed cur) True
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
|
-- | The field key to index on.
|
||||||
|
type Key = String
|
||||||
|
|
||||||
|
-- | Direction to index.
|
||||||
|
data Direction = Ascending
|
||||||
|
| Descending
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
fromDirection :: Direction -> Int
|
||||||
|
fromDirection Ascending = 1
|
||||||
|
fromDirection Descending = (-1)
|
||||||
|
|
||||||
|
-- | Should this index guarantee uniqueness?
|
||||||
|
type Unique = Bool
|
||||||
|
|
||||||
|
createIndex :: Connection -> FullCollection ->
|
||||||
|
[(Key, Direction)] -> Unique -> IO String
|
||||||
|
createIndex c col keys uniq = do
|
||||||
|
let (db, _col') = splitFullCol col
|
||||||
|
name = indexName keys
|
||||||
|
keysDoc = flip fmap keys $
|
||||||
|
\(k, d) -> (k, toBson $ fromDirection d :: BsonValue)
|
||||||
|
_ <- insert c (db ++ ".system.indexes") $
|
||||||
|
toBsonDoc [("name", toBson name),
|
||||||
|
("ns", toBson col),
|
||||||
|
("key", toBson keysDoc),
|
||||||
|
("unique", toBson uniq)]
|
||||||
|
return name
|
||||||
|
|
||||||
|
indexName :: [(Key, Direction)] -> String
|
||||||
|
indexName = List.concat . List.intersperse "_" . fmap partName
|
||||||
|
where partName (k, Ascending) = k ++ "_1"
|
||||||
|
partName (k, Descending) = k ++ "_-1"
|
||||||
|
|
||||||
putCol :: Collection -> Put
|
putCol :: Collection -> Put
|
||||||
putCol col = putByteString (pack col) >> putNull
|
putCol col = putByteString (pack col) >> putNull
|
||||||
|
|
||||||
|
|
3
TODO
3
TODO
|
@ -44,7 +44,6 @@ MongoDB
|
||||||
* repsert
|
* repsert
|
||||||
* rename
|
* rename
|
||||||
- index operations
|
- index operations
|
||||||
* createIndex
|
|
||||||
* ensureIndex
|
* ensureIndex
|
||||||
* dropIndex
|
* dropIndex
|
||||||
* dropIndexes
|
* dropIndexes
|
||||||
|
@ -100,3 +99,5 @@ Documentation
|
||||||
- tutorial
|
- tutorial
|
||||||
|
|
||||||
GridFS
|
GridFS
|
||||||
|
|
||||||
|
what's this about index caching?
|
||||||
|
|
Loading…
Reference in a new issue