diff --git a/HsHyperEstraier.cabal b/HsHyperEstraier.cabal --- a/HsHyperEstraier.cabal +++ b/HsHyperEstraier.cabal @@ -5,7 +5,7 @@ Haskell. HyperEstraier is an embeddable full text search engine which is supposed to be independent to any particular natural languages. -Version: 0.3.2 +Version: 0.3.2.1 License: PublicDomain License-File: COPYING Author: PHO @@ -13,7 +13,7 @@ Stability: experimental Homepage: http://cielonegro.org/HsHyperEstraier.html Category: Text -Tested-With: GHC == 6.8.1 +Tested-With: GHC == 6.12.3 Cabal-Version: >= 1.6 Build-Type: Simple Extra-Source-Files: @@ -27,9 +27,13 @@ Library Build-Depends: - base >= 4 && < 5, bytestring, network, utf8-string + base == 4.2.*, + bytestring == 0.9.*, + network == 2.2.*, + utf8-string == 0.3.* PkgConfig-Depends: - hyperestraier >= 1.4.9, qdbm >= 1.8.74 + hyperestraier >= 1.4.9, + qdbm >= 1.8.74 Exposed-Modules: Text.HyperEstraier Text.HyperEstraier.Condition diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -1,7 +1,10 @@ +Changes from 0.3.2 to 0.3.2.1 +----------------------------- +* Fix breakage on 64-bit environments; reported by Mats Rauhala. + Changes from 0.3.1 to 0.3.2 --------------------------- * Fixed breakage on GHC 6.12.1 - Changes from 0.3 to 0.3.1 ------------------------- diff --git a/Text/HyperEstraier/Condition.hsc b/Text/HyperEstraier/Condition.hsc --- a/Text/HyperEstraier/Condition.hsc +++ b/Text/HyperEstraier/Condition.hsc @@ -33,6 +33,7 @@ import Control.Exception import Data.Bits import Foreign.C.String +import Foreign.C.Types import Foreign.ForeignPtr import Foreign.Ptr import Text.HyperEstraier.Utils @@ -71,7 +72,7 @@ -- details. deriving (Eq, Show) -marshalCondOption :: CondOption -> Int +marshalCondOption :: CondOption -> CInt marshalCondOption (Speed Slow ) = #const ESTCONDSURE marshalCondOption (Speed Normal ) = #const ESTCONDUSUAL marshalCondOption (Speed Fast ) = #const ESTCONDFAST @@ -101,14 +102,14 @@ deriving (Eq, Show) -marshalEclipse :: Eclipse -> Double -marshalEclipse (Threshold thr) = assertThreshold thr -marshalEclipse (ThresholdWithURL thr) = assertThreshold thr + #const ESTECLSIMURL +marshalEclipse :: Eclipse -> CDouble +marshalEclipse (Threshold thr) = assertThreshold (realToFrac thr) +marshalEclipse (ThresholdWithURL thr) = assertThreshold (realToFrac thr) + #const ESTECLSIMURL marshalEclipse SameServer = #const ESTECLSERV marshalEclipse SameDirectory = #const ESTECLDIR marshalEclipse SameFile = #const ESTECLFILE -assertThreshold :: Double -> Double +assertThreshold :: (Fractional a, Ord a) => a -> a assertThreshold thr = assert (thr >= 0.0 && thr <= 1.0) thr @@ -128,25 +129,25 @@ _set_order :: Ptr ESTCOND -> CString -> IO () foreign import ccall unsafe "estraier.h est_cond_set_max" - _set_max :: Ptr ESTCOND -> Int -> IO () + _set_max :: Ptr ESTCOND -> CInt -> IO () foreign import ccall unsafe "estraier.h est_cond_set_skip" - _set_skip :: Ptr ESTCOND -> Int -> IO () + _set_skip :: Ptr ESTCOND -> CInt -> IO () foreign import ccall unsafe "estraier.h est_cond_set_options" - _set_options :: Ptr ESTCOND -> Int -> IO () + _set_options :: Ptr ESTCOND -> CInt -> IO () foreign import ccall unsafe "estraier.h est_cond_set_auxiliary" - _set_auxiliary :: Ptr ESTCOND -> Int -> IO () + _set_auxiliary :: Ptr ESTCOND -> CInt -> IO () foreign import ccall unsafe "estraier.h est_cond_set_eclipse" - _set_eclipse :: Ptr ESTCOND -> Double -> IO () + _set_eclipse :: Ptr ESTCOND -> CDouble -> IO () foreign import ccall unsafe "estraier.h est_cond_set_distinct" _set_distinct :: Ptr ESTCOND -> CString -> IO () foreign import ccall unsafe "estraier.h est_cond_set_mask" - _set_mask :: Ptr ESTCOND -> Int -> IO () + _set_mask :: Ptr ESTCOND -> CInt -> IO () wrapCond :: Ptr ESTCOND -> IO Condition @@ -192,33 +193,34 @@ -- |@'setMax' cond n@ specifies the maximum number of results. By -- default, the number of results is unlimited. setMax :: Condition -> Int -> IO () -setMax cond n - = withCondPtr cond $ flip _set_max n +setMax cond + = withCondPtr cond . flip _set_max . fromIntegral -- |@'setSkip' cond n@ specifies how many documents should be skipped -- from the beginning of result. setSkip :: Condition -> Int -> IO () -setSkip cond n - = withCondPtr cond $ flip _set_skip n +setSkip cond + = withCondPtr cond . flip _set_skip . fromIntegral -- |@'setOptions' cond opts@ specifies options to the search -- condition. setOptions :: Condition -> [CondOption] -> IO () -setOptions cond options - = withCondPtr cond $ - flip _set_options (marshalOpts marshalCondOption options) +setOptions cond + = withCondPtr cond . + flip _set_options . + marshalOpts marshalCondOption -- |@'setAuxiliary' cond min@ specifies how many documents should be -- in the result to avoid using the auxiliary index to pad the result. setAuxiliary :: Condition -> Int -> IO () -setAuxiliary cond n - = withCondPtr cond $ flip _set_auxiliary n +setAuxiliary cond + = withCondPtr cond . flip _set_auxiliary . fromIntegral -- |@'setEclipse' cond ecl@ specifies how to hide documents from the -- search result by their similarity. setEclipse :: Condition -> Eclipse -> IO () -setEclipse cond ecl - = withCondPtr cond $ flip _set_eclipse (marshalEclipse ecl) +setEclipse cond + = withCondPtr cond . flip _set_eclipse . marshalEclipse -- |@'setDistinct' cond attr@ specifies an attribute which must be -- unique to the search result. @@ -244,8 +246,8 @@ -- > print result -- setMetaSearchMask :: Condition -> [Int] -> IO () -setMetaSearchMask cond xs - = withCondPtr cond $ flip _set_max (calculateMask xs) +setMetaSearchMask cond + = withCondPtr cond . flip _set_max . fromIntegral . calculateMask where calculateMask :: [Int] -> Int calculateMask [] = 0 diff --git a/Text/HyperEstraier/Database.hsc b/Text/HyperEstraier/Database.hsc --- a/Text/HyperEstraier/Database.hsc +++ b/Text/HyperEstraier/Database.hsc @@ -95,7 +95,7 @@ instance Exception EstError -unmarshalError :: Int -> EstError +unmarshalError :: CInt -> EstError unmarshalError (#const ESTEINVAL ) = InvalidArgument unmarshalError (#const ESTEACCES ) = AccessForbidden unmarshalError (#const ESTELOCK ) = LockFailure @@ -187,39 +187,39 @@ deriving (Eq, Show) -marshalOpenMode :: OpenMode -> Int +marshalOpenMode :: OpenMode -> CInt marshalOpenMode (Reader opts) = (#const ESTDBREADER) .|. marshalOpts marshalReaderOption opts marshalOpenMode (Writer opts) = (#const ESTDBWRITER) .|. marshalOpts marshalWriterOption opts -marshalReaderOption :: ReaderOption -> Int +marshalReaderOption :: ReaderOption -> CInt marshalReaderOption (ReadLock mode) = marshalLockingMode mode -marshalWriterOption :: WriterOption -> Int +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 -> Int +marshalLockingMode :: LockingMode -> CInt marshalLockingMode NoLock = #const ESTDBNOLCK marshalLockingMode NonblockingLock = #const ESTDBLCKNB -marshalCreateOption :: CreateOption -> Int +marshalCreateOption :: CreateOption -> CInt marshalCreateOption (Analysis opt ) = marshalAnalysisOption opt marshalCreateOption (Index tuning) = marshalIndexTuning tuning marshalCreateOption (Score opts ) = marshalOpts marshalScoreOption opts -marshalAnalysisOption :: AnalysisOption -> Int +marshalAnalysisOption :: AnalysisOption -> CInt marshalAnalysisOption PerfectNGram = #const ESTDBPERFNG marshalAnalysisOption CharCategory = #const ESTDBCHRCAT -marshalIndexTuning :: IndexTuning -> Int +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 -> Int +marshalScoreOption :: ScoreOption -> CInt marshalScoreOption Nullified = #const ESTDBSCVOID marshalScoreOption StoredAsInt = #const ESTDBSCINT marshalScoreOption OnlyToBeStored = #const ESTDBSCASIS @@ -237,7 +237,7 @@ deriving (Eq, Show) -marshalAttrIndexType :: AttrIndexType -> Int +marshalAttrIndexType :: AttrIndexType -> CInt marshalAttrIndexType SeqIndex = #const ESTIDXATTRSEQ marshalAttrIndexType StrIndex = #const ESTIDXATTRSTR marshalAttrIndexType NumIndex = #const ESTIDXATTRNUM @@ -251,7 +251,7 @@ deriving (Eq, Show) -marshalOptimizeOption :: OptimizeOption -> Int +marshalOptimizeOption :: OptimizeOption -> CInt marshalOptimizeOption NoPurge = #const ESTOPTNOPURGE marshalOptimizeOption NoDBOptimize = #const ESTOPTNODBOPT @@ -263,7 +263,7 @@ deriving (Eq, Show) -marshalRemoveOption :: RemoveOption -> Int +marshalRemoveOption :: RemoveOption -> CInt marshalRemoveOption CleaningRemove = #const ESTODCLEAN -- |'PutOption' is an option for the 'putDocument' action. @@ -276,7 +276,7 @@ deriving (Eq, Show) -marshalPutOption :: PutOption -> Int +marshalPutOption :: PutOption -> CInt marshalPutOption CleaningPut = #const ESTPDCLEAN marshalPutOption WeightStatically = #const ESTPDWEIGHT @@ -287,7 +287,7 @@ | NoKeywords -- ^ Don't retrieve the keywords of the document. deriving (Eq, Show) -marshalGetOption :: GetOption -> Int +marshalGetOption :: GetOption -> CInt marshalGetOption NoAttributes = #const ESTGDNOATTR marshalGetOption NoText = #const ESTGDNOTEXT marshalGetOption NoKeywords = #const ESTGDNOKWD @@ -299,73 +299,73 @@ foreign import ccall unsafe "estmtdb.h est_mtdb_open" - _open :: CString -> Int -> Ptr Int -> IO (Ptr ESTMTDB) + _open :: CString -> CInt -> Ptr CInt -> IO (Ptr ESTMTDB) foreign import ccall unsafe "estmtdb.h est_mtdb_close" - _close :: Ptr ESTMTDB -> Ptr Int -> IO Int + _close :: Ptr ESTMTDB -> Ptr CInt -> IO CInt foreign import ccall unsafe "estmtdb.h est_mtdb_error" - _error :: Ptr ESTMTDB -> IO Int + _error :: Ptr ESTMTDB -> IO CInt foreign import ccall unsafe "estmtdb.h est_mtdb_fatal" - _fatal :: Ptr ESTMTDB -> IO Int + _fatal :: Ptr ESTMTDB -> IO CInt foreign import ccall unsafe "estmtdb.h est_mtdb_add_attr_index" - _add_attr_index :: Ptr ESTMTDB -> CString -> Int -> IO Int + _add_attr_index :: Ptr ESTMTDB -> CString -> CInt -> IO CInt foreign import ccall unsafe "estmtdb.h est_mtdb_flush" - _flush :: Ptr ESTMTDB -> Int -> IO Int + _flush :: Ptr ESTMTDB -> CInt -> IO CInt foreign import ccall unsafe "estmtdb.h est_mtdb_sync" - _sync :: Ptr ESTMTDB -> IO Int + _sync :: Ptr ESTMTDB -> IO CInt foreign import ccall unsafe "estmtdb.h est_mtdb_optimize" - _optimize :: Ptr ESTMTDB -> Int -> IO Int + _optimize :: Ptr ESTMTDB -> CInt -> IO CInt foreign import ccall unsafe "estmtdb.h est_mtdb_merge" - _merge :: Ptr ESTMTDB -> CString -> Int -> IO Int + _merge :: Ptr ESTMTDB -> CString -> CInt -> IO CInt foreign import ccall unsafe "estmtdb.h est_mtdb_put_doc" - _put_doc :: Ptr ESTMTDB -> Ptr ESTDOC -> Int -> IO Int + _put_doc :: Ptr ESTMTDB -> Ptr ESTDOC -> CInt -> IO CInt foreign import ccall unsafe "estmtdb.h est_mtdb_out_doc" - _out_doc :: Ptr ESTMTDB -> Int -> Int -> IO Int + _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 Int + _edit_doc :: Ptr ESTMTDB -> Ptr ESTDOC -> IO CInt foreign import ccall unsafe "estmtdb.h est_mtdb_get_doc" - _get_doc :: Ptr ESTMTDB -> Int -> Int -> IO (Ptr ESTDOC) + _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 -> Int -> CString -> IO CString + _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 Int + _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 Int + _doc_num :: Ptr ESTMTDB -> IO CInt foreign import ccall unsafe "estmtdb.h est_mtdb_word_num" - _word_num :: Ptr ESTMTDB -> IO Int + _word_num :: Ptr ESTMTDB -> IO CInt foreign import ccall unsafe "estmtdb.h est_mtdb_size" - _size :: Ptr ESTMTDB -> IO Double + _size :: Ptr ESTMTDB -> IO CDouble foreign import ccall unsafe "estmtdb.h est_mtdb_search" - _search :: Ptr ESTMTDB -> Ptr ESTCOND -> Ptr Int -> Ptr CM.CBMAP -> IO (Ptr Int) + _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) -> Int -> Ptr ESTCOND -> Ptr Int -> Ptr CM.CBMAP -> IO (Ptr Int) + _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 Int + _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 -> Int -> Int -> Int -> IO () + _set_cache_size :: Ptr ESTMTDB -> CSize -> CInt -> CInt -> CInt -> IO () wrapDB :: Ptr ESTMTDB -> IO Database @@ -459,7 +459,7 @@ flushDatabase :: Database -> Int -> IO () flushDatabase db maxWords = withDBPtr db $ \ dbPtr -> - _flush dbPtr maxWords + _flush dbPtr (fromIntegral maxWords) >>= throwLastErrorIf db . (== 0) -- |Synchronize a database to the disk. @@ -504,7 +504,8 @@ removeDocument :: Database -> DocumentID -> [RemoveOption] -> IO () removeDocument db docId opts = withDBPtr db $ \ dbPtr -> - _out_doc dbPtr docId (marshalOpts marshalRemoveOption opts) + _out_doc dbPtr (fromIntegral docId) + (marshalOpts marshalRemoveOption opts) >>= throwLastErrorIf db . (== 0) -- |Update attributes of a document in a database. The document to be @@ -523,7 +524,8 @@ getDocument :: Database -> DocumentID -> [GetOption] -> IO Document getDocument db docId opts = withDBPtr db $ \ dbPtr -> - do docPtr <- _get_doc dbPtr docId (marshalOpts marshalGetOption opts) + do docPtr <- _get_doc dbPtr (fromIntegral docId) + (marshalOpts marshalGetOption opts) throwLastErrorIf db (docPtr == nullPtr) wrapDoc docPtr @@ -532,7 +534,7 @@ getDocAttr db docId name = withDBPtr db $ \ dbPtr -> withUTF8CString name $ \ namePtr -> - do valuePtr <- _get_doc_attr dbPtr docId namePtr + do valuePtr <- _get_doc_attr dbPtr (fromIntegral docId) namePtr if valuePtr == nullPtr then return Nothing else @@ -548,7 +550,7 @@ getDocIdByURI db uri = withDBPtr db $ \ dbPtr -> withUTF8CString (uriToString id uri "") $ \ uriPtr -> - do ret <- _uri_to_id dbPtr uriPtr + do ret <- liftM fromIntegral $ _uri_to_id dbPtr uriPtr case ret of -1 -> return Nothing _ -> return (Just ret) @@ -562,13 +564,13 @@ -- |Get the number of documents in a database. getNumOfDocs :: Database -> IO Int -getNumOfDocs db - = withDBPtr db _doc_num +getNumOfDocs + = liftM fromIntegral . flip withDBPtr _doc_num -- |Get the number of words in a database. getNumOfWords :: Database -> IO Int -getNumOfWords db - = withDBPtr db _word_num +getNumOfWords + = liftM fromIntegral . flip withDBPtr _word_num -- |Get the size of a database. getDatabaseSize :: Database -> IO Integer @@ -585,8 +587,8 @@ withCondPtr cond $ \ condPtr -> alloca $ \ retLenPtr -> do retPtr <- _search dbPtr condPtr retLenPtr nullPtr - retLen <- peek retLenPtr - ret <- peekArray retLen retPtr + retLen <- liftM fromIntegral $ peek retLenPtr + ret <- liftM (map fromIntegral) $ peekArray retLen retPtr free retPtr return ret @@ -601,8 +603,8 @@ alloca $ \ retLenPtr -> CM.withMapPtr hints $ \ hintsPtr -> do retPtr <- _search dbPtr condPtr retLenPtr hintsPtr - retLen <- peek retLenPtr - ret <- peekArray retLen retPtr + retLen <- liftM fromIntegral $ peek retLenPtr + ret <- liftM (map fromIntegral) $ peekArray retLen retPtr free retPtr hints' <- liftM (map decodeHint) (CM.toList hints) return (ret, hints') @@ -621,8 +623,8 @@ = withArrayOfPtrs withDBPtr dbs $ \ dbPtrArray -> withCondPtr cond $ \ condPtr -> alloca $ \ retLenPtr -> - do retPtr <- _search_meta dbPtrArray (length dbs) condPtr retLenPtr nullPtr - retLen <- peek 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 @@ -639,17 +641,18 @@ withCondPtr cond $ \ condPtr -> alloca $ \ retLenPtr -> CM.withMapPtr hints $ \ hintsPtr -> - do retPtr <- _search_meta dbPtrArray (length dbs) condPtr retLenPtr hintsPtr - retLen <- peek retLenPtr + 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] -> [Int] -> [(Database, DocumentID)] +decodeMetaSearchRec :: [Database] -> [CInt] -> [(Database, DocumentID)] decodeMetaSearchRec _ [] = [] -decodeMetaSearchRec dbs (dbIdx:docId:xs) = (dbs !! dbIdx, docId) : decodeMetaSearchRec dbs xs +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. @@ -679,4 +682,7 @@ -> IO () setCacheSize db size anum tnum rnum = withDBPtr db $ \ dbPtr -> - _set_cache_size dbPtr (fromIntegral size) anum tnum rnum + _set_cache_size dbPtr (fromIntegral size) + (fromIntegral anum) + (fromIntegral tnum) + (fromIntegral rnum) diff --git a/Text/HyperEstraier/Document.hsc b/Text/HyperEstraier/Document.hsc --- a/Text/HyperEstraier/Document.hsc +++ b/Text/HyperEstraier/Document.hsc @@ -41,11 +41,13 @@ where import Codec.Binary.UTF8.String +import Control.Monad import qualified Data.ByteString.Char8 as C8 import Data.Maybe import qualified Database.QDBM.Cabin.List as CL import qualified Database.QDBM.Cabin.Map as CM import Foreign.C.String +import Foreign.C.Types import Foreign.ForeignPtr import Foreign.Ptr import Text.HyperEstraier.Utils @@ -84,10 +86,10 @@ _set_keywords :: Ptr ESTDOC -> Ptr CM.CBMAP -> IO () foreign import ccall unsafe "estraier.h est_doc_set_score" - _set_score :: Ptr ESTDOC -> Int -> IO () + _set_score :: Ptr ESTDOC -> CInt -> IO () foreign import ccall unsafe "estraier.h est_doc_id" - _id :: Ptr ESTDOC -> IO Int + _id :: Ptr ESTDOC -> IO CInt foreign import ccall unsafe "estraier.h est_doc_attr_names" _attr_names :: Ptr ESTDOC -> IO (Ptr CL.CBLIST) @@ -102,13 +104,13 @@ _keywords :: Ptr ESTDOC -> IO (Ptr CM.CBMAP) foreign import ccall unsafe "estraier.h est_doc_score" - _score :: Ptr ESTDOC -> IO Int + _score :: Ptr ESTDOC -> IO CInt foreign import ccall unsafe "estraier.h est_doc_dump_draft" _dump_draft :: Ptr ESTDOC -> IO CString foreign import ccall unsafe "estraier.h est_doc_make_snippet" - _make_snippet :: Ptr ESTDOC -> Ptr CL.CBLIST -> Int -> Int -> Int -> IO CString + _make_snippet :: Ptr ESTDOC -> Ptr CL.CBLIST -> CInt -> CInt -> CInt -> IO CString wrapDoc :: Ptr ESTDOC -> IO Document @@ -179,13 +181,13 @@ -- |Set an alternative score of a document. setScore :: Document -> Maybe Int -> IO () -setScore doc score - = withDocPtr doc $ flip _set_score (fromMaybe (-1) score) +setScore doc + = withDocPtr doc . flip _set_score . fromIntegral . fromMaybe (-1) -- |Get the ID of document. getId :: Document -> IO DocumentID -getId doc - = withDocPtr doc _id +getId + = liftM fromIntegral . flip withDocPtr _id -- |Get a list of all attribute names in a document. getAttrNames :: Document -> IO [String] @@ -239,7 +241,7 @@ _score docPtr >>= \ n -> case n of -1 -> return Nothing - _ -> return (Just n) + _ -> return $ Just $ fromIntegral n -- |Dump a document in the \"draft\" format. dumpDraft :: Document -> IO String @@ -264,7 +266,9 @@ = do wordsList <- CL.fromList $ map (C8.pack . encodeString) words withDocPtr doc $ \ docPtr -> CL.withListPtr wordsList $ \ wordsPtr -> - _make_snippet docPtr wordsPtr wwidth hwidth awidth + _make_snippet docPtr wordsPtr (fromIntegral wwidth) + (fromIntegral hwidth) + (fromIntegral awidth) >>= packMallocUTF8CString >>= return . parseSnippet where diff --git a/examples/HelloWorld.hs b/examples/HelloWorld.hs --- a/examples/HelloWorld.hs +++ b/examples/HelloWorld.hs @@ -1,6 +1,5 @@ {- -*- Coding: utf-8 -*- -} -import qualified System.IO.UTF8 as U import Network.URI import System.Directory import Text.HyperEstraier @@ -27,17 +26,17 @@ result <- searchDatabase db cond putStrLn (">> Found: " ++ show result) - U.putStrLn ">> Trying to search for \"hêllö\"..." + putStrLn ">> Trying to search for \"hêllö\"..." cond' <- newCondition - setPhrase cond "hêllö" - result' <- searchDatabase db cond + setPhrase cond' "hêllö" + result' <- searchDatabase db cond' putStrLn (">> Found: " ++ show result') if null result' then - U.putStrLn ">> Great, hêllö doesn't match to hello." + putStrLn ">> Great, hêllö doesn't match to hello." else - U.putStrLn (">> hêllö matches to hello... This seems to be indeed a desired behavior, " ++ - "but this may cause problems on languages where diacritical marks are " ++ - "significant to distinguish completely different words...") + putStrLn (">> hêllö matches to hello... This seems to be indeed a desired behavior, " ++ + "but this may cause problems on languages where diacritical marks are " ++ + "significant to distinguish completely different words...") removeDirectoryRecursive "casket"