muesli 0.1.0.1 → 0.1.1.0
raw patch · 10 files changed
+225/−121 lines, 10 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Database.Muesli.Indexes: updateMainIdx :: MainIndex -> [LogRecord] -> MainIndex
- Database.Muesli.Indexes: updateRefIdx :: FilterIndex -> [LogRecord] -> FilterIndex
- Database.Muesli.Indexes: updateSortIdx :: SortIndex -> [LogRecord] -> SortIndex
- Database.Muesli.Indexes: updateUnqIdx :: UniqueIndex -> [LogRecord] -> UniqueIndex
- Database.Muesli.Query: lookupUnique :: (ToKey (Unique b), MonadIO m) => Property a -> Unique b -> Transaction l m (Maybe (Reference a))
- Database.Muesli.Query: rangeK :: (Document a, ToKey (Sortable b), MonadIO m) => Maybe (Sortable b) -> Maybe (Reference a) -> Property a -> Int -> Transaction l m [Reference a]
+ Database.Muesli.Indexes: updateFilterIndex :: MainIndex -> FilterIndex -> [LogRecord] -> FilterIndex
+ Database.Muesli.Indexes: updateMainIndex :: MainIndex -> [LogRecord] -> MainIndex
+ Database.Muesli.Indexes: updateSortIndex :: MainIndex -> SortIndex -> [LogRecord] -> SortIndex
+ Database.Muesli.Indexes: updateUniqueIndex :: MainIndex -> UniqueIndex -> [LogRecord] -> UniqueIndex
+ Database.Muesli.Query: [SortAsc] :: SortOrder
+ Database.Muesli.Query: [SortDesc] :: SortOrder
+ Database.Muesli.Query: data SortOrder
+ Database.Muesli.Query: filter' :: (Document a, LogState l, MonadIO m) => Property a -> Maybe (Reference b) -> Property a -> SortOrder -> Transaction l m [Reference a]
+ Database.Muesli.Query: 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, a)]
+ Database.Muesli.Query: 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]
+ Database.Muesli.Query: instance Eq SortOrder
+ Database.Muesli.Query: instance Show SortOrder
+ Database.Muesli.Query: range' :: (Document a, ToKey (Sortable b), MonadIO m) => Int -> Property a -> Maybe (Sortable b) -> Maybe (Reference a) -> SortOrder -> Transaction l m [Reference a]
+ Database.Muesli.Query: unique :: (Document a, LogState l, ToKey (Unique b), MonadIO m) => Property a -> Unique b -> Transaction l m (Maybe (Reference a, a))
+ Database.Muesli.Query: unique' :: (ToKey (Unique b), MonadIO m) => Property a -> Unique b -> Transaction l m (Maybe (Reference a))
- Database.Muesli.Query: filter :: (Document a, ToKey (Sortable b), LogState l, MonadIO m) => Maybe (Reference c) -> Maybe (Sortable b) -> Maybe (Reference a) -> Property a -> Property a -> Int -> Transaction l m [(Reference a, a)]
+ Database.Muesli.Query: filter :: (Document a, LogState l, MonadIO m) => Property a -> Maybe (Reference b) -> Property a -> SortOrder -> Transaction l m [(Reference a, a)]
- Database.Muesli.Query: lookup :: (Document a, LogState l, MonadIO m) => Reference a -> Transaction l m (Maybe (Reference a, a))
+ Database.Muesli.Query: lookup :: (Document a, LogState l, MonadIO m) => Reference a -> Transaction l m (Maybe a)
- Database.Muesli.Query: range :: (Document a, ToKey (Sortable b), LogState l, MonadIO m) => Maybe (Sortable b) -> Maybe (Reference a) -> Property a -> Int -> Transaction l m [(Reference a, a)]
+ Database.Muesli.Query: range :: (Document a, ToKey (Sortable b), LogState l, MonadIO m) => Int -> Property a -> Maybe (Sortable b) -> Maybe (Reference a) -> SortOrder -> Transaction l m [(Reference a, a)]
Files
- CHANGELOG.md +18/−0
- README.md +20/−14
- muesli.cabal +2/−2
- src/Database/Muesli/Backend/File.hs +3/−0
- src/Database/Muesli/Commit.hs +6/−6
- src/Database/Muesli/GC.hs +8/−8
- src/Database/Muesli/Handle.hs +4/−4
- src/Database/Muesli/Indexes.hs +31/−19
- src/Database/Muesli/Query.hs +132/−67
- src/Database/Muesli/Types.hs +1/−1
CHANGELOG.md view
@@ -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
README.md view
@@ -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,
muesli.cabal view
@@ -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 <https://en.wikipedia.org/wiki/Multiversion_concurrency_control MVCC> <https://en.wikipedia.org/wiki/Document-oriented_database document-oriented database> featuring ACID transactions, automatic index management and minimal boilerplate.
src/Database/Muesli/Backend/File.hs view
@@ -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
src/Database/Muesli/Commit.hs view
@@ -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))
src/Database/Muesli/GC.hs view
@@ -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
src/Database/Muesli/Handle.hs view
@@ -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.
src/Database/Muesli/Indexes.hs view
@@ -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]
src/Database/Muesli/Query.hs view
@@ -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
src/Database/Muesli/Types.hs view
@@ -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