HsHyperEstraier-0.4: Text/HyperEstraier/Database.hsc
{-# LANGUAGE
DeriveDataTypeable
, EmptyDataDecls
, ForeignFunctionInterface
, OverloadedStrings
, UnicodeSyntax
#-}
#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 Control.Exception
import Control.Monad
import Control.Monad.Unicode
import Data.Bits
import qualified Data.ByteString as B (ByteString)
import qualified Data.ByteString.Char8 as C8 hiding (ByteString)
import Data.IORef
import Data.Maybe
import qualified Data.Text as T
import Data.Text.Encoding
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
import Prelude.Unicode
-- |'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 ∷ CInt → 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 → CInt
marshalOpenMode (Reader opts) = (#const ESTDBREADER) .|. marshalOpts marshalReaderOption opts
marshalOpenMode (Writer opts) = (#const ESTDBWRITER) .|. marshalOpts marshalWriterOption opts
marshalReaderOption ∷ ReaderOption → CInt
marshalReaderOption (ReadLock mode) = marshalLockingMode mode
marshalWriterOption ∷ WriterOption → CInt
marshalWriterOption (Create opts) = (#const ESTDBCREAT) .|. marshalOpts marshalCreateOption opts
marshalWriterOption (Truncate opts) = (#const ESTDBTRUNC) .|. marshalOpts marshalCreateOption opts
marshalWriterOption (WriteLock mode) = marshalLockingMode mode
marshalLockingMode ∷ LockingMode → CInt
marshalLockingMode NoLock = #const ESTDBNOLCK
marshalLockingMode NonblockingLock = #const ESTDBLCKNB
marshalCreateOption ∷ CreateOption → CInt
marshalCreateOption (Analysis opt ) = marshalAnalysisOption opt
marshalCreateOption (Index tuning) = marshalIndexTuning tuning
marshalCreateOption (Score opts ) = marshalOpts marshalScoreOption opts
marshalAnalysisOption ∷ AnalysisOption → CInt
marshalAnalysisOption PerfectNGram = #const ESTDBPERFNG
marshalAnalysisOption CharCategory = #const ESTDBCHRCAT
marshalIndexTuning ∷ IndexTuning → CInt
marshalIndexTuning Small = #const ESTDBSMALL
marshalIndexTuning Large = #const ESTDBLARGE
marshalIndexTuning Huge = #const ESTDBHUGE
marshalIndexTuning Huge2 = #const ESTDBHUGE2
marshalIndexTuning Huge3 = #const ESTDBHUGE3
marshalScoreOption ∷ ScoreOption → CInt
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 → CInt
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 → CInt
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 → CInt
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 → CInt
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 → CInt
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 → CInt → Ptr CInt → IO (Ptr ESTMTDB)
foreign import ccall unsafe "estmtdb.h est_mtdb_close"
_close ∷ Ptr ESTMTDB → Ptr CInt → IO CInt
foreign import ccall unsafe "estmtdb.h est_mtdb_error"
_error ∷ Ptr ESTMTDB → IO CInt
foreign import ccall unsafe "estmtdb.h est_mtdb_fatal"
_fatal ∷ Ptr ESTMTDB → IO CInt
foreign import ccall unsafe "estmtdb.h est_mtdb_add_attr_index"
_add_attr_index ∷ Ptr ESTMTDB → CString → CInt → IO CInt
foreign import ccall unsafe "estmtdb.h est_mtdb_flush"
_flush ∷ Ptr ESTMTDB → CInt → IO CInt
foreign import ccall unsafe "estmtdb.h est_mtdb_sync"
_sync ∷ Ptr ESTMTDB → IO CInt
foreign import ccall unsafe "estmtdb.h est_mtdb_optimize"
_optimize ∷ Ptr ESTMTDB → CInt → IO CInt
foreign import ccall unsafe "estmtdb.h est_mtdb_merge"
_merge ∷ Ptr ESTMTDB → CString → CInt → IO CInt
foreign import ccall unsafe "estmtdb.h est_mtdb_put_doc"
_put_doc ∷ Ptr ESTMTDB → Ptr ESTDOC → CInt → IO CInt
foreign import ccall unsafe "estmtdb.h est_mtdb_out_doc"
_out_doc ∷ Ptr ESTMTDB → CInt → CInt → IO CInt
foreign import ccall unsafe "estmtdb.h est_mtdb_edit_doc"
_edit_doc ∷ Ptr ESTMTDB → Ptr ESTDOC → IO CInt
foreign import ccall unsafe "estmtdb.h est_mtdb_get_doc"
_get_doc ∷ Ptr ESTMTDB → CInt → CInt → IO (Ptr ESTDOC)
foreign import ccall unsafe "estmtdb.h est_mtdb_get_doc_attr"
_get_doc_attr ∷ Ptr ESTMTDB → CInt → CString → IO CString
foreign import ccall unsafe "estmtdb.h est_mtdb_uri_to_id"
_uri_to_id ∷ Ptr ESTMTDB → CString → IO CInt
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 CInt
foreign import ccall unsafe "estmtdb.h est_mtdb_word_num"
_word_num ∷ Ptr ESTMTDB → IO CInt
foreign import ccall unsafe "estmtdb.h est_mtdb_size"
_size ∷ Ptr ESTMTDB → IO CDouble
foreign import ccall unsafe "estmtdb.h est_mtdb_search"
_search ∷ Ptr ESTMTDB → Ptr ESTCOND → Ptr CInt → Ptr CM.CBMAP → IO (Ptr CInt)
foreign import ccall unsafe "estmtdb.h est_mtdb_search_meta"
_search_meta ∷ Ptr (Ptr ESTMTDB) → CInt → Ptr ESTCOND → Ptr CInt → Ptr CM.CBMAP → IO (Ptr CInt)
foreign import ccall unsafe "estmtdb.h est_mtdb_scan_doc"
_scan_doc ∷ Ptr ESTMTDB → Ptr ESTDOC → Ptr ESTCOND → IO CInt
foreign import ccall unsafe "estmtdb.h est_mtdb_set_cache_size"
_set_cache_size ∷ Ptr ESTMTDB → CSize → CInt → CInt → CInt → 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 path' $ \ fpathPtr →
alloca $ \ errPtr →
do dbPtr ← _open fpathPtr (marshalOpenMode opts) errPtr
if dbPtr == nullPtr then
fmap (Left ∘ unmarshalError) (peek errPtr)
else
fmap Right (wrapDB dbPtr)
where
path' = T.pack fpath
-- |@'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 → T.Text → 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 (fromIntegral 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 path' $ \ fpathPtr →
_merge dbPtr fpathPtr (marshalOpts marshalRemoveOption opts)
≫= throwLastErrorIf db ∘ (== 0)
where
path' = T.pack fpath
-- |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 (fromIntegral 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 (fromIntegral docId)
(marshalOpts marshalGetOption opts)
throwLastErrorIf db (docPtr == nullPtr)
wrapDoc docPtr
-- |Get an attribute of a document in a database.
getDocAttr ∷ Database → DocumentID → T.Text → IO (Maybe T.Text)
getDocAttr db docId name
= withDBPtr db $ \ dbPtr →
withUTF8CString name $ \ namePtr →
do valuePtr ← _get_doc_attr dbPtr (fromIntegral 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 ∘ T.unpack ∘ 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 (T.pack $ uriToString id uri "") $ \ uriPtr →
do ret ← liftM fromIntegral $ _uri_to_id dbPtr uriPtr
case ret of
-1 → return Nothing
_ → return (Just ret)
-- |Get the name of a database.
getDatabaseName ∷ Database → IO T.Text
getDatabaseName db
= withDBPtr db $ \ dbPtr →
_name dbPtr
≫= peekUTF8CString
-- |Get the number of documents in a database.
getNumOfDocs ∷ Database → IO Int
getNumOfDocs
= liftM fromIntegral ∘ flip withDBPtr _doc_num
-- |Get the number of words in a database.
getNumOfWords ∷ Database → IO Int
getNumOfWords
= liftM fromIntegral ∘ flip withDBPtr _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 ← liftM fromIntegral $ peek retLenPtr
ret ← liftM (map fromIntegral) $ 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], [(T.Text, 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 ← liftM fromIntegral $ peek retLenPtr
ret ← liftM (map fromIntegral) $ peekArray retLen retPtr
free retPtr
hints' ← liftM (map decodeHint) (CM.toList hints)
return (ret, hints')
decodeHint ∷ (B.ByteString, B.ByteString) → (T.Text, Int)
decodeHint (word, count)
= (decodeUtf8 word, read $ C8.unpack 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 (fromIntegral $ length dbs) condPtr retLenPtr nullPtr
retLen ← liftM fromIntegral $ 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)], [(T.Text, 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 (fromIntegral $ length dbs) condPtr retLenPtr hintsPtr
retLen ← liftM fromIntegral $ peek retLenPtr
ret ← liftM (decodeMetaSearchRec dbs) $ peekArray retLen retPtr
free retPtr
hints' ← liftM (map decodeHint) (CM.toList hints)
return (ret, hints')
decodeMetaSearchRec ∷ [Database] → [CInt] → [(Database, DocumentID)]
decodeMetaSearchRec _ [] = []
decodeMetaSearchRec dbs (dbIdx:docId:xs) = (dbs !! fromIntegral dbIdx, fromIntegral 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)
(fromIntegral anum)
(fromIntegral tnum)
(fromIntegral rnum)