[lmdb facebookincubator#1] Factor out a generic DB layer

Author: simonmar

glean.cabal.in

@@ -387,6 +387,18 @@ library rts
     extra-libraries: atomic
     pkgconfig-depends: libunwind, libglog, icu-uc, gflags, libxxhash
 
+library storage
+    import: fb-haskell, fb-cpp, deps, folly
+    visibility: private
+    CXX_LIB_glean_cpp_storage
+    include-dirs: .
+    install-includes:
+        glean/storage/ffi.h
+        glean/storage/db.h
+        glean/storage/stats.h
+    build-depends:
+        glean:rts,
+
 library rocksdb
     import: fb-haskell, fb-cpp, deps, folly
     visibility: private
@@ -400,18 +412,7 @@ library rocksdb
         glean/rocksdb/util.h
     pkgconfig-depends: rocksdb, fmt
     build-depends:
-        glean:rocksdb-stats,
-        glean:rts,
-
--- This needs to be separate from rocksdb because it can't be compiled with -fno-rtti
-library rocksdb-stats
-    import: fb-haskell, fb-cpp, deps, folly
-    visibility: private
-    CXX_LIB_glean_cpp_rocksdb_stats
-    include-dirs: .
-    install-includes:
-        glean/rocksdb/stats.h
-    build-depends:
+        glean:storage,
         glean:rts,
 
 library util
@@ -596,6 +597,7 @@ library db
         Glean.Database.Schema.Types
         Glean.Database.Storage
         Glean.Database.Storage.Memory
+        Glean.Database.Storage.DB
         Glean.Database.Storage.RocksDB
         Glean.Database.Trace
         Glean.Database.Types

glean/db/Glean/Database/Storage.hs

@@ -10,6 +10,8 @@ module Glean.Database.Storage
   ( Mode(..)
   , CreateSchema(..)
   , Storage(..)
+  , Database
+  , DatabaseOps(..)
   , DBVersion(..)
   , AxiomOwnership
   , WriteLock(..)
@@ -26,11 +28,12 @@ import Glean.Database.Backup.Backend (Data)
 import Glean.Internal.Types (StoredSchema)
 import Glean.RTS.Foreign.FactSet (FactSet)
 import Glean.RTS.Foreign.Inventory (Inventory)
-import Glean.RTS.Foreign.Lookup (CanLookup, Lookup)
-import Glean.RTS.Foreign.Ownership
+import Glean.RTS.Foreign.Lookup (CanLookup(..), Lookup)
+import Glean.RTS.Foreign.Ownership hiding (computeDerivedOwnership)
 import Glean.RTS.Types (Fid, Pid)
 import Glean.ServerConfig.Types (DBVersion(..))
 import Glean.Types (PredicateStats, Repo, SchemaId)
+import Glean.Util.Some
 
 -- | List of binary representation versions we can read
 readableVersions :: [DBVersion]
@@ -76,20 +79,16 @@ type AxiomOwnership = HashMap ByteString (VS.Vector Fid)
 -- | Token representing the write lock
 data WriteLock w = WriteLock w
 
--- | An abstract storage for fact database
-class CanLookup (Database s) => Storage s where
-  -- | A fact database
-  data Database s
+data family Database s
 
+-- | An abstract storage for fact database
+class DatabaseOps (Database s) => Storage s where
   -- | A short, user-readable description of the storage
   describe :: s -> String
 
   -- | Open a database
   open :: s -> Repo -> Mode -> DBVersion -> IO (Database s)
 
-  -- | Close a database
-  close :: Database s -> IO ()
-
   -- | Delete a database if it exists
   delete :: s -> Repo -> IO ()
 
@@ -98,57 +97,89 @@ class CanLookup (Database s) => Storage s where
   -- directory where the database would be stored.
   safeRemoveForcibly :: s -> Repo -> IO ()
 
+  -- | Determine the total capacity of the storage medium (e.g., disk size).
+  getTotalCapacity :: s -> IO (Maybe Int)
+
+  -- | Determine the used capacity of the storage medium (e.g., how much of the
+  -- disk is in use).
+  getUsedCapacity :: s -> IO (Maybe Int)
+
+  -- | Determine the free capacity of the storage medium (e.g., how much of the
+  -- disk is free).
+  getFreeCapacity :: s -> IO Int
+
+  -- | Execute the action, passing to it a path to a scratch directory which can
+  -- be used, e.g., for downloading databases. This directory is not guaranteed
+  -- to persist beyond the call and is not guaranteed to be empty.
+  withScratchRoot :: s -> (FilePath -> IO a) -> IO a
+
+  -- | Restore a database. The scratch directory which can be used for
+  -- storing intermediate files is guaranteed to be empty and will be
+  -- deleted after the operation completes. The implementation may
+  -- delete the serialized database file after it has been consumed,
+  -- to reduce the number of copies of the DB on disk during a restore.
+  restore
+    :: s   -- ^ storage
+    -> Repo  -- ^ repo
+    -> FilePath  -- ^ scratch directory
+    -> FilePath  -- ^ file containing the serialiased database (produced by 'backup')
+    -> IO ()
+
+class CanLookup db => DatabaseOps db where
+  -- | Close a database
+  close :: db -> IO ()
+
   -- | Obtain the 'PredicateStats' for each predicate
-  predicateStats :: Database s -> IO [(Pid, PredicateStats)]
+  predicateStats :: db -> IO [(Pid, PredicateStats)]
 
   -- | Store an arbitrary binary key/value pair in the database. This data is
   -- completely separate from the facts.
   --
   -- NOTE: It is expected that 'store' and 'retrieve' are used sparingly and
   -- there are no performance guarantees. A typical use case for this is
   -- storing the serialised schema in the database.
-  store :: Database s -> ByteString -> ByteString -> IO ()
+  store :: db -> ByteString -> ByteString -> IO ()
 
   -- | Retrieve the value of a key previously stored with 'store'.
-  retrieve :: Database s -> ByteString -> IO (Maybe ByteString)
+  retrieve :: db -> ByteString -> IO (Maybe ByteString)
 
   -- | Commit a set of facts to the database. The facts must have the right ids,
   -- they are NOT renamed.
-  commit :: Database s -> FactSet -> IO ()
+  commit :: db -> FactSet -> IO ()
 
   -- | Add ownership data about a set of (committed) facts.
-  addOwnership :: Database s -> WriteLock w -> AxiomOwnership -> IO ()
+  addOwnership :: db -> WriteLock w -> AxiomOwnership -> IO ()
 
   -- | Optimise a database for reading. This is typically done before backup.
-  optimize :: Database s -> Bool {- compact -} -> IO ()
+  optimize :: db -> Bool {- compact -} -> IO ()
 
   computeOwnership
-    :: Database s
+    :: db
     -> Maybe Lookup
        -- ^ Base DB lookup if this is a stacked DB, because ownership may
        -- need to propagate ownership through facts in the base DB.
     -> Inventory
     -> IO ComputedOwnership
 
-  storeOwnership :: Database s -> WriteLock w -> ComputedOwnership -> IO ()
+  storeOwnership :: db -> WriteLock w -> ComputedOwnership -> IO ()
 
   -- | Fetch the 'Ownership' interface for this DB. This is used to
   -- make a 'Slice' (a view of a subset of the facts in the DB).
   --
   -- Can return 'Nothing' if this database backend doesn't support
   -- ownership. (TODO: support ownership in the memory backend and
   -- remove this 'Maybe').
-  getOwnership :: Database s -> IO (Maybe Ownership)
+  getOwnership :: db -> IO (Maybe Ownership)
 
-  getUnitId :: Database s -> ByteString -> IO (Maybe UnitId)
-  getUnit :: Database s -> UnitId -> IO (Maybe ByteString)
+  getUnitId :: db -> ByteString -> IO (Maybe UnitId)
+  getUnit :: db -> UnitId -> IO (Maybe ByteString)
 
   -- | Called once per batch.
-  addDefineOwnership :: Database s -> WriteLock w -> DefineOwnership -> IO ()
+  addDefineOwnership :: db -> WriteLock w -> DefineOwnership -> IO ()
 
   -- | Called once per derived predicate at the end of its derivation.
   computeDerivedOwnership
-    :: Database s
+    :: db
     -> WriteLock w
     -> Ownership
     -> Maybe Lookup
@@ -162,44 +193,39 @@ class CanLookup (Database s) => Storage s where
   -- faster getOwner() operations. Takes time to cache the data and
   -- memory to retain the cache. Only useful if this DB will be used
   -- in an incremental stack.
-  cacheOwnership :: Database s -> IO ()
-
-  prepareFactOwnerCache :: Database s -> IO ()
-
-  -- | Determine the total capacity of the storage medium (e.g., disk size).
-  getTotalCapacity :: s -> IO (Maybe Int)
-
-  -- | Determine the used capacity of the storage medium (e.g., how much of the
-  -- disk is in use).
-  getUsedCapacity :: s -> IO (Maybe Int)
-
-  -- | Determine the free capacity of the storage medium (e.g., how much of the
-  -- disk is free).
-  getFreeCapacity :: s -> IO Int
+  cacheOwnership :: db -> IO ()
 
-  -- | Execute the action, passing to it a path to a scratch directory which can
-  -- be used, e.g., for downloading databases. This directory is not guaranteed
-  -- to persist beyond the call and is not guaranteed to be empty.
-  withScratchRoot :: s -> (FilePath -> IO a) -> IO a
+  prepareFactOwnerCache :: db -> IO ()
 
   -- | Backup a database. The scratch directory which can be used for storing
   -- intermediate files is guaranteed to be empty and will be deleted after
   -- the operation completes.
   backup
-    :: Database s  -- ^ database
+    :: db  -- ^ database
     -> FilePath  -- ^ scratch directory
     -> (FilePath -> Data -> IO a)
           -- ^ function which expects the serialised database
     -> IO a
 
-  -- | Restore a database. The scratch directory which can be used for
-  -- storing intermediate files is guaranteed to be empty and will be
-  -- deleted after the operation completes. The implementation may
-  -- delete the serialized database file after it has been consumed,
-  -- to reduce the number of copies of the DB on disk during a restore.
-  restore
-    :: s   -- ^ storage
-    -> Repo  -- ^ repo
-    -> FilePath  -- ^ scratch directory
-    -> FilePath  -- ^ file containing the serialiased database (produced by 'backup')
-    -> IO ()
+instance CanLookup (Some DatabaseOps) where
+  withLookup (Some db) = withLookup db
+  lookupName (Some db) = lookupName db
+
+instance DatabaseOps (Some DatabaseOps) where
+  close (Some db) = close db
+  predicateStats (Some db) = predicateStats db
+  store (Some db) = store db
+  retrieve (Some db) = retrieve db
+  commit (Some db) = commit db
+  addOwnership (Some db) = addOwnership db
+  optimize (Some db) = optimize db
+  computeOwnership (Some db) = computeOwnership db
+  storeOwnership (Some db) = storeOwnership db
+  getOwnership (Some db) = getOwnership db
+  getUnitId (Some db) = getUnitId db
+  getUnit (Some db) = getUnit db
+  addDefineOwnership (Some db) = addDefineOwnership db
+  computeDerivedOwnership (Some db) = computeDerivedOwnership db
+  cacheOwnership (Some db) = cacheOwnership db
+  prepareFactOwnerCache (Some db) = prepareFactOwnerCache db
+  backup (Some db) = backup db