#include "estraier.h"

-- |An interface to functions to manipulate databases.

module Text.HyperEstraier.Database
    ( -- * Types
      Database
    , EstError(..)

    , AttrIndexType(..)
    , OptimizeOption(..)
    , RemoveOption(..)
    , PutOption(..)
    , GetOption(..)

    , OpenMode(..)
    , ReaderOption(..)
    , WriterOption(..)
    , LockingMode(..)
    , CreateOption(..)
    , AnalysisOption(..)
    , IndexTuning(..)
    , ScoreOption(..)

      -- * Opening and closing databases
    , withDatabase
    , openDatabase
    , closeDatabase

      -- * Manipulating database
    , addAttrIndex
    , flushDatabase
    , syncDatabase
    , optimizeDatabase
    , mergeDatabase
    , setCacheSize

      -- * Getting documents in and out
    , putDocument
    , removeDocument
    , updateDocAttrs
    , getDocument
    , getDocAttr
    , getDocURI
    , getDocIdByURI

      -- * Statistics of databases
    , getDatabaseName
    , getNumOfDocs
    , getNumOfWords
    , getDatabaseSize
    , hasFatalError

      -- * Searching for documents
    , searchDatabase
    , searchDatabase'
    , metaSearch
    , metaSearch'
    , scanDocument
    )
    where

import           Codec.Binary.UTF8.String
import           Control.Exception
import           Control.Monad
import           Data.Bits
import qualified Data.ByteString as Strict (ByteString)
import qualified Data.ByteString.Char8 as C8 hiding (ByteString)
import           Data.IORef
import           Data.Maybe
import           Data.Typeable
import qualified Database.QDBM.Cabin.Map as CM
import           Foreign.C.String
import           Foreign.C.Types
import           Foreign.Marshal.Alloc
import           Foreign.Marshal.Array
import           Foreign.Ptr
import           Foreign.Storable
import           Network.URI
import           Text.HyperEstraier.Condition
import           Text.HyperEstraier.Document
import           Text.HyperEstraier.Utils

-- |'EstError' represents an error occured on various operations.
data EstError
    = InvalidArgument -- ^ An argument passed to the function was invalid.
    | AccessForbidden -- ^ The operation is forbidden.
    | LockFailure     -- ^ Failed to lock the database.
    | DatabaseProblem -- ^ The database has a problem.
    | IOProblem       -- ^ An I\/O operation failed.
    | NoSuchItem      -- ^ An object you specified does not exist.
    | MiscError       -- ^ Errors for other reasons.
    deriving (Eq, Show, Typeable)

instance Exception EstError


unmarshalError :: Int -> EstError
unmarshalError (#const ESTEINVAL ) = InvalidArgument
unmarshalError (#const ESTEACCES ) = AccessForbidden
unmarshalError (#const ESTELOCK  ) = LockFailure
unmarshalError (#const ESTEDB    ) = DatabaseProblem
unmarshalError (#const ESTEIO    ) = IOProblem
unmarshalError (#const ESTENOITEM) = NoSuchItem
unmarshalError (#const ESTEMISC  ) = MiscError
unmarshalError _                   = undefined

-- |'OpenMode' represents how to open a database.
data OpenMode
    = Reader [ReaderOption] -- ^ Open the database with read-only
                            --   mode. You can specify 'ReaderOption'
                            --   to modify the behavior of the
                            --   database.
    | Writer [WriterOption] -- ^ Open the database with writable
                            --   mode. You can specify 'WriterOption'
                            --   to modify the behavior of the
                            --   database.
    deriving (Eq, Show)

-- |'ReaderOption' is an option for the 'Reader' constructor.
data ReaderOption
    = ReadLock LockingMode -- ^ Specify how to lock the database.
    deriving (Eq, Show)

-- |'WriterOption' is an option for the 'Writer' constructor.
data WriterOption
    = Create [CreateOption]   -- ^ Create a database if an old one
                              --   doesn't exist. You can specify
                              --   'CreateOption' to modify the
                              --   behavior of the database.
    | Truncate [CreateOption] -- ^ Always create a new database even
                              --   if an old one already exists. You
                              --   can specify 'CreateOption' to
                              --   modify the behavior of the
                              --   database.
    | WriteLock LockingMode   -- ^ Specify how to lock the database.
    deriving (Eq, Show)

-- |'LockingMode' represents how to lock the database.
data LockingMode
    = NoLock          -- ^ Do no exclusive access control at all. This
                      --   option is very unsafe.
    | NonblockingLock -- ^ Do non-blocking lock. (The author of this
                      --   module doesn't know what happens if this
                      --   option is in effect. See the manual and the
                      --   source code of HyperEstraier and QDBM.)
    deriving (Eq, Show)

-- |'CreateOption' is an option for the 'Create' constructor.
data CreateOption
    = Analysis AnalysisOption -- ^ Specify the word analysis method.
    | Index IndexTuning       -- ^ Specify the prospective size of the
                              --   database.
    | Score [ScoreOption]     -- ^ Specify how to handle scores of the
                              --   documents.
    deriving (Eq, Show)

-- |'AnalysisOption' is an option for the 'Analysis' constructor.
data AnalysisOption
    = PerfectNGram -- ^ Use the perfect N-gram analyzer.
    | CharCategory -- ^ Use the character category analyzer.
    deriving (Eq, Show)

-- |'IndexTuning' is an option for the 'Index' constructor.
data IndexTuning
    = Small -- ^ Predict the database will have less than 50,000
            --   documents.
    | Large -- ^ Predict the database will have less than 300,000
            --   documents.
    | Huge  -- ^ Predict the database will have less than 1,000,000
            --   documents.
    | Huge2 -- ^ Predict the database will have less than 5,000,000
            --   documents.
    | Huge3 -- ^ Predict the database will have more than 10,000,000
            --   documents.
    deriving (Eq, Show)

-- |'ScoreOption' is an option for the 'Score' constructor.
data ScoreOption
    = Nullified      -- ^ Nullify anything about the score of
                     --   documents.
    | StoredAsInt    -- ^ Store the scores for documents into the
                     --   database as 32-bit integer.
    | OnlyToBeStored -- ^ Store the scores for documents into the
                     --   database but don't use them during the
                     --   search operation.
    deriving (Eq, Show)


marshalOpenMode :: OpenMode -> Int
marshalOpenMode (Reader opts) = (#const ESTDBREADER) .|. marshalOpts marshalReaderOption opts
marshalOpenMode (Writer opts) = (#const ESTDBWRITER) .|. marshalOpts marshalWriterOption opts

marshalReaderOption :: ReaderOption -> Int
marshalReaderOption (ReadLock mode) = marshalLockingMode mode

marshalWriterOption :: WriterOption -> Int
marshalWriterOption (Create    opts) = (#const ESTDBCREAT) .|. marshalOpts marshalCreateOption opts
marshalWriterOption (Truncate  opts) = (#const ESTDBTRUNC) .|. marshalOpts marshalCreateOption opts
marshalWriterOption (WriteLock mode) = marshalLockingMode mode

marshalLockingMode :: LockingMode -> Int
marshalLockingMode NoLock          = #const ESTDBNOLCK
marshalLockingMode NonblockingLock = #const ESTDBLCKNB

marshalCreateOption :: CreateOption -> Int
marshalCreateOption (Analysis opt   ) = marshalAnalysisOption opt
marshalCreateOption (Index    tuning) = marshalIndexTuning tuning
marshalCreateOption (Score    opts  ) = marshalOpts marshalScoreOption opts

marshalAnalysisOption :: AnalysisOption -> Int
marshalAnalysisOption PerfectNGram = #const ESTDBPERFNG
marshalAnalysisOption CharCategory = #const ESTDBCHRCAT

marshalIndexTuning :: IndexTuning -> Int
marshalIndexTuning Small = #const ESTDBSMALL
marshalIndexTuning Large = #const ESTDBLARGE
marshalIndexTuning Huge  = #const ESTDBHUGE
marshalIndexTuning Huge2 = #const ESTDBHUGE2
marshalIndexTuning Huge3 = #const ESTDBHUGE3

marshalScoreOption :: ScoreOption -> Int
marshalScoreOption Nullified      = #const ESTDBSCVOID
marshalScoreOption StoredAsInt    = #const ESTDBSCINT
marshalScoreOption OnlyToBeStored = #const ESTDBSCASIS

-- |'AttrIndexType' represents an index type for an attribute.
data AttrIndexType
    = SeqIndex -- ^ Map from a document ID to an attribute value. This
               --   type of index increses the efficiency of, say,
               --   'getDocAttr'.
    | StrIndex -- ^ Map from an attribute value to a document ID. This
               --   increases the search speed when you search for
               --   documents by an attribute value.
    | NumIndex -- ^ This is similar to 'StrIndex' but for attributes
               --   whose value is a number.
    deriving (Eq, Show)


marshalAttrIndexType :: AttrIndexType -> Int
marshalAttrIndexType SeqIndex = #const ESTIDXATTRSEQ
marshalAttrIndexType StrIndex = #const ESTIDXATTRSTR
marshalAttrIndexType NumIndex = #const ESTIDXATTRNUM

-- |'OptimizeOption' is an option for the 'optimizeDatabase' action.
data OptimizeOption
    = NoPurge      -- ^ Omit the process which purges garbages of
                   --   removed documents.
    | NoDBOptimize -- ^ Omit the process which optimizes the database
                   --   file.
    deriving (Eq, Show)


marshalOptimizeOption :: OptimizeOption -> Int
marshalOptimizeOption NoPurge      = #const ESTOPTNOPURGE
marshalOptimizeOption NoDBOptimize = #const ESTOPTNODBOPT

-- |'RemoveOption' is an option for the 'mergeDatabase' action and the
-- 'removeDocument' action.
data RemoveOption
    = CleaningRemove -- ^ Clean up the region in the database where
                     --   the removed documents were placed.
    deriving (Eq, Show)


marshalRemoveOption :: RemoveOption -> Int
marshalRemoveOption CleaningRemove = #const ESTODCLEAN

-- |'PutOption' is an option for the 'putDocument' action.
data PutOption
    = CleaningPut      -- ^ If the new document overwrites an old one,
                       --   clean up the region in the database where
                       --   the old document were placed.
    | WeightStatically -- ^ Statically apply the \"\@weight\"
                       --   attribute of the document.
    deriving (Eq, Show)


marshalPutOption :: PutOption -> Int
marshalPutOption CleaningPut      = #const ESTPDCLEAN
marshalPutOption WeightStatically = #const ESTPDWEIGHT

-- |'GetOption' is an option for the 'getDocument' action.
data GetOption
    = NoAttributes -- ^ Don't retrieve the attributes of the document.
    | NoText       -- ^ Don't retrieve the body of the document.
    | NoKeywords   -- ^ Don't retrieve the keywords of the document.
    deriving (Eq, Show)

marshalGetOption :: GetOption -> Int
marshalGetOption NoAttributes = #const ESTGDNOATTR
marshalGetOption NoText       = #const ESTGDNOTEXT
marshalGetOption NoKeywords   = #const ESTGDNOKWD

-- |@'Database'@ is an opaque object representing a HyperEstraier
-- database.
newtype Database = Database (IORef (Ptr ESTMTDB))
data ESTMTDB


foreign import ccall unsafe "estmtdb.h est_mtdb_open"
        _open :: CString -> Int -> Ptr Int -> IO (Ptr ESTMTDB)

foreign import ccall unsafe "estmtdb.h est_mtdb_close"
        _close :: Ptr ESTMTDB -> Ptr Int -> IO Int

foreign import ccall unsafe "estmtdb.h est_mtdb_error"
        _error :: Ptr ESTMTDB -> IO Int

foreign import ccall unsafe "estmtdb.h est_mtdb_fatal"
        _fatal :: Ptr ESTMTDB -> IO Int

foreign import ccall unsafe "estmtdb.h est_mtdb_add_attr_index"
        _add_attr_index :: Ptr ESTMTDB -> CString -> Int -> IO Int

foreign import ccall unsafe "estmtdb.h est_mtdb_flush"
        _flush :: Ptr ESTMTDB -> Int -> IO Int

foreign import ccall unsafe "estmtdb.h est_mtdb_sync"
        _sync :: Ptr ESTMTDB -> IO Int

foreign import ccall unsafe "estmtdb.h est_mtdb_optimize"
        _optimize :: Ptr ESTMTDB -> Int -> IO Int

foreign import ccall unsafe "estmtdb.h est_mtdb_merge"
        _merge :: Ptr ESTMTDB -> CString -> Int -> IO Int

foreign import ccall unsafe "estmtdb.h est_mtdb_put_doc"
        _put_doc :: Ptr ESTMTDB -> Ptr ESTDOC -> Int -> IO Int

foreign import ccall unsafe "estmtdb.h est_mtdb_out_doc"
        _out_doc :: Ptr ESTMTDB -> Int -> Int -> IO Int

foreign import ccall unsafe "estmtdb.h est_mtdb_edit_doc"
        _edit_doc :: Ptr ESTMTDB -> Ptr ESTDOC -> IO Int

foreign import ccall unsafe "estmtdb.h est_mtdb_get_doc"
        _get_doc :: Ptr ESTMTDB -> Int -> Int -> IO (Ptr ESTDOC)

foreign import ccall unsafe "estmtdb.h est_mtdb_get_doc_attr"
        _get_doc_attr :: Ptr ESTMTDB -> Int -> CString -> IO CString

foreign import ccall unsafe "estmtdb.h est_mtdb_uri_to_id"
        _uri_to_id :: Ptr ESTMTDB -> CString -> IO Int

foreign import ccall unsafe "estmtdb.h est_mtdb_name"
        _name :: Ptr ESTMTDB -> IO CString

foreign import ccall unsafe "estmtdb.h est_mtdb_doc_num"
        _doc_num :: Ptr ESTMTDB -> IO Int

foreign import ccall unsafe "estmtdb.h est_mtdb_word_num"
        _word_num :: Ptr ESTMTDB -> IO Int

foreign import ccall unsafe "estmtdb.h est_mtdb_size"
        _size :: Ptr ESTMTDB -> IO Double

foreign import ccall unsafe "estmtdb.h est_mtdb_search"
        _search :: Ptr ESTMTDB -> Ptr ESTCOND -> Ptr Int -> Ptr CM.CBMAP -> IO (Ptr Int)

foreign import ccall unsafe "estmtdb.h est_mtdb_search_meta"
        _search_meta :: Ptr (Ptr ESTMTDB) -> Int -> Ptr ESTCOND -> Ptr Int -> Ptr CM.CBMAP -> IO (Ptr Int)

foreign import ccall unsafe "estmtdb.h est_mtdb_scan_doc"
        _scan_doc :: Ptr ESTMTDB -> Ptr ESTDOC -> Ptr ESTCOND -> IO Int

foreign import ccall unsafe "estmtdb.h est_mtdb_set_cache_size"
        _set_cache_size :: Ptr ESTMTDB -> CSize -> Int -> Int -> Int -> IO ()


wrapDB :: Ptr ESTMTDB -> IO Database
wrapDB dbPtr = fmap Database (newIORef dbPtr)


withDBPtr :: Database -> (Ptr ESTMTDB -> IO a) -> IO a
withDBPtr (Database ref) f
    = do dbPtr <- readIORef ref
         if dbPtr == nullPtr then
             fail "The HyperEstraier DB has already been closed."
           else
             f dbPtr

-- |@'withDatabase' fpath mode f@ opens a database at @fpath@ and
-- compute @f@. When the action @f@ finishes or throws an exception,
-- the database will be closed automatically. If 'withDatabase' fails
-- to open the database, it throws an 'EstError'. See 'openDatabase'.
withDatabase :: FilePath -> OpenMode -> (Database -> IO a) -> IO a
withDatabase fpath opts f = bracket openDB' closeDatabase f
    where
      openDB' :: IO Database
      openDB' = do ret <- openDatabase fpath opts
                   case ret of
                     Left  err -> throwIO err
                     Right db  -> return db

-- |@'openDatabase' fpath mode@ opens a database at @fpath@. If it
-- succeeds it returns @'Prelude.Right' 'Database'@, otherwise it
-- returns @'Prelude.Left' 'EstError'@.
--
-- The 'Database' can be shared by multiple threads, but there is one
-- important limitation in the current implementation of the
-- HyperEstraier itself. /A single process can NOT open the same
-- database twice simultaneously./ Such attempt results in
-- 'AccessForbidden'.
openDatabase :: FilePath -> OpenMode -> IO (Either EstError Database)
openDatabase fpath opts
    = withUTF8CString fpath $ \ fpathPtr ->
      alloca                $ \ errPtr   ->
      do dbPtr <- _open fpathPtr (marshalOpenMode opts) errPtr
         if dbPtr == nullPtr then
             fmap (Left . unmarshalError) (peek errPtr)
           else
             fmap Right (wrapDB dbPtr)

-- |@'closeDatabase' db@ closes the database @db@. If the @db@ has
-- already been closed, this operation causes nothing.
closeDatabase :: Database -> IO ()
closeDatabase (Database ref)
    = do dbPtr <- readIORef ref
         when (dbPtr /= nullPtr) (close' dbPtr)
    where
      close' :: Ptr ESTMTDB -> IO ()
      close' dbPtr
          = alloca $ \ errPtr ->
            do ret <- _close dbPtr errPtr
               case ret of
                 0 -> peek errPtr >>= throwIO . unmarshalError
                 _ -> writeIORef ref nullPtr


throwLastError :: Database -> IO a
throwLastError db
    = withDBPtr db $ \ dbPtr ->
      _error dbPtr >>= throwIO . unmarshalError


throwLastErrorIf :: Database -> Bool -> IO ()
throwLastErrorIf _  False = return ()
throwLastErrorIf db True  = throwLastError db

-- |Return 'Prelude.True' iff the document has a fatal error.
hasFatalError :: Database -> IO Bool
hasFatalError db
    = withDBPtr db $ \ dbPtr ->
      fmap (/= 0) (_fatal dbPtr)

-- |@'addAttrIndex' db attr idxType@ creates an index of type
-- @idxType@ for attribute @attr@ into the database @db@.
addAttrIndex :: Database -> String -> AttrIndexType -> IO ()
addAttrIndex db attr idxType
    = withDBPtr       db   $ \ dbPtr   ->
      withUTF8CString attr $ \ attrPtr ->
      _add_attr_index dbPtr attrPtr (marshalAttrIndexType idxType)
           >>= throwLastErrorIf db . (== 0)

-- |@'flushDatabase' db numWords@ flushes at most @numWords@ index
-- words in the cache of the database @db@. If @numWords <= 0@ all the
-- index words will be flushed.
flushDatabase :: Database -> Int -> IO ()
flushDatabase db maxWords
    = withDBPtr db $ \ dbPtr ->
      _flush dbPtr maxWords
           >>= throwLastErrorIf db . (== 0)

-- |Synchronize a database to the disk.
syncDatabase :: Database -> IO ()
syncDatabase db
    = withDBPtr db $ \ dbPtr ->
      _sync dbPtr
           >>= throwLastErrorIf db . (== 0)

-- |Optimize a database.
optimizeDatabase :: Database -> [OptimizeOption] -> IO ()
optimizeDatabase db opts
    = withDBPtr db $ \ dbPtr ->
      _optimize dbPtr (marshalOpts marshalOptimizeOption opts)
           >>= throwLastErrorIf db . (== 0)

-- |@'mergeDatabase' db fpath opts@ merges another database at @fpath@
-- (source) to the @db@ (destination). The flags of the two databases
-- must be the same. If any documents in the source database have the
-- same URI as the documents in the destination, those documents in
-- the destination will be overwritten.
mergeDatabase :: Database -> FilePath -> [RemoveOption] -> IO ()
mergeDatabase db fpath opts
    = withDBPtr       db    $ \ dbPtr    ->
      withUTF8CString fpath $ \ fpathPtr ->
      _merge dbPtr fpathPtr (marshalOpts marshalRemoveOption opts)
           >>= throwLastErrorIf db . (== 0)

-- |Put a document into a database. The document must have an
-- @\"\@uri\"@ attribute. If the database already has a document whose
-- URI is the same as of the new document, the old one will be
-- overwritten. See 'Text.HyperEstraier.Document.setURI' and
-- 'updateDocAttrs'.
putDocument :: Database -> Document -> [PutOption] -> IO ()
putDocument db doc opts
    = withDBPtr  db  $ \ dbPtr  ->
      withDocPtr doc $ \ docPtr ->
      _put_doc dbPtr docPtr (marshalOpts marshalPutOption opts)
           >>= throwLastErrorIf db . (== 0)

-- |Remove a document from a database.
removeDocument :: Database -> DocumentID -> [RemoveOption] -> IO ()
removeDocument db docId opts
    = withDBPtr db $ \ dbPtr ->
      _out_doc dbPtr docId (marshalOpts marshalRemoveOption opts)
           >>= throwLastErrorIf db . (== 0)

-- |Update attributes of a document in a database. The document to be
-- updated is determined by the document ID. It is an error to change
-- the URI of the document to be the same as of one of existing
-- documents. Note that the document body will not be updated. See
-- 'putDocument'.
updateDocAttrs :: Database -> Document -> IO ()
updateDocAttrs db doc
    = withDBPtr  db  $ \ dbPtr  ->
      withDocPtr doc $ \ docPtr ->
      _edit_doc dbPtr docPtr
           >>= throwLastErrorIf db . (== 0)

-- |Find a document in a database by an ID.
getDocument :: Database -> DocumentID -> [GetOption] -> IO Document
getDocument db docId opts
    = withDBPtr db $ \ dbPtr ->
      do docPtr <- _get_doc dbPtr docId (marshalOpts marshalGetOption opts)
         throwLastErrorIf db (docPtr == nullPtr)
         wrapDoc docPtr

-- |Get an attribute of a document in a database.
getDocAttr :: Database -> DocumentID -> String -> IO (Maybe String)
getDocAttr db docId name
    = withDBPtr       db   $ \ dbPtr   ->
      withUTF8CString name $ \ namePtr ->
      do valuePtr <- _get_doc_attr dbPtr docId namePtr
         if valuePtr == nullPtr then
             return Nothing
           else
             fmap Just (packMallocUTF8CString valuePtr)

-- |Get the URI of a document in a database.
getDocURI :: Database -> DocumentID -> IO URI
getDocURI db docId
    = fmap (fromJust . parseURI . fromJust) (getDocAttr db docId "@uri")

-- |Find a document in a database by an URI and return its ID.
getDocIdByURI :: Database -> URI -> IO (Maybe DocumentID)
getDocIdByURI db uri
    = withDBPtr db $ \ dbPtr ->
      withUTF8CString (uriToString id uri "") $ \ uriPtr ->
      do ret <- _uri_to_id dbPtr uriPtr
         case ret of
           -1 -> return Nothing
           _  -> return (Just ret)

-- |Get the name of a database.
getDatabaseName :: Database -> IO String
getDatabaseName db
    = withDBPtr db $ \ dbPtr ->
      _name dbPtr 
           >>= peekUTF8CString

-- |Get the number of documents in a database.
getNumOfDocs :: Database -> IO Int
getNumOfDocs db
    = withDBPtr db _doc_num

-- |Get the number of words in a database.
getNumOfWords :: Database -> IO Int
getNumOfWords db
    = withDBPtr db _word_num

-- |Get the size of a database.
getDatabaseSize :: Database -> IO Integer
getDatabaseSize db
    = withDBPtr db $ \ dbPtr ->
      -- Why est_db_size() returns double? Why not size_t or long long
      -- int? Crazy.
      fmap floor (_size dbPtr)

-- |Search for documents in a database by a condition.
searchDatabase :: Database -> Condition -> IO [DocumentID]
searchDatabase db cond
    = withDBPtr   db   $ \ dbPtr     ->
      withCondPtr cond $ \ condPtr   ->
      alloca           $ \ retLenPtr ->
      do retPtr <- _search dbPtr condPtr retLenPtr nullPtr
         retLen <- peek retLenPtr
         ret    <- peekArray retLen retPtr
         free retPtr
         return ret

-- |Search for documents in a database by a condition. The second item
-- of the resulting tuple is a map from each search words to the
-- number of documents which are matched to the word.
searchDatabase' :: Database -> Condition -> IO ([DocumentID], [(String, Int)])
searchDatabase' db cond
    = do hints <- CM.newMap
         withDBPtr db $ \ dbPtr ->
             withCondPtr cond    $ \ condPtr   ->
             alloca              $ \ retLenPtr ->
             CM.withMapPtr hints $ \ hintsPtr  ->
             do retPtr <- _search dbPtr condPtr retLenPtr hintsPtr
                retLen <- peek retLenPtr
                ret    <- peekArray retLen retPtr
                free retPtr
                hints' <- liftM (map decodeHint) (CM.toList hints)
                return (ret, hints')


decodeHint :: (Strict.ByteString, Strict.ByteString) -> (String, Int)
decodeHint (word, count)
    = let word'  = decodeString $ C8.unpack word
          count' = read $ C8.unpack count
      in
        (word', count')

-- |Search for documents in many databases at once.
metaSearch :: [Database] -> Condition -> IO [(Database, DocumentID)]
metaSearch dbs cond
    = withArrayOfPtrs withDBPtr dbs $ \ dbPtrArray ->
      withCondPtr cond              $ \ condPtr    ->
      alloca                        $ \ retLenPtr  ->
      do retPtr <- _search_meta dbPtrArray (length dbs) condPtr retLenPtr nullPtr
         retLen <- peek retLenPtr
         ret    <- liftM (decodeMetaSearchRec dbs) $ peekArray retLen retPtr
         free retPtr
         return ret

-- |Search for documents in many databases at once. The second item of
-- the resulting tuple is a map from each search words to the number
-- of documents which are matched to the word.
metaSearch' :: [Database]
            -> Condition
            -> IO ([(Database, DocumentID)], [(String, Int)])
metaSearch' dbs cond
    = do hints <- CM.newMap
         withArrayOfPtrs withDBPtr dbs $ \ dbPtrArray ->
             withCondPtr cond          $ \ condPtr    ->
             alloca                    $ \ retLenPtr  ->
             CM.withMapPtr hints       $ \ hintsPtr   ->
             do retPtr <- _search_meta dbPtrArray (length dbs) condPtr retLenPtr hintsPtr
                retLen <- peek retLenPtr
                ret    <- liftM (decodeMetaSearchRec dbs) $ peekArray retLen retPtr
                free retPtr
                hints' <- liftM (map decodeHint) (CM.toList hints)
                return (ret, hints')


decodeMetaSearchRec :: [Database] -> [Int] -> [(Database, DocumentID)]
decodeMetaSearchRec _   []               = []
decodeMetaSearchRec dbs (dbIdx:docId:xs) = (dbs !! dbIdx, docId) : decodeMetaSearchRec dbs xs
decodeMetaSearchRec _   _                = error "illegal meta search records"

-- |Check if a document matches to every phrases in a condition.
--
-- To be honest with you, the author of this binding doesn't really
-- know what @est_db_scan_doc()@ does. Its documentation is way too
-- ambiguous across the board. Moreover, the names of symbols of the
-- HyperEstraier are very badly named. Can you imagine what, say
-- @est_db_out_doc()@ does? How about the constant named
-- @ESTCONDSURE@? The author got tired of examining the commentless
-- source code over and over again to write this binding. Its
-- functionality is awesome though...
scanDocument :: Database -> Document -> Condition -> IO Bool
scanDocument db doc cond
    = withDBPtr   db   $ \ dbPtr   ->
      withDocPtr  doc  $ \ docPtr  ->
      withCondPtr cond $ \ condPtr ->
      fmap (/= 0) (_scan_doc dbPtr docPtr condPtr)

-- |Change the size of various caches of a database. Passing negative
-- values leaves the old values unchanged.
setCacheSize :: Database -- ^ The database.
             -> Int      -- ^ Maximum size of the index cache. (default: 64 MiB)
             -> Int      -- ^ Maximum records of cached attributes. (default: 8192 records)
             -> Int      -- ^ Maximum number of cached document text. (default: 1024 documents)
             -> Int      -- ^ Maximum number of the cached search results. (default: 256 records)
             -> IO ()
setCacheSize db size anum tnum rnum
    = withDBPtr db $ \ dbPtr ->
      _set_cache_size dbPtr (fromIntegral size) anum tnum rnum