diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,21 @@ +### 0.1.1.0 + +* fixed index update bug: new references were added, but the ones from the +previous version of the document were not removed +* added sort order argument to range queries +* `lookup` returns just `Maybe a` +* renamed `lookupUnique` to `unique'` +* renamed `filter` to `filterRange` +* renamed `rangeK` to `range'` +* changed argument order in `range`, `range'`, `filterRange` to match SQL +* added `unique` +* added `filter` +* added `filterRange'`, `filter'` + +### 0.1.0.1 + +* fixed a GC bug: `swapDb` failed to swap + ### 0.1 * initial release diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -17,19 +17,18 @@ (see example below). * **minimal boilerplate**: instead of *TemplateHaskell* we use [`GHC.Generics`][gen] and [`deriving`][der]. -* **simple monad for writing queries**, with standard primitive operations like: -`lookup`, `insert`, `update`, `delete`, `range`, `filter`. -* range queries (`filter` and `range`) afford efficient **cursor-like -navigation** (paging) through large datasets. For example this is the -equivalent SQL for `filter`: +* **monadic queries**, with standard primitive operations like: +`lookup`, `insert`, `update`, `delete`, `filter`, `range`, and `filterRange`. +* range queries afford efficient **cursor-like navigation** (paging) through +large datasets. For example this is the equivalent SQL for `filterRange`: ```SQL SELECT TOP page * FROM table WHERE (filterFld = filterVal) AND (sortVal = NULL OR sortFld < sortVal) AND (sortKey = NULL OR ID < sortKey) -ORDER BY field, ID DESC +ORDER BY sortFld, ID DESC ``` -* **easy to reason about performance**: all primitive queries run in **O(log n)**. +* **easy to reason about performance**: all primitive queries run in **O(p*log(n))**. * **type safety**: impossible to attempt deserializing a record at a wrong type (or address), and risk getting bogus data with no error thrown. References are tagged with a phantom type and created only by the database. @@ -38,11 +37,19 @@ * **multiple backends** supported: currently *file*, and soon (:tm:) *in-memory*, *remote*. * **portability**: it should work on all platforms, including mobile. -* **replication**: soon (:tm:) +* p2p **replication**: soon (:tm:) -*Note: some of these features become misfeatures for certain scenarios which +*Note: Some of these features become misfeatures for certain scenarios which would make either a pure in-memory cache, or a real database more appropriate.* +*In particular the query language is very basic at the current stage. Sure, you +can use the customary `Functor` / `Applicative` / `Monad` interface, but you will +have to write all kinds of wrapper queries to make things manageable.* + +*The design principle is to only upgrade the query language in tandem with the indexes. +Right now the indexes are not very smart, so the query language will not lie +about it with some nice but poorly implemented abstraction.* + Example use ----------- First, mark up your types. You must use the record syntax to name the @@ -96,8 +103,7 @@ return (pid, p) postsByContrib :: Reference Person -> Transaction l m [(Reference BlogPost, BlogPost)] -postsByContrib pid = - filter (Just pid) Nothing Nothing "postContributors" "postTitle" 1000 +postsByContrib pid = filter "postContributors" (Just pid) "postTitle" flagContributor :: Reference Person -> Transaction l m () flagContributor pid = do @@ -144,8 +150,8 @@ live up to the "document-oriented" label, but this should be optional - [ ] better migration story - [ ] radix tree / PATRICIA implementation for proper full-text search -(currently indexing strings just takes first 4/8 chars and turnes them into an int, -which is good enough for simple sorting) +(currently indexing strings just takes first 4/8 chars and turns them into an int, +which is good enough for basic sorting) - [ ] replication - [ ] more advanced & flexible index system supporting complex indexes, joins, etc. - [ ] fancy query language @@ -164,7 +170,7 @@ potentially very large string fields, typical in "document-oriented" scenarios. It was suggested that in such cases you should store this data in external files. But then, if you want to regain the ACID property, and already have some indexes -laying aroung, you are well on your way of creating *muesli*. +laying around, you are well on your way of creating *muesli*. * data file only contains serialized records and gaps, no metadata * LRU cache holds deserialized objects wrapped in `Data.Dynamic`. On SSDs deserialization is far more costly than file IO, diff --git a/muesli.cabal b/muesli.cabal --- a/muesli.cabal +++ b/muesli.cabal @@ -1,9 +1,9 @@ name: muesli category: Database -version: 0.1.0.1 +version: 0.1.1.0 synopsis: A simple document-oriented database description: - @muesli@ is an easy to use + @muesli@ is a simple featuring ACID transactions, automatic index management and minimal boilerplate. diff --git a/src/Database/Muesli/Backend/File.hs b/src/Database/Muesli/Backend/File.hs --- a/src/Database/Muesli/Backend/File.hs +++ b/src/Database/Muesli/Backend/File.hs @@ -14,6 +14,9 @@ -- Portability : portable -- -- Binary seekable file backend that uses 'Prelude' functions. +-- +-- Only one process at a time can safely use the files, but file locking is not +-- yet implemented. ---------------------------------------------------------------------------- module Database.Muesli.Backend.File diff --git a/src/Database/Muesli/Commit.hs b/src/Database/Muesli/Commit.hs --- a/src/Database/Muesli/Commit.hs +++ b/src/Database/Muesli/Commit.hs @@ -187,8 +187,8 @@ -- -- It periodically checks for new records in the 'logPend', and processes them, -- by adding a 'Completed' record to the log file with 'logAppend', and --- updating indexes with 'updateMainIdx', 'updateRefIdx', 'updateSortIdx' and --- 'updateUnqIdx', after writing (without master lock) the serialized documents +-- updating indexes with 'updateMainIndex', 'updateFilterIndex', 'updateSortIndex' and +-- 'updateUniqueIndex', after writing (without master lock) the serialized documents -- in the data file with 'writeDocument'. -- It also moves the records from 'logPend' to 'logComp'. commitThread :: LogState l => Handle l -> Bool -> IO () @@ -214,10 +214,10 @@ let m' = m { logState = st , logPend = lgp , logComp = lgc - , mainIdx = updateMainIdx (mainIdx m) rs' - , unqIdx = updateUnqIdx (unqIdx m) rs' - , sortIdx = updateSortIdx (sortIdx m) rs' - , refIdx = updateRefIdx (refIdx m) rs' + , mainIdx = updateMainIndex (mainIdx m) rs' + , unqIdx = updateUniqueIndex (mainIdx m) (unqIdx m) rs' + , sortIdx = updateSortIndex (mainIdx m) (sortIdx m) rs' + , refIdx = updateFilterIndex (mainIdx m) (refIdx m) rs' } return (m', null lgp)) return (kill, (kill, wait)) diff --git a/src/Database/Muesli/GC.hs b/src/Database/Muesli/GC.hs --- a/src/Database/Muesli/GC.hs +++ b/src/Database/Muesli/GC.hs @@ -81,10 +81,10 @@ let dataPath = dataDbPath (unHandle h) let dataPathNew = dataPath ++ ".new" buildDataFile dataPathNew rs2 h - let mIdx = updateMainIdx IntMap.empty rs' - let uIdx = updateUnqIdx IntMap.empty rs' - let iIdx = updateSortIdx IntMap.empty rs' - let rIdx = updateRefIdx IntMap.empty rs' + let mIdx = updateMainIndex IntMap.empty rs' + let uIdx = updateUniqueIndex IntMap.empty IntMap.empty rs' + let iIdx = updateSortIndex IntMap.empty IntMap.empty rs' + let rIdx = updateFilterIndex IntMap.empty IntMap.empty rs' when (forceEval mIdx iIdx rIdx) $ withCommitSgn h $ \kill -> do withMaster h $ \nm -> do let (ncrs', dpos') = realloc dpos . concat . Map.elems $ @@ -106,10 +106,10 @@ , gaps = gs , logPend = logp' , logComp = Map.empty - , mainIdx = updateMainIdx mIdx ncrs - , unqIdx = updateUnqIdx uIdx ncrs - , sortIdx = updateSortIdx iIdx ncrs - , refIdx = updateRefIdx rIdx ncrs + , mainIdx = updateMainIndex mIdx ncrs + , unqIdx = updateUniqueIndex mIdx uIdx ncrs + , sortIdx = updateSortIndex mIdx iIdx ncrs + , refIdx = updateFilterIndex mIdx rIdx ncrs } return (m, ()) withData h $ \(DataState _ cache) -> do diff --git a/src/Database/Muesli/Handle.hs b/src/Database/Muesli/Handle.hs --- a/src/Database/Muesli/Handle.hs +++ b/src/Database/Muesli/Handle.hs @@ -125,10 +125,10 @@ shows tid " found for nonexisting transaction." Just rps -> let rs = fst <$> rps in m { logPend = Map.delete tid logp - , mainIdx = updateMainIdx (mainIdx m) rs - , unqIdx = updateUnqIdx (unqIdx m) rs - , sortIdx = updateSortIdx (sortIdx m) rs - , refIdx = updateRefIdx (refIdx m) rs + , mainIdx = updateMainIndex (mainIdx m) rs + , unqIdx = updateUniqueIndex (mainIdx m) (unqIdx m) rs + , sortIdx = updateSortIndex (mainIdx m) (sortIdx m) rs + , refIdx = updateFilterIndex (mainIdx m) (refIdx m) rs } -- | Sends a message to the 'Database.Muesli.GC.gcThread' requesting GC. diff --git a/src/Database/Muesli/Indexes.hs b/src/Database/Muesli/Indexes.hs --- a/src/Database/Muesli/Indexes.hs +++ b/src/Database/Muesli/Indexes.hs @@ -8,16 +8,18 @@ -- Stability : experimental -- Portability : portable -- --- Incremental database index update functions. +-- Incremental database index update functions. Except for 'updateMainIndex', +-- these functions first search for the previous version for each record and, +-- if found, remove the old references from the index, then add the new ones. -- -- Used during loading, query evaluation, and GC. ---------------------------------------------------------------------------- module Database.Muesli.Indexes - ( updateMainIdx - , updateRefIdx - , updateSortIdx - , updateUnqIdx + ( updateMainIndex + , updateFilterIndex + , updateSortIndex + , updateUniqueIndex ) where import qualified Data.IntMap.Strict as Map @@ -26,16 +28,24 @@ import Database.Muesli.State -- | Updates the 'MainIndex' (allocation table). -updateMainIdx :: MainIndex -> [LogRecord] -> MainIndex -updateMainIdx = foldl' f +updateMainIndex :: MainIndex -> [LogRecord] -> MainIndex +updateMainIndex = foldl' f where f idx r = let did = fromIntegral (recDocumentKey r) in let rs' = maybe [r] (r:) (Map.lookup did idx) in Map.insert did rs' idx +getPreviousVersion :: MainIndex -> LogRecord -> Maybe LogRecord +getPreviousVersion idx r = + let did = fromIntegral (recDocumentKey r) in + maybe Nothing (\ors -> if null ors then Nothing + else Just (head ors) { recDeleted = True }) + (Map.lookup did idx) + -- | Updates the 'UniqueIndex'. -updateUnqIdx :: UniqueIndex -> [LogRecord] -> UniqueIndex -updateUnqIdx = foldl' f - where f idx r = foldl' g idx (recUniques r) +updateUniqueIndex :: MainIndex -> UniqueIndex -> [LogRecord] -> UniqueIndex +updateUniqueIndex mIdx = foldl' h + where h idx r = f (maybe idx (f idx) (getPreviousVersion mIdx r)) r + f idx r = foldl' g idx (recUniques r) where did = fromIntegral (recDocumentKey r) del = recDeleted r @@ -50,9 +60,10 @@ else Map.insert rval did is -- | Updates the main 'SortIndex', and also the 'SortIndex'es inside a 'FilterIndex'. -updateSortIdx :: SortIndex -> [LogRecord] -> SortIndex -updateSortIdx = foldl' f - where f idx r = foldl' g idx (recSortables r) +updateSortIndex :: MainIndex -> SortIndex -> [LogRecord] -> SortIndex +updateSortIndex mIdx = foldl' h + where h idx r = f (maybe idx (f idx) (getPreviousVersion mIdx r)) r + f idx r = foldl' g idx (recSortables r) where did = fromIntegral (recDocumentKey r) del = recDeleted r @@ -74,16 +85,17 @@ -- | Updates the 'FilterIndex'. -- --- Calls 'updateSortIdx' for the internal sorted indexes. -updateRefIdx :: FilterIndex -> [LogRecord] -> FilterIndex -updateRefIdx = foldl' f - where f idx r = foldl' g idx (recReferences r) +-- Calls 'updateSortIndex' for the internal sorted indexes. +updateFilterIndex :: MainIndex -> FilterIndex -> [LogRecord] -> FilterIndex +updateFilterIndex mIdx = foldl' h + where h idx r = f (maybe idx (f idx) (getPreviousVersion mIdx r)) r + f idx r = foldl' g idx (recReferences r) where del = recDeleted r g idx' lnk = let rpid = fromIntegral (fst lnk) in let rval = fromIntegral (snd lnk) in - let sng = updateSortIdx Map.empty [r] in + let sng = updateSortIndex mIdx Map.empty [r] in case Map.lookup rpid idx' of Nothing -> if del then idx' else Map.insert rpid (Map.singleton rval sng) idx' @@ -92,4 +104,4 @@ Nothing -> if del then is else Map.insert rval sng is Just ss -> Map.insert rval ss' is - where ss' = updateSortIdx ss [r] + where ss' = updateSortIndex mIdx ss [r] diff --git a/src/Database/Muesli/Query.hs b/src/Database/Muesli/Query.hs --- a/src/Database/Muesli/Query.hs +++ b/src/Database/Muesli/Query.hs @@ -18,6 +18,11 @@ -- -- All queries in this module are run on indexes and perform an -- __O(log n)__ worst case operation. +-- +-- Functions whose name ends in \' do the same operation as their counterparts, +-- but return only the keys. As such, they work only on indexes and no I/O is +-- involved. They can be used to implement various kinds of joins not supported +-- by the primitive operations. ---------------------------------------------------------------------------- module Database.Muesli.Query @@ -34,11 +39,16 @@ , update , delete -- ** Range queries + , SortOrder (..) , range - , rangeK + , range' + , filterRange + , filterRange' , filter + , filter' -- ** Queries on unique fields - , lookupUnique + , unique + , unique' , updateUnique -- ** Other , size @@ -71,14 +81,14 @@ -- | Dereferences the given key. Returns 'Nothing' if the key is not found. lookup :: (Document a, LogState l, MonadIO m) => Reference a -> - Transaction l m (Maybe (Reference a, a)) + Transaction l m (Maybe a) lookup (Reference did) = Transaction $ do t <- S.get mbr <- withMasterLock (transHandle t) $ \m -> return $ findFirstDoc m t did mba <- maybe (return Nothing) (\(r, mbs) -> do a <- getDocument (transHandle t) r mbs - return $ Just (Reference did, a)) + return $ Just a) mbr S.put t { transReadList = did : transReadList t } return mba @@ -95,9 +105,9 @@ -- | Returns a 'Reference' to a document uniquely determined by the given -- 'Unique' key value, or 'Nothing' if the key is not found. -lookupUnique :: (ToKey (Unique b), MonadIO m) => +unique' :: (ToKey (Unique b), MonadIO m) => Property a -> Unique b -> Transaction l m (Maybe (Reference a)) -lookupUnique p ub = Transaction $ do +unique' p ub = Transaction $ do t <- S.get let u = toKey ub withMasterLock (transHandle t) $ \m -> return . liftM Reference $ @@ -107,15 +117,21 @@ IntMap.lookup (fromIntegral u)) where pp = fst $ unProperty p --- | Performs a 'lookupUnique' and then, depending whether the key exists or not, + +-- | Returns a document uniquely determined by the given +-- 'Unique' key value, or 'Nothing' if the key is not found. +unique :: (Document a, LogState l, ToKey (Unique b), MonadIO m) => + Property a -> Unique b -> Transaction l m (Maybe (Reference a, a)) +unique p ub = + unique' p ub >>= maybe (return Nothing) + (\k -> liftM (liftM (k,)) (lookup k)) + +-- | Performs a 'unique'' and then, depending whether the key exists or not, -- either 'insert's or 'update's the respective document. updateUnique :: (Document a, ToKey (Unique b), MonadIO m) => Property a -> Unique b -> a -> Transaction l m (Reference a) -updateUnique p u a = do - mdid <- lookupUnique p u - case mdid of - Nothing -> insert a - Just did -> update did a >> return did +updateUnique p u a = + unique' p u >>= maybe (insert a) (\did -> update did a >> return did) -- | Updates a document. -- @@ -176,20 +192,9 @@ } S.put t { transUpdateList = (r, B.empty) : transUpdateList t } -page_ :: (Document a, ToKey (Sortable b), LogState l, MonadIO m) => - (Int -> MasterState l -> [Int]) -> Maybe (Sortable b) -> - Transaction l m [(Reference a, a)] -page_ f mdid = Transaction $ do - t <- S.get - dds <- withMasterLock (transHandle t) $ \m -> do - let ds = f (ival mdid) m - let mbds = findFirstDoc m t . fromIntegral <$> ds - return $ concatMap (foldMap pure) mbds - dds' <- forM (reverse dds) $ \(d, mbs) -> do - a <- getDocument (transHandle t) d mbs - return (Reference $ recDocumentKey d, a) - S.put t { transReadList = (unReference . fst <$> dds') ++ transReadList t } - return dds' +-- | Sort order for range queries. +data SortOrder = SortAsc | SortDesc + deriving (Eq, Show) -- | Runs a range query on a 'Sortable' field. -- @@ -204,19 +209,32 @@ -- @ -- SELECT TOP page * FROM table -- WHERE (sortVal = NULL OR sortFld < sortVal) AND (sortKey = NULL OR ID < sortKey) --- ORDER BY field, ID DESC +-- ORDER BY sortFld, ID sortOrder -- @ range :: (Document a, ToKey (Sortable b), LogState l, MonadIO m) - => Maybe (Sortable b) -- ^ The @sortVal@ in the below SQL. - -> Maybe (Reference a) -- ^ The @sortKey@ below. + => Int -- ^ The @page@ below. -> Property a -- ^ The @sortFld@ and @table@ below. - -> Int -- ^ The @page@ below. + -> Maybe (Sortable b) -- ^ The @sortVal@ in the below SQL. + -> Maybe (Reference a) -- ^ The @sortKey@ below. + -> SortOrder -- ^ The @sortOrder@ below. -> Transaction l m [(Reference a, a)] -range mst msti p pg = page_ f mst - where f st m = fromMaybe [] $ do - ds <- IntMap.lookup (prop2Int p) (sortIdx m) - return $ getPage st (rval msti) pg ds +range pg p mst msti so = page_ (range_ pg p msti so) mst so +range_ :: Document a => Int -> Property a -> Maybe (Reference b) -> + SortOrder -> Int -> MasterState l -> [Int] +range_ pg p msti so st m = fromMaybe [] $ getPage st (rval msti) pg so <$> + IntMap.lookup (prop2Int p) (sortIdx m) + +-- | Like 'range', but returns only the keys. +range' :: (Document a, ToKey (Sortable b), MonadIO m) + => Int + -> Property a + -> Maybe (Sortable b) + -> Maybe (Reference a) + -> SortOrder + -> Transaction l m [Reference a] +range' pg p mst msti so = pageK_ (range_ pg p msti so) mst so + -- | Runs a filter-and-range query on a 'Reference' field, with results sorted -- on a different 'Sortable' field. -- @@ -232,54 +250,101 @@ -- SELECT TOP page * FROM table -- WHERE (filterFld = filterVal) AND -- (sortVal = NULL OR sortFld < sortVal) AND (sortKey = NULL OR ID < sortKey) --- ORDER BY field, ID DESC +-- ORDER BY sortFld, ID sortOrder -- @ -filter :: (Document a, ToKey (Sortable b), LogState l, MonadIO m) - => Maybe (Reference c) -- ^ The @filterVal@ in the below SQL. - -> Maybe (Sortable b) -- ^ The @sortVal@ below. - -> Maybe (Reference a) -- ^ The @sortKey@ below. - -> Property a -- ^ The @sortFld@ and @table@ below. - -> Property a -- ^ The @filterFld@ and @table@ below. - -> Int -- ^ The @page@ below. +filterRange :: (Document a, ToKey (Sortable b), LogState l, MonadIO m) + => Int -- ^ The @page@ below. + -> Property a -- ^ The @sortFld@ and @table@ below. + -> Maybe (Reference c) -- ^ The @filterVal@ in the below SQL. + -> Property a -- ^ The @filterFld@ and @table@ below. + -> Maybe (Sortable b) -- ^ The @sortVal@ below. + -> Maybe (Reference a) -- ^ The @sortKey@ below. + -> SortOrder -- ^ The @sortOrder@ below. + -> Transaction l m [(Reference a, a)] +filterRange pg fprop mdid sprop mst msti so = + page_ (filterRange_ pg fprop mdid sprop mst msti so) mst so + +filterRange_ :: (ToKey (Sortable b), Document a) => Int -> Property a + -> Maybe (Reference c) -> Property a -> Maybe (Sortable b) + -> Maybe (Reference a) -> SortOrder -> Int -> MasterState l -> [Int] +filterRange_ pg fprop mdid sprop mst msti so _ m = + fromMaybe [] . liftM (getPage (ival so mst) (rval msti) pg so) $ + IntMap.lookup (fromIntegral . fst . unProperty $ fprop) (refIdx m) >>= + IntMap.lookup (fromIntegral $ maybe 0 unReference mdid) >>= + IntMap.lookup (prop2Int sprop) + +-- | Like 'filterRange', but returns only the keys. +filterRange' :: (Document a, ToKey (Sortable b), LogState l, MonadIO m) + => Int + -> Property a + -> Maybe (Reference c) + -> Property a + -> Maybe (Sortable b) + -> Maybe (Reference a) + -> SortOrder + -> Transaction l m [Reference a] +filterRange' pg fprop mdid sprop mst msti so = + pageK_ (filterRange_ pg fprop mdid sprop mst msti so) mst so + +-- | Runs a filter query on a 'Reference' field, with results sorted +-- on a different 'Sortable' field. +-- +-- Like 'filterRange', but returns all documents, not just a range. +filter :: (Document a, LogState l, MonadIO m) + => Property a + -> Maybe (Reference b) + -> Property a + -> SortOrder -> Transaction l m [(Reference a, a)] -filter mdid mst msti fprop sprop pg = page_ f mst - where f _ m = fromMaybe [] . liftM (getPage (ival mst) (rval msti) pg) $ - IntMap.lookup (fromIntegral . fst . unProperty $ fprop) (refIdx m) >>= - IntMap.lookup (fromIntegral $ maybe 0 unReference mdid) >>= - IntMap.lookup (prop2Int sprop) +filter fprop mdid sprop = filterRange maxBound fprop mdid sprop + (Nothing :: Maybe (Sortable Int)) Nothing +-- | Like 'filter', but returns only the keyes. +filter' :: (Document a, LogState l, MonadIO m) + => Property a + -> Maybe (Reference b) + -> Property a + -> SortOrder + -> Transaction l m [Reference a] +filter' fprop mdid sprop = filterRange' maxBound fprop mdid sprop + (Nothing :: Maybe (Sortable Int)) Nothing + +page_ :: (Document a, ToKey (Sortable b), LogState l, MonadIO m) => + (Int -> MasterState l -> [Int]) -> Maybe (Sortable b) -> SortOrder -> + Transaction l m [(Reference a, a)] +page_ f mst so = Transaction $ do + t <- S.get + dds <- withMasterLock (transHandle t) $ \m -> do + let ds = f (ival so mst) m + let mbds = findFirstDoc m t . fromIntegral <$> ds + return $ concatMap (foldMap pure) mbds + dds' <- forM (reverse dds) $ \(d, mbs) -> do + a <- getDocument (transHandle t) d mbs + return (Reference $ recDocumentKey d, a) + S.put t { transReadList = (unReference . fst <$> dds') ++ transReadList t } + return dds' + pageK_ :: (MonadIO m, ToKey (Sortable b)) => (Int -> MasterState l -> [Int]) -> - Maybe (Sortable b) -> Transaction l m [Reference a] -pageK_ f mdid = Transaction $ do + Maybe (Sortable b) -> SortOrder -> Transaction l m [Reference a] +pageK_ f mst so = Transaction $ do t <- S.get dds <- withMasterLock (transHandle t) $ \m -> return $ concatMap (map (recDocumentKey . fst) . foldMap pure . findFirstDoc m t . - fromIntegral) $ f (ival mdid) m + fromIntegral) $ f (ival so mst) m S.put t { transReadList = dds ++ transReadList t } return (Reference <$> dds) --- | Like 'range', but only returns the keys and does not touch the data file. --- This may be used for implementing a faster deleteRange query, for example. -rangeK :: (Document a, ToKey (Sortable b), MonadIO m) - => Maybe (Sortable b) - -> Maybe (Reference a) - -> Property a - -> Int - -> Transaction l m [Reference a] -rangeK mst msti p pg = pageK_ f mst - where f st m = fromMaybe [] $ getPage st (rval msti) pg <$> - IntMap.lookup (prop2Int p) (sortIdx m) - -getPage :: Int -> Int -> Int -> IntMap IntSet -> [Int] -getPage sta sti pg idx = go sta pg [] +getPage :: Int -> Int -> Int -> SortOrder -> IntMap IntSet -> [Int] +getPage sta sti pg so idx = go sta pg [] where go st p acc = if p == 0 then acc - else case IntMap.lookupLT st idx of + else case fn st idx of Nothing -> acc Just (n, is) -> let (p', ids) = getPage2 sti p is in if p' == 0 then ids ++ acc else go n p' $ ids ++ acc + fn = if so == SortDesc then IntMap.lookupLT else IntMap.lookupGT getPage2 :: Int -> Int -> IntSet -> (Int, [Int]) getPage2 sta pg idx = go sta pg [] @@ -300,8 +365,8 @@ rval :: Maybe (Reference a) -> Int rval = fromIntegral . unReference . fromMaybe maxBound -ival :: ToKey (Sortable a) => Maybe (Sortable a) -> Int -ival = fromIntegral . maybe maxBound toKey +ival :: ToKey (Sortable a) => SortOrder -> Maybe (Sortable a) -> Int +ival so = fromIntegral . maybe (if so == SortDesc then maxBound else 0) toKey prop2Int :: Document a => Property a -> Int prop2Int = fromIntegral . fst . unProperty diff --git a/src/Database/Muesli/Types.hs b/src/Database/Muesli/Types.hs --- a/src/Database/Muesli/Types.hs +++ b/src/Database/Muesli/Types.hs @@ -230,7 +230,7 @@ ss -> ss -- | 'Unique' fields act as primary keys, and can be queried with --- 'Database.Muesli.Query.lookupUnique' and 'Database.Muesli.Query.updateUnique'. +-- 'Database.Muesli.Query.unique' and 'Database.Muesli.Query.updateUnique'. -- The 'Hashable' instance is used to generate the key. -- -- For fields that need to be both unique and sortable, use