Add databaseRevision API

Author: blahgeek

notmuch.cabal

@@ -102,6 +102,15 @@ executable hs-notmuch-files
   build-depends:
     , notmuch
 
+executable hs-notmuch-dbinfo
+  import: common
+  if !flag(demos)
+    buildable: False
+  hs-source-dirs: tools
+  main-is: DbInfo.hs
+  build-depends:
+    , notmuch
+
 executable hs-notmuch-tag-message
   import: common
   if !flag(demos)

src/Notmuch.hs

@@ -72,6 +72,7 @@ module Notmuch
   , databaseOpenReadOnly
   , databasePath
   , databaseVersion
+  , databaseRevision
   , Database
   -- ** Database modes
   , Mode
@@ -146,6 +147,7 @@ import Control.Exception (bracket)
 import Control.Monad.Except (MonadError(..))
 import Control.Monad.IO.Class (MonadIO(..))
 import Data.Foldable (traverse_)
+import Foreign.C.Types (CULong)
 import GHC.Generics (Generic)
 
 import Control.DeepSeq (NFData)
@@ -240,6 +242,17 @@ databaseOpenReadOnly = database_open
 databaseVersion :: MonadIO m => Database a -> m Int
 databaseVersion = liftIO . database_get_version
 
+-- | Get the revision and UUID of the database.
+--
+-- The revision number increases monotonically with each commit to
+-- the database (although rollover is possible).  The "UUID" is an
+-- __opaque__ string that persists until e.g. database compaction.
+-- Revision numbers are only comparable where the UUID strings are
+-- equal.
+--
+databaseRevision :: MonadIO m => Database a -> m (CULong, String)
+databaseRevision = liftIO . database_get_revision
+
 -- | Look for a particular message in the database.
 findMessage
   :: (AsNotmuchError e, MonadError e m, MonadIO m)

src/Notmuch/Binding.chs

@@ -251,6 +251,14 @@ database_get_version :: Database a -> IO Int
 database_get_version db =
   fromIntegral <$> withDatabase db {#call unsafe database_get_version #}
 
+database_get_revision :: Database a -> IO (CULong, String)
+database_get_revision db =
+  withDatabase db $ \db' ->
+    alloca $ \uuidPtr -> do
+      rev <- {#call unsafe database_get_revision #} db' uuidPtr
+      uuid <- peekCString =<< peek uuidPtr
+      pure (rev, uuid)
+
 -- | Index a file with the default indexing options.
 -- (This binding does not yet provide a way to change
 -- the indexing options.)  Returns the indexed message.

tools/DbInfo.hs

@@ -0,0 +1,47 @@
+-- This file is part of hs-notmuch - Haskell Notmuch binding
+-- Copyright (C) 2022  Yikai Zhao
+--
+-- hs-notmuch is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation, either version 3 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+{-
+
+Print version and revision info for a database.
+
+-}
+
+{-# LANGUAGE LambdaCase #-}
+
+import Control.Monad.Except (runExceptT)
+import System.Environment (getArgs)
+import System.Exit (die)
+
+import Notmuch
+
+
+main :: IO ()
+main = getArgs >>= \case
+  [dbDir] -> go dbDir
+  _ -> putStrLn "usage: hs-notmuch-dbinfo DB-DIR"
+
+go :: String -> IO ()
+go dbDir = do
+  (version, (revision, uuid)) <- runExceptT (
+    do
+      db <- databaseOpenReadOnly dbDir
+      (,) <$> databaseVersion db <*> databaseRevision db
+    ) >>= either (die . (show :: Status -> String)) pure
+  putStr "Path: "     *> putStrLn dbDir
+  putStr "Version: "  *> print version
+  putStr "Revision: " *> print revision
+  putStr "UUID: "     *> putStrLn uuid