packages feed

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