diff --git a/Holumbus-Searchengine.cabal b/Holumbus-Searchengine.cabal --- a/Holumbus-Searchengine.cabal +++ b/Holumbus-Searchengine.cabal @@ -1,8 +1,8 @@ name: Holumbus-Searchengine -version: 1.2.2 +version: 1.2.3 license: MIT license-file: LICENSE -author: Sebastian M. Gauck, Timo B. Huebel, Uwe Schmidt +author: Sebastian M. Gauck, Timo B. Kranz, Uwe Schmidt copyright: Copyright (c) 2007 - 2012 Uwe Schmidt, Sebastian M. Gauck and Timo B. Kranz maintainer: Timo B. Huebel , Uwe Schmidt stability: experimental @@ -12,6 +12,8 @@ description: The Holumbus-Searchengine library provides a document indexer and crawler to build indexes over document collections as well as a sophisticated query interface for these indexes. + . + Changes from 1.2.2: New HashedIndex with DocIds generated by a hash function cabal-version: >=1.6 build-type: Simple -- tested-with: ghc-7.0.3 @@ -19,6 +21,10 @@ extra-source-files: README +source-repository head + type: git + location: https://github.com/fortytools/holumbus + library build-depends: base >= 4 && < 5 , binary >= 0.5 && < 1 @@ -38,6 +44,7 @@ , parallel >= 3.1 && < 4 , parsec >= 2.1 && < 4 , process >= 1 && < 2 + , SHA >= 1.4 && < 2 , unix >= 2.3 && < 3 -- instance NFData (Map k v) has moved from deepseq into containers (dependency hell) @@ -85,6 +92,8 @@ Holumbus.Index.CompactIndex Holumbus.Index.CompactSmallDocuments Holumbus.Index.Compression + Holumbus.Index.HashedDocuments + Holumbus.Index.HashedIndex Holumbus.Index.Inverted.CompressedPrefixMem Holumbus.Index.Inverted.PrefixMem Holumbus.Query.Fuzzy diff --git a/src/Holumbus/Crawler/RobotTypes.hs b/src/Holumbus/Crawler/RobotTypes.hs --- a/src/Holumbus/Crawler/RobotTypes.hs +++ b/src/Holumbus/Crawler/RobotTypes.hs @@ -35,9 +35,7 @@ instance Binary RobotAction where put = B.put . fromEnum - get = do - b <- B.get - return (toEnum b) + get = B.get >>= return . toEnum instance NFData RobotAction where rnf x = x `seq` () diff --git a/src/Holumbus/Index/Common/DocId.hs b/src/Holumbus/Index/Common/DocId.hs --- a/src/Holumbus/Index/Common/DocId.hs +++ b/src/Holumbus/Index/Common/DocId.hs @@ -25,7 +25,7 @@ import Data.Binary ( Binary (..) ) import qualified Data.Binary as B -import Data.Word ( Word64 ) +import Data.Int ( Int64 ) import Text.XML.HXT.Core @@ -34,31 +34,45 @@ -- | The unique identifier of a document -- (created upon insertion into the document table). -newtype DocId = DocId { theDocId :: Word64 } - deriving (Eq, Ord, Enum) +newtype DocId = DocId { theDocId :: Int64 } + deriving (Eq, Ord, Enum, NFData) + instance Show DocId where show = show . theDocId - -instance NFData DocId where - rnf (DocId i) = rnf i + {-# INLINE show #-} instance Binary DocId where put = B.put . theDocId get = B.get >>= return . DocId + {-# INLINE put #-} + {-# INLINE get #-} incrDocId :: DocId -> DocId incrDocId = DocId . (1+) . theDocId +addDocId :: DocId -> DocId -> DocId +addDocId id1 id2 = DocId $ theDocId id1 + theDocId id2 + +subDocId :: DocId -> DocId -> DocId +subDocId id1 id2 = DocId $ theDocId id1 - theDocId id2 + nullDocId :: DocId nullDocId = DocId 0 firstDocId :: DocId firstDocId = DocId 1 -mkDocId :: Word64 -> DocId -mkDocId = DocId +mkDocId :: Integer -> DocId +mkDocId = DocId . fromIntegral xpDocId :: PU DocId xpDocId = xpWrap (DocId, theDocId) xpPrim + +{-# INLINE incrDocId #-} +{-# INLINE addDocId #-} +{-# INLINE subDocId #-} +{-# INLINE nullDocId #-} +{-# INLINE firstDocId #-} +{-# INLINE mkDocId #-} -- ------------------------------------------------------------ diff --git a/src/Holumbus/Index/Common/DocIdMap.hs b/src/Holumbus/Index/Common/DocIdMap.hs --- a/src/Holumbus/Index/Common/DocIdMap.hs +++ b/src/Holumbus/Index/Common/DocIdMap.hs @@ -32,6 +32,7 @@ , maxKeyDocIdMap , isIntervallDocIdMap , unionDocIdMap + , intersectionDocIdMap , differenceDocIdMap , unionWithDocIdMap , intersectionWithDocIdMap @@ -50,14 +51,14 @@ ) where -import Control.DeepSeq +import Control.DeepSeq import Data.Binary ( Binary (..) ) import qualified Data.Binary as B import qualified Data.EnumMap as IM import Data.Foldable -import Holumbus.Index.Common.DocId +import Holumbus.Index.Common.DocId -- ------------------------------------------------------------ @@ -108,12 +109,15 @@ isIntervallDocIdMap :: DocIdMap v -> Bool isIntervallDocIdMap m = nullDocIdMap m || - ( fromEnum (theDocId (minKeyDocIdMap m) - theDocId (maxKeyDocIdMap m)) - == sizeDocIdMap m + ( fromEnum (theDocId (maxKeyDocIdMap m)) - fromEnum (theDocId (minKeyDocIdMap m)) + == sizeDocIdMap m - 1 ) unionDocIdMap :: DocIdMap v -> DocIdMap v -> DocIdMap v unionDocIdMap = liftDIM2 $ IM.union + +intersectionDocIdMap :: DocIdMap v -> DocIdMap v -> DocIdMap v +intersectionDocIdMap = liftDIM2 $ IM.intersection differenceDocIdMap :: DocIdMap v -> DocIdMap v -> DocIdMap v differenceDocIdMap = liftDIM2 $ IM.difference diff --git a/src/Holumbus/Index/CompactDocuments.hs b/src/Holumbus/Index/CompactDocuments.hs --- a/src/Holumbus/Index/CompactDocuments.hs +++ b/src/Holumbus/Index/CompactDocuments.hs @@ -10,7 +10,6 @@ Maintainer : Uwe Schmidt (uwe@fh-wedel.de) Stability : experimental - Portability: MultiParamTypeClasses FlexibleInstances A more space efficient substitute for Holumbus.Index.Documents -} @@ -94,10 +93,10 @@ dt2s = editDocIds add1 dt2 ix2s = updateDocIds' add1 ix2 - add1 = mkDocId . (+ disp) . theDocId + add1 = addDocId disp max1 = maxKeyDocIdMap . toMap $ dt1 min2 = minKeyDocIdMap . toMap $ dt2 - disp = theDocId max1 + 1 - theDocId min2 + disp = incrDocId $ subDocId max1 min2 s1 = sizeDocs dt1 s2 = sizeDocs dt2 @@ -168,16 +167,21 @@ insertDoc ds d = maybe reallyInsert (\oldId -> (oldId, ds)) (lookupByURI ds (uri d)) where - reallyInsert = (newId, Documents newIdToDoc newDocToId newId) + d' = fromDocument d + reallyInsert = rnf d' `seq` -- force document compression + (newId, Documents newIdToDoc newDocToId newId) where - newIdToDoc = insertDocIdMap newId (fromDocument d) (idToDoc ds) - newDocToId = M.insert (uri d) newId (docToId ds) + newIdToDoc = insertDocIdMap newId d' (idToDoc ds) + newDocToId = M.insert (uri d) newId (docToId ds) newId = incrDocId (lastDocId ds) - updateDoc ds i d = ds - { idToDoc = insertDocIdMap i (fromDocument d) (idToDoc ds) + updateDoc ds i d = rnf d' `seq` -- force document compression + ds + { idToDoc = insertDocIdMap i d' (idToDoc ds) , docToId = M.insert (uri d) i (docToId (removeById ds i)) } + where + d' = fromDocument d removeById ds d = maybe ds reallyRemove (lookupById ds d) where @@ -283,10 +287,13 @@ -- | Create a document table containing a single document. singleton :: (Binary a) => Document a -> Documents a -singleton d = Documents - (singletonDocIdMap firstDocId (fromDocument d)) +singleton d = rnf d' `seq` + Documents + (singletonDocIdMap firstDocId d') (M.singleton (uri d) firstDocId) firstDocId + where + d' = fromDocument d -- | Simplify a document table by transforming the custom information into a string. diff --git a/src/Holumbus/Index/CompactIndex.hs b/src/Holumbus/Index/CompactIndex.hs --- a/src/Holumbus/Index/CompactIndex.hs +++ b/src/Holumbus/Index/CompactIndex.hs @@ -23,9 +23,6 @@ , emptyIndexerState , emptyDocuments - , emptySmallDocuments - , docTable2smallDocTable - , mergeAndWritePartialRes' , writeXml , writeBin diff --git a/src/Holumbus/Index/HashedDocuments.hs b/src/Holumbus/Index/HashedDocuments.hs new file mode 100644 --- /dev/null +++ b/src/Holumbus/Index/HashedDocuments.hs @@ -0,0 +1,246 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +-- ---------------------------------------------------------------------------- + +{- | + Module : Holumbus.Index.HashedDocuments + Copyright : Copyright (C) 2012 Uwe Schmidt + License : MIT + + Maintainer : Uwe Schmidt (uwe@fh-wedel.de) + Stability : experimental + + A more space efficient substitute for Holumbus.Index.Documents + and a more flexible implementation than Holumbus.Index.CompactDocuments. + + DocIds are computed by a hash function, so the inverse map from URIs to DocIds + is substituted by the hash function +-} + +-- ---------------------------------------------------------------------------- + +module Holumbus.Index.HashedDocuments + ( + -- * Documents type + Documents (..) + , CompressedDoc(..) + , DocMap + + -- * Construction + , emptyDocuments + , singleton + + -- * Conversion + , toDocument + , fromDocument + , fromDocMap + , toDocMap + ) +where + +import qualified Codec.Compression.BZip as BZ + +import Control.DeepSeq + +import Data.Binary ( Binary ) +import qualified Data.Binary as B + +import Data.ByteString.Lazy ( ByteString ) +import qualified Data.ByteString.Lazy as BS + +import Data.Digest.Pure.SHA + +import Holumbus.Index.Common + +import Text.XML.HXT.Core + +-- ---------------------------------------------------------------------------- + +-- | The table which is used to map a document to an artificial id and vice versa. + +type DocMap a + = DocIdMap (CompressedDoc a) + +newtype CompressedDoc a + = CDoc { unCDoc :: ByteString } + deriving (Eq, Show) + +newtype Documents a + = Documents { idToDoc :: DocMap a } -- ^ A mapping from a document id to + -- the document itself. + deriving (Eq, Show, NFData) + +-- ---------------------------------------------------------------------------- +-- | The hash function from URIs to DocIds + +docToId :: URI -> DocId +docToId = mkDocId . integerDigest . sha1 . B.encode + +-- ---------------------------------------------------------------------------- + +instance (Binary a, HolIndex i) => HolDocIndex Documents a i where + unionDocIndex dt1 ix1 dt2 ix2 + | s1 == 0 + = (dt2, ix2) + | s2 == 0 + = (dt1, ix1) + | s1 < s2 + = unionDocIndex dt2 ix2 dt1 ix1 + | otherwise + = (dt, ix) + where + dt = unionDocs' dt1 dt2 -- the unchecked version of union of doctables + ix = mergeIndexes ix1 ix2 + s1 = sizeDocs dt1 + s2 = sizeDocs dt2 + +-- ---------------------------------------------------------------------------- + +toDocument :: (Binary a) => CompressedDoc a -> Document a +toDocument = B.decode . BZ.decompress . unCDoc + +fromDocument :: (Binary a) => Document a -> CompressedDoc a +fromDocument = CDoc . BZ.compress . B.encode + +mapDocument :: (Binary a) => (Document a -> Document a) -> CompressedDoc a -> CompressedDoc a +mapDocument f = fromDocument . f . toDocument + +toDocMap :: (Binary a) => DocIdMap (Document a) -> DocMap a +toDocMap = mapDocIdMap fromDocument + +fromDocMap :: (Binary a) => DocMap a -> DocIdMap (Document a) +fromDocMap = mapDocIdMap toDocument + +-- ---------------------------------------------------------------------------- + +instance Binary a => HolDocuments Documents a where + sizeDocs + = sizeDocIdMap . idToDoc + + lookupById d i + = maybe (fail "") return + . fmap toDocument + . lookupDocIdMap i + . idToDoc + $ d + + lookupByURI d u + = maybe (fail "") (const $ return i) + . lookupDocIdMap i + . idToDoc + $ d + where + i = docToId u + + disjointDocs dt1 dt2 + = nullDocIdMap $ intersectionDocIdMap (idToDoc dt1) (idToDoc dt2) + + unionDocs dt1 dt2 + | disjointDocs dt1 dt2 + = unionDocs' dt1 dt2 + | otherwise + = error $ + "HashedDocuments.unionDocs: doctables are not disjoint" + + makeEmpty _ + = emptyDocuments + + insertDoc ds d + = maybe reallyInsert (const (newId, ds)) (lookupById ds newId) + where + newId + = docToId . uri $ d + d' = fromDocument d + reallyInsert + = rnf d' `seq` -- force document compression + (newId, Documents {idToDoc = insertDocIdMap newId d' $ idToDoc ds}) + + updateDoc ds i d + = rnf d' `seq` -- force document compression + Documents {idToDoc = insertDocIdMap i d' $ idToDoc ds} + where + d' = fromDocument d + + removeById ds d + = Documents {idToDoc = deleteDocIdMap d $ idToDoc ds} + + + updateDocuments f d + = Documents {idToDoc = mapDocIdMap (mapDocument f) (idToDoc d)} + + + filterDocuments p d + = Documents {idToDoc = filterDocIdMap (p . toDocument) (idToDoc d)} + + + fromMap itd' + = Documents {idToDoc = toDocMap itd'} + + toMap + = fromDocMap . idToDoc + +-- ---------------------------------------------------------------------------- + +instance (Binary a, XmlPickler a) => XmlPickler (Documents a) where + xpickle + = xpElem "documents" $ + xpWrap convertDoctable $ + xpWrap (fromListDocIdMap, toListDocIdMap) $ + xpList xpDocumentWithId + where + convertDoctable + = (Documents, idToDoc) + xpDocumentWithId + = xpElem "doc" $ + xpPair (xpAttr "id" xpDocId) xpickle + +-- ---------------------------------------------------------------------------- + +instance Binary a => Binary (Documents a) where + put = B.put . idToDoc + get = fmap Documents B.get + +-- ------------------------------------------------------------ + +instance (Binary a, XmlPickler a) => XmlPickler (CompressedDoc a) where + xpickle + = xpWrap (fromDocument , toDocument) $ + xpickle + +-- ---------------------------------------------------------------------------- + +instance Binary a => Binary (CompressedDoc a) where + put = B.put . unCDoc + get = B.get >>= return . CDoc + +-- ---------------------------------------------------------------------------- + +instance NFData (CompressedDoc a) where + rnf (CDoc s) + = BS.length s `seq` () + +-- ------------------------------------------------------------ + +-- | Create an empty table. + +emptyDocuments :: Documents a +emptyDocuments + = Documents emptyDocIdMap + +unionDocs' :: Documents a -> Documents a -> Documents a +unionDocs' dt1 dt2 + = Documents + { idToDoc = unionDocIdMap (idToDoc dt1) (idToDoc dt2) } + +-- | Create a document table containing a single document. + +singleton :: (Binary a) => Document a -> Documents a +singleton d + = rnf d' `seq` + Documents {idToDoc = singletonDocIdMap (docToId . uri $ d) d'} + where + d' = fromDocument d + +-- ------------------------------------------------------------ diff --git a/src/Holumbus/Index/HashedIndex.hs b/src/Holumbus/Index/HashedIndex.hs new file mode 100644 --- /dev/null +++ b/src/Holumbus/Index/HashedIndex.hs @@ -0,0 +1,234 @@ +{-# OPTIONS #-} + +-- ------------------------------------------------------------ + +module Holumbus.Index.HashedIndex + ( Document + , Documents + , SmallDocuments + + , Inverted + , emptyInverted + , removeDocIdsInverted + + , CompactInverted + , emptyCompactInverted + , inverted2compactInverted + + , HolumbusState + , HolumbusConfig + , emptyHolumbusState + , defragmentHolumbusState + + , emptyIndexerState + , emptyDocuments + + , mergeAndWritePartialRes' + , writeXml + , writeBin + , writeSearchBin + , writePartialIndex + ) +where + +import Control.Arrow +import Control.DeepSeq +import Control.Monad.Reader + +import Data.Binary + +import Holumbus.Crawler.Types +import Holumbus.Crawler.IndexerCore +import Holumbus.Crawler.Logger + +import Holumbus.Index.Common ( Document(..) + , Occurrences + , fromList + , toList + , unionDocs + , mergeIndexes + ) + +import Holumbus.Index.HashedDocuments ( Documents(..) + , emptyDocuments + ) + +import Text.XML.HXT.Core + +-- ------------------------------------------------------------ + +{- .1: direct use of prefix tree with simple-9 encoded occurences + + concerning efficiency this implementation is about the same as the 2. one, + space and time are minimally better, the reason could be less code working with classes + +import Holumbus.Index.Inverted.PrefixMem + +-- -} +-- ------------------------------------------------------------ + +{- .2: indirect use of prefix tree with simple-9 encoded occurences via InvertedCompressed + + minimal overhead compared to .1 + but less efficient in time (1598s / 1038s) and space + total mem use (2612MB / 2498MB) than .3 + +import qualified Holumbus.Index.Inverted.CompressedPrefixMem as PM + +type Inverted = PM.InvertedCompressed + +emptyInverted :: Inverted +emptyInverted = PM.emptyInvertedCompressed + +-- -} + +-- ------------------------------------------------------------ +-- {- remove "--" to coment out region + +{- .3: indirect prefix tree without compression of position sets + + best of these 3 implementations + + implementations with serializations become much more inefficient + in runtime and are not worth to be considered +-} + +import qualified Holumbus.Index.Inverted.CompressedPrefixMem as PM + +type Inverted = PM.Inverted0 + +emptyInverted :: Inverted +emptyInverted = PM.emptyInverted0 + +removeDocIdsInverted :: Occurrences -> Inverted -> Inverted +removeDocIdsInverted = PM.removeDocIdsInverted + +type CompactInverted = PM.InvertedOSerialized + +emptyCompactInverted :: CompactInverted +emptyCompactInverted = PM.emptyInvertedOSerialized + +inverted2compactInverted :: Inverted -> CompactInverted +inverted2compactInverted = fromList PM.emptyInvertedOSerialized . toList + +-- -} +-- ------------------------------------------------------------ + +type HolumbusState di = IndexerState Inverted Documents di +type HolumbusConfig di = IndexCrawlerConfig Inverted Documents di + +emptyHolumbusState :: HolumbusState di +emptyHolumbusState = emptyIndexerState emptyInverted emptyDocuments + +type SmallDocuments = Documents + +emptySmallDocuments :: SmallDocuments a +emptySmallDocuments = emptyDocuments + +-- ------------------------------------------------------------ + +defragmentHolumbusState :: (Binary di) => HolumbusState di -> HolumbusState di +defragmentHolumbusState = id + +-- ------------------------------------------------------------ + +mergeAndWritePartialRes' :: (MonadIO m, NFData i, Binary i) => + (SmallDocuments i -> SmallDocuments i) -> [String] -> String -> m () +mergeAndWritePartialRes' id' pxs out + = do notice $ ["merge hashed partial doctables from"] ++ pxs + mdocs <- mergeSmallDocs $ map (++ ".doc") pxs + notice $ ["write merged hashed doctable to", out ++ ".doc"] + liftIO $ encodeFile (out ++ ".doc") (id' mdocs) + notice $ ["merge hashed partial indexes from"] ++ pxs + mixs <- mergeCompactIxs $ map (++ ".idx") pxs + notice $ ["write merged hashed indexes to", out ++ ".idx"] + liftIO $ encodeFile (out ++ ".idx") mixs + notice $ ["merge partial hashed doctables and indexes done"] + +mergeSmallDocs :: (MonadIO m, NFData i, Binary i) => [String] -> m (SmallDocuments i) +mergeSmallDocs [] + = return emptySmallDocuments +mergeSmallDocs (x : xs) + = do docs <- mergeSmallDocs xs + notice ["merge hashed documents from file", x] + doc1 <- liftIO $ decodeFile x + rnf doc1 `seq` + (return $ unionDocs docs doc1) + +mergeCompactIxs :: (MonadIO m) => [String] -> m CompactInverted +mergeCompactIxs [] + = return emptyCompactInverted +mergeCompactIxs (x : xs) + = do ixs <- mergeCompactIxs xs + notice ["merge compact hashed index from file", x] + ix1 <- liftIO $ decodeFile x + rnf ix1 `seq` + (return $ mergeIndexes ix1 ixs) + +-- ------------------------------------------------------------ + +writeXml :: (MonadIO m, XmlPickler a) => FilePath -> a -> m () +writeXml xf v + | xmlOut + = do notice ["writing into XML file", xmlFile] + liftIO $ runX (constA v + >>> hxtSetTraceAndErrorLogger WARNING + >>> xpickleDocument xpickle [withIndent yes] xmlFile + ) + >> return () + notice ["writing XML finished"] + | otherwise + = notice ["no XML output"] + where + (xmlOut, xmlFile) + | null xf = (False, xf) + | xf == "-" = (True, "") + | otherwise = (True, xf) + +writeBin :: (MonadIO m, Binary a) => FilePath -> a -> m () +writeBin out v + | null out + = notice ["no binary output"] + | otherwise + = do notice ["writing into binary file", out] + liftIO $ encodeFile out v + notice ["writing binary data finished"] + +writeSearchBin :: (Binary c, MonadIO m) => FilePath -> HolumbusState c -> m () +writeSearchBin out state + | null out + = notice ["no search index written"] + | otherwise + = do notice ["writing hashed document table into binary file", docFile] + liftIO $ encodeFile docFile (ixs_documents state) + notice ["writing hashed compressed inverted index into binary file", idxFile] + liftIO $ encodeFile idxFile (inverted2compactInverted . ixs_index $ state) + notice ["writing hashed search index files finished"] + where + docFile = out ++ ".doc" + idxFile = out ++ ".idx" + +-- ------------------------------------------------------------ + +writePartialIndex :: (NFData c, XmlPickler c, Binary c) => + Bool -> FilePath -> CrawlerAction a (HolumbusState c) () +writePartialIndex xout fn + = modifyStateIO + theResultAccu + (writePartialIndex' xout fn) + +writePartialIndex' :: (NFData c, XmlPickler c, Binary c) => + Bool -> FilePath -> HolumbusState c -> IO (HolumbusState c) +writePartialIndex' xout out ixs + = do writeSearchBin out ixs + if xout + then writeXml (out ++ ".xml") ixs + else return () + return emptyHolumbusState + +-- ------------------------------------------------------------ + +notice :: MonadIO m => [String] -> m () +notice = noticeC "hashedIndex" + +-- ------------------------------------------------------------