HsHyperEstraier 0.3.1 → 0.3.2
raw patch · 8 files changed
+103/−126 lines, 8 filesdep ~base
Dependency ranges changed: base
Files
- Database/QDBM/Cabin/List.hsc +3/−3
- Database/QDBM/Cabin/Map.hsc +12/−16
- HsHyperEstraier.cabal +2/−2
- NEWS +5/−0
- Text/HyperEstraier/Condition.hsc +29/−34
- Text/HyperEstraier/Database.hsc +35/−39
- Text/HyperEstraier/Document.hsc +14/−17
- Text/HyperEstraier/Utils.hsc +3/−15
Database/QDBM/Cabin/List.hsc view
@@ -50,7 +50,7 @@ wrapList :: Ptr CBLIST -> IO List-wrapList listPtr = newForeignPtr _close listPtr >>= return . List+wrapList listPtr = fmap List (newForeignPtr _close listPtr) withListPtr :: List -> (Ptr CBLIST -> IO a) -> IO a@@ -71,7 +71,7 @@ length :: List -> IO Int length list = withListPtr list $ \ listPtr ->- _num listPtr >>= return . fromIntegral+ fmap fromIntegral (_num listPtr) (!!) :: List -> Int -> IO (Maybe Strict.ByteString)@@ -90,7 +90,7 @@ toList :: List -> IO [Strict.ByteString] toList list = do len <- length list- mapM (list !!) [0..len] >>= return . catMaybes+ fmap catMaybes (mapM (list !!) [0..len]) fromList :: [Strict.ByteString] -> IO List
Database/QDBM/Cabin/Map.hsc view
@@ -52,11 +52,11 @@ wrapMap :: Ptr CBMAP -> IO Map-wrapMap mapPtr = newForeignPtr _close mapPtr >>= return . Map+wrapMap = fmap Map . newForeignPtr _close unsafePeekMap :: Ptr CBMAP -> IO Map-unsafePeekMap mapPtr = newForeignPtr_ mapPtr >>= return . Map+unsafePeekMap = fmap Map . newForeignPtr_ withMapPtr :: Map -> (Ptr CBMAP -> IO a) -> IO a@@ -72,11 +72,10 @@ = withMapPtr m $ \ mapPtr -> C8.useAsCStringLen key $ \ (keyPtr , keyLen ) -> C8.useAsCStringLen value $ \ (valuePtr, valueLen) ->- _put mapPtr- keyPtr (fromIntegral keyLen )- valuePtr (fromIntegral valueLen)- (fromIntegral $ fromEnum overwrite)- >>= return . (/= 0)+ fmap (/= 0) (_put mapPtr+ keyPtr (fromIntegral keyLen )+ valuePtr (fromIntegral valueLen)+ (fromIntegral $ fromEnum overwrite)) get :: Map -> Strict.ByteString -> IO (Maybe Strict.ByteString)@@ -95,9 +94,7 @@ initIterator :: Map -> IO () initIterator m- = withMapPtr m $ \ mapPtr ->- _iterinit mapPtr-+ = withMapPtr m _iterinit iterateNext :: Map -> IO (Maybe (Strict.ByteString, Strict.ByteString)) iterateNext m@@ -110,16 +107,13 @@ else do keyLen <- peek keyLenPtr key <- C8.packCStringLen (keyPtr, fromIntegral keyLen)- -- QDBM のソースを見たら、keyPtr そのものの値からアドレ- -- スを計算してゐた…。良くそんな無茶をやるなあと思ふ。 valPtr <- _iterval keyPtr valLenPtr valLen <- peek valLenPtr value <- C8.packCStringLen (valPtr, fromIntegral valLen) return $ Just (key, value) ---- iterator の状態は Map 内部に格納されるので、thread-safe でない。だか--- ら list にするなら正格にしなければならない。+-- Internal state of the iterator is stored in the Map itself. That's+-- not thread-safe. So we can't iterate it lazily. toList :: Map -> IO [(Strict.ByteString, Strict.ByteString)] toList m = initIterator m >> loop where@@ -127,7 +121,9 @@ loop = do next <- iterateNext m case next of Nothing -> return []- Just pair -> do rest <- loop -- ここで unsafeInterleaveIO したいが出來ない。+ Just pair -> do -- We want to do unsafeInterleaveIO+ -- here, but we can't.+ rest <- loop return $ pair : rest
HsHyperEstraier.cabal view
@@ -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.1+Version: 0.3.2 License: PublicDomain License-File: COPYING Author: PHO <pho at cielonegro dot org>@@ -27,7 +27,7 @@ Library Build-Depends:- base >= 4, bytestring, network, utf8-string+ base >= 4 && < 5, bytestring, network, utf8-string PkgConfig-Depends: hyperestraier >= 1.4.9, qdbm >= 1.8.74 Exposed-Modules:
NEWS view
@@ -1,3 +1,8 @@+Changes from 0.3.1 to 0.3.2+---------------------------+* Fixed breakage on GHC 6.12.1++ Changes from 0.3 to 0.3.1 ------------------------- * Fixed incorrect dependency declaration in HsHyperEstraier.cabal. No
Text/HyperEstraier/Condition.hsc view
@@ -72,15 +72,15 @@ deriving (Eq, Show) marshalCondOption :: CondOption -> Int-marshalCondOption (Speed Slow ) = (#const ESTCONDSURE )-marshalCondOption (Speed Normal ) = (#const ESTCONDUSUAL )-marshalCondOption (Speed Fast ) = (#const ESTCONDFAST )-marshalCondOption (Speed EvenFaster ) = (#const ESTCONDAGITO )-marshalCondOption OmitTFIDF = (#const ESTCONDNOIDF )-marshalCondOption (Syntax Simplified ) = (#const ESTCONDSIMPLE)-marshalCondOption (Syntax Rough ) = (#const ESTCONDROUGH )-marshalCondOption (Syntax Union ) = (#const ESTCONDUNION )-marshalCondOption (Syntax Intersection) = (#const ESTCONDISECT )+marshalCondOption (Speed Slow ) = #const ESTCONDSURE+marshalCondOption (Speed Normal ) = #const ESTCONDUSUAL+marshalCondOption (Speed Fast ) = #const ESTCONDFAST+marshalCondOption (Speed EvenFaster ) = #const ESTCONDAGITO+marshalCondOption OmitTFIDF = #const ESTCONDNOIDF+marshalCondOption (Syntax Simplified ) = #const ESTCONDSIMPLE+marshalCondOption (Syntax Rough ) = #const ESTCONDROUGH+marshalCondOption (Syntax Union ) = #const ESTCONDUNION+marshalCondOption (Syntax Intersection) = #const ESTCONDISECT -- |'Eclipse' represents how to hide documents from the search -- result by their similarity.@@ -103,10 +103,10 @@ marshalEclipse :: Eclipse -> Double marshalEclipse (Threshold thr) = assertThreshold thr-marshalEclipse (ThresholdWithURL thr) = assertThreshold thr + (#const ESTECLSIMURL)-marshalEclipse SameServer = (#const ESTECLSERV)-marshalEclipse SameDirectory = (#const ESTECLDIR )-marshalEclipse SameFile = (#const ESTECLFILE)+marshalEclipse (ThresholdWithURL thr) = assertThreshold thr + #const ESTECLSIMURL+marshalEclipse SameServer = #const ESTECLSERV+marshalEclipse SameDirectory = #const ESTECLDIR+marshalEclipse SameFile = #const ESTECLFILE assertThreshold :: Double -> Double assertThreshold thr = assert (thr >= 0.0 && thr <= 1.0) thr@@ -150,7 +150,7 @@ wrapCond :: Ptr ESTCOND -> IO Condition-wrapCond condPtr = newForeignPtr _delete condPtr >>= return . Condition+wrapCond = fmap Condition . newForeignPtr _delete withCondPtr :: Condition -> (Ptr ESTCOND -> IO a) -> IO a@@ -167,8 +167,8 @@ setPhrase :: Condition -> String -> IO () setPhrase cond phrase = withCondPtr cond $ \ condPtr ->- withUTF8CString phrase $ \ phrasePtr ->- _set_phrase condPtr phrasePtr+ withUTF8CString phrase $+ _set_phrase condPtr -- |@'addAttrCond' cond expr@ appends an attribute search condition to -- @cond@. See the user's guide for explanation about the attribute@@ -176,8 +176,8 @@ addAttrCond :: Condition -> String -> IO () addAttrCond cond attr = withCondPtr cond $ \ condPtr ->- withUTF8CString attr $ \ attrPtr ->- _add_attr condPtr attrPtr+ withUTF8CString attr $+ _add_attr condPtr -- |@'setOrder' cond expr@ stores an ordering expression into -- @cond@. See the user's guide for explanation about the ordering@@ -186,51 +186,47 @@ setOrder :: Condition -> String -> IO () setOrder cond order = withCondPtr cond $ \ condPtr ->- withUTF8CString order $ \ orderPtr ->- _set_order condPtr orderPtr+ withUTF8CString order $+ _set_order condPtr -- |@'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 $ \ condPtr ->- _set_max condPtr n+ = withCondPtr cond $ flip _set_max n -- |@'setSkip' cond n@ specifies how many documents should be skipped -- from the beginning of result. setSkip :: Condition -> Int -> IO () setSkip cond n- = withCondPtr cond $ \ condPtr ->- _set_skip condPtr n+ = withCondPtr cond $ flip _set_skip n -- |@'setOptions' cond opts@ specifies options to the search -- condition. setOptions :: Condition -> [CondOption] -> IO () setOptions cond options- = withCondPtr cond $ \ condPtr ->- _set_options condPtr (marshalOpts marshalCondOption options)+ = withCondPtr cond $+ flip _set_options (marshalOpts marshalCondOption options) -- |@'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 $ \ condPtr ->- _set_auxiliary condPtr n+ = withCondPtr cond $ flip _set_auxiliary n -- |@'setEclipse' cond ecl@ specifies how to hide documents from the -- search result by their similarity. setEclipse :: Condition -> Eclipse -> IO () setEclipse cond ecl- = withCondPtr cond $ \ condPtr ->- _set_eclipse condPtr (marshalEclipse ecl)+ = withCondPtr cond $ flip _set_eclipse (marshalEclipse ecl) -- |@'setDistinct' cond attr@ specifies an attribute which must be -- unique to the search result. setDistinct :: Condition -> String -> IO () setDistinct cond attr = withCondPtr cond $ \ condPtr ->- withUTF8CString attr $ \ attrPtr ->- _set_distinct condPtr attrPtr+ withUTF8CString attr $+ _set_distinct condPtr -- |@'setMetaSearchMask' cond xs@ specifies that, in -- 'Text.HyperEstraier.Database.metaSearch', some databases must be@@ -249,8 +245,7 @@ -- setMetaSearchMask :: Condition -> [Int] -> IO () setMetaSearchMask cond xs- = withCondPtr cond $ \ condPtr ->- _set_max condPtr (calculateMask xs)+ = withCondPtr cond $ flip _set_max (calculateMask xs) where calculateMask :: [Int] -> Int calculateMask [] = 0
Text/HyperEstraier/Database.hsc view
@@ -200,8 +200,8 @@ marshalWriterOption (WriteLock mode) = marshalLockingMode mode marshalLockingMode :: LockingMode -> Int-marshalLockingMode NoLock = (#const ESTDBNOLCK)-marshalLockingMode NonblockingLock = (#const ESTDBLCKNB)+marshalLockingMode NoLock = #const ESTDBNOLCK+marshalLockingMode NonblockingLock = #const ESTDBLCKNB marshalCreateOption :: CreateOption -> Int marshalCreateOption (Analysis opt ) = marshalAnalysisOption opt@@ -209,20 +209,20 @@ marshalCreateOption (Score opts ) = marshalOpts marshalScoreOption opts marshalAnalysisOption :: AnalysisOption -> Int-marshalAnalysisOption PerfectNGram = (#const ESTDBPERFNG)-marshalAnalysisOption CharCategory = (#const ESTDBCHRCAT)+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)+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)+marshalScoreOption Nullified = #const ESTDBSCVOID+marshalScoreOption StoredAsInt = #const ESTDBSCINT+marshalScoreOption OnlyToBeStored = #const ESTDBSCASIS -- |'AttrIndexType' represents an index type for an attribute. data AttrIndexType@@ -238,9 +238,9 @@ marshalAttrIndexType :: AttrIndexType -> Int-marshalAttrIndexType SeqIndex = (#const ESTIDXATTRSEQ)-marshalAttrIndexType StrIndex = (#const ESTIDXATTRSTR)-marshalAttrIndexType NumIndex = (#const ESTIDXATTRNUM)+marshalAttrIndexType SeqIndex = #const ESTIDXATTRSEQ+marshalAttrIndexType StrIndex = #const ESTIDXATTRSTR+marshalAttrIndexType NumIndex = #const ESTIDXATTRNUM -- |'OptimizeOption' is an option for the 'optimizeDatabase' action. data OptimizeOption@@ -252,8 +252,8 @@ marshalOptimizeOption :: OptimizeOption -> Int-marshalOptimizeOption NoPurge = (#const ESTOPTNOPURGE)-marshalOptimizeOption NoDBOptimize = (#const ESTOPTNODBOPT)+marshalOptimizeOption NoPurge = #const ESTOPTNOPURGE+marshalOptimizeOption NoDBOptimize = #const ESTOPTNODBOPT -- |'RemoveOption' is an option for the 'mergeDatabase' action and the -- 'removeDocument' action.@@ -264,7 +264,7 @@ marshalRemoveOption :: RemoveOption -> Int-marshalRemoveOption CleaningRemove = (#const ESTODCLEAN)+marshalRemoveOption CleaningRemove = #const ESTODCLEAN -- |'PutOption' is an option for the 'putDocument' action. data PutOption@@ -277,8 +277,8 @@ marshalPutOption :: PutOption -> Int-marshalPutOption CleaningPut = (#const ESTPDCLEAN)-marshalPutOption WeightStatically = (#const ESTPDWEIGHT)+marshalPutOption CleaningPut = #const ESTPDCLEAN+marshalPutOption WeightStatically = #const ESTPDWEIGHT -- |'GetOption' is an option for the 'getDocument' action. data GetOption@@ -288,9 +288,9 @@ deriving (Eq, Show) marshalGetOption :: GetOption -> Int-marshalGetOption NoAttributes = (#const ESTGDNOATTR)-marshalGetOption NoText = (#const ESTGDNOTEXT)-marshalGetOption NoKeywords = (#const ESTGDNOKWD)+marshalGetOption NoAttributes = #const ESTGDNOATTR+marshalGetOption NoText = #const ESTGDNOTEXT+marshalGetOption NoKeywords = #const ESTGDNOKWD -- |@'Database'@ is an opaque object representing a HyperEstraier -- database.@@ -369,7 +369,7 @@ wrapDB :: Ptr ESTMTDB -> IO Database-wrapDB dbPtr = newIORef dbPtr >>= return . Database+wrapDB dbPtr = fmap Database (newIORef dbPtr) withDBPtr :: Database -> (Ptr ESTMTDB -> IO a) -> IO a@@ -408,9 +408,9 @@ alloca $ \ errPtr -> do dbPtr <- _open fpathPtr (marshalOpenMode opts) errPtr if dbPtr == nullPtr then- peek errPtr >>= return . Left . unmarshalError+ fmap (Left . unmarshalError) (peek errPtr) else- wrapDB dbPtr >>= return . Right+ fmap Right (wrapDB dbPtr) -- |@'closeDatabase' db@ closes the database @db@. If the @db@ has -- already been closed, this operation causes nothing.@@ -442,7 +442,7 @@ hasFatalError :: Database -> IO Bool hasFatalError db = withDBPtr db $ \ dbPtr ->- _fatal dbPtr >>= return . (/= 0)+ fmap (/= 0) (_fatal dbPtr) -- |@'addAttrIndex' db attr idxType@ creates an index of type -- @idxType@ for attribute @attr@ into the database @db@.@@ -536,12 +536,12 @@ if valuePtr == nullPtr then return Nothing else- packMallocUTF8CString valuePtr >>= return . Just+ fmap Just (packMallocUTF8CString valuePtr) -- |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+ = 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)@@ -563,23 +563,20 @@ -- |Get the number of documents in a database. getNumOfDocs :: Database -> IO Int getNumOfDocs db- = withDBPtr db $ \ dbPtr ->- _doc_num dbPtr+ = withDBPtr db _doc_num -- |Get the number of words in a database. getNumOfWords :: Database -> IO Int getNumOfWords db- = withDBPtr db $ \ dbPtr ->- _word_num dbPtr+ = withDBPtr db _word_num -- |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+ -- 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]@@ -670,8 +667,7 @@ = withDBPtr db $ \ dbPtr -> withDocPtr doc $ \ docPtr -> withCondPtr cond $ \ condPtr ->- _scan_doc dbPtr docPtr condPtr- >>= return . (/= 0)+ fmap (/= 0) (_scan_doc dbPtr docPtr condPtr) -- |Change the size of various caches of a database. Passing negative -- values leaves the old values unchanged.
Text/HyperEstraier/Document.hsc view
@@ -112,7 +112,7 @@ wrapDoc :: Ptr ESTDOC -> IO Document-wrapDoc docPtr = newForeignPtr _delete docPtr >>= return . Document+wrapDoc = fmap Document . newForeignPtr _delete withDocPtr :: Document -> (Ptr ESTDOC -> IO a) -> IO a@@ -138,29 +138,29 @@ setAttribute doc name value = withDocPtr doc $ \ docPtr -> withUTF8CString name $ \ namePtr ->- withUTF8CString' value $ \ valuePtr ->- _add_attr docPtr namePtr valuePtr+ withUTF8CString' value $+ _add_attr docPtr namePtr -- |Add a block of text to a document. addText :: Document -> String -> IO () addText doc text = withDocPtr doc $ \ docPtr ->- withUTF8CString text $ \ textPtr ->- _add_text docPtr textPtr+ withUTF8CString text $+ _add_text docPtr -- |Add a block of hidden text to a document. addHiddenText :: Document -> String -> IO () addHiddenText doc text = withDocPtr doc $ \ docPtr ->- withUTF8CString text $ \ textPtr ->- _add_hidden_text docPtr textPtr+ withUTF8CString text $+ _add_hidden_text docPtr -- |Set an URI of a document. This is a special case of -- 'setAttribute'. setURI :: Document -> Maybe URI -> IO () setURI doc uri = setAttribute doc "@uri" (fmap uri2str uri) where- uri2str u = uriToString id u ""+ uri2str = flip (uriToString id) "" -- |Set keywords of a document. setKeywords :: Document -- ^ The document.@@ -168,8 +168,8 @@ -> IO () setKeywords doc keywords = withDocPtr doc $ \ docPtr ->- withKeywordMapPtr $ \ mapPtr ->- _set_keywords docPtr mapPtr+ withKeywordMapPtr $+ _set_keywords docPtr where withKeywordMapPtr :: (Ptr CM.CBMAP -> IO a) -> IO a withKeywordMapPtr f = do m <- CM.fromList $ map encodeKeyword keywords@@ -180,14 +180,12 @@ -- |Set an alternative score of a document. setScore :: Document -> Maybe Int -> IO () setScore doc score- = withDocPtr doc $ \ docPtr ->- _set_score docPtr (fromMaybe (-1) score)+ = withDocPtr doc $ flip _set_score (fromMaybe (-1) score) -- |Get the ID of document. getId :: Document -> IO DocumentID getId doc- = withDocPtr doc $ \ docPtr ->- _id docPtr+ = withDocPtr doc _id -- |Get a list of all attribute names in a document. getAttrNames :: Document -> IO [String]@@ -207,7 +205,7 @@ if valuePtr == nullPtr then return Nothing else- peekUTF8CString valuePtr >>= return . Just+ fmap Just (peekUTF8CString valuePtr) -- |Get the text in a document. getText :: Document -> IO String@@ -218,7 +216,7 @@ -- |Get the URI of a document. getURI :: Document -> IO (Maybe URI)-getURI doc = getAttribute doc "@uri" >>= return . fmap parse+getURI doc = fmap (fmap parse) (getAttribute doc "@uri") where parse :: String -> URI parse = fromJust . parseURIReference@@ -230,7 +228,6 @@ _keywords docPtr >>= CM.unsafePeekMap >>= CM.toList- -- ここまで正格。次の行は遲延される。 >>= return . map decodeKeyword where decodeKeyword (word, score) = (decodeString $ C8.unpack word, read $ C8.unpack score)
Text/HyperEstraier/Utils.hsc view
@@ -36,20 +36,9 @@ peekUTF8CString :: CString -> IO String-peekUTF8CString cstr = peekCString cstr >>= return . decodeString+peekUTF8CString = fmap decodeString . peekCString --- (.) の型は (b -> c) -> (a -> b) -> a -> c である。(.) は同じ arity--- の函數を繋げる。map は二引數函數なので、それと繋げる方も二引數にしな--- ければならない。所で foldl (.|.) 0 の型は Bits a => [a] -> a で一引--- 數である。これを (foldl (.|.) 0 .) にすると、その型は Bits b => (a--- -> [b]) -> a -> b になり、單純に Bits a のリストを取ってゐた函數が--- 「何かの値を取って Bits b のリストを返す函數」と「その何かの値」を取--- る函數に變化する。それを (.) の左邊に置くと、((foldl (.|.) 0 .) .)--- の型は Bits c => (a -> b -> [c]) -> a -> b -> c になる。この函數に--- map を適用すると、map の型は (a -> b) -> [a] -> [b] なので、結果は--- Bits b => (a -> b) -> [a] -> b になる。------ point-free って難しいね。+ marshalOpts :: Bits b => (a -> b) -> [a] -> b marshalOpts = (foldl (.|.) 0 .) . map @@ -59,8 +48,7 @@ -> (Ptr (Ptr b) -> IO c) -> IO c withArrayOfPtrs withXPtr xs f- = withXPtrList xs [] $ \ xPtrs ->- withArray xPtrs f+ = withXPtrList xs [] $ flip withArray f where -- withXPtrList :: [a] -> [Ptr b] -> ([Ptr b] -> IO c) -> IO c withXPtrList [] acc g = g acc