HsHyperEstraier-0.2: Text/HyperEstraier/Database.hsc
#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.Dynamic
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. It
-- is usually thrown as a 'Control.Exception.DynException'.
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)
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 = newIORef dbPtr >>= return . Database
throwEstError :: EstError -> IO a
throwEstError = throwIO . DynException . toDyn
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 -> throwEstError 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
peek errPtr >>= return . Left . unmarshalError
else
wrapDB dbPtr >>= return . Right
-- |@'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 >>= throwEstError . unmarshalError
_ -> writeIORef ref nullPtr
throwLastError :: Database -> IO a
throwLastError db
= withDBPtr db $ \ dbPtr ->
_error dbPtr >>= throwEstError . 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 ->
_fatal dbPtr >>= return . (/= 0)
-- |@'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
packMallocUTF8CString valuePtr >>= return . Just
-- |Get the URI of a document in a database.
getDocURI :: Database -> DocumentID -> IO URI
getDocURI db docId
= getDocAttr db docId "@uri" >>= return . fromJust . parseURI . fromJust
-- |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 $ \ dbPtr ->
_doc_num dbPtr
-- |Get the number of words in a database.
getNumOfWords :: Database -> IO Int
getNumOfWords db
= withDBPtr db $ \ dbPtr ->
_word_num dbPtr
-- |Get the size of a database.
getDatabaseSize :: Database -> IO Integer
getDatabaseSize db
= withDBPtr db $ \ dbPtr ->
-- なんで est_db_size() の戻り値が double なの。なんで size_t と
-- か long long int とかぢゃないの。H.E. のやってる事は大雜把には
-- 凄いのに、細かい部分が實に好い加減だなあ…
_size dbPtr >>= return . floor
-- |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 ->
_scan_doc dbPtr docPtr condPtr
>>= return . (/= 0)
-- |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