{-# OPTIONS #-}
-- ------------------------------------------------------------
module Holumbus.Index.CompactIndex
( 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 Data.Function.Selector ( (.&&&.) )
import Holumbus.Crawler.Types
import Holumbus.Crawler.IndexerCore
import Holumbus.Crawler.Logger
import Holumbus.Index.Common ( Document(..)
, Occurrences
, defragmentDocIndex
, fromList
, toList
, unionDocs
, mergeIndexes
)
import Holumbus.Index.CompactDocuments
( Documents(..)
, emptyDocuments
)
import Holumbus.Index.CompactSmallDocuments
( SmallDocuments(..)
, docTable2smallDocTable
)
import qualified Holumbus.Index.CompactSmallDocuments
as CSD
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
-- -}
-- ------------------------------------------------------------
-- {-
{- .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
flushHolumbusState :: HolumbusState di -> HolumbusState di
flushHolumbusState hs = hs { ixs_index = emptyInverted
, ixs_documents = emptyDocuments
{ lastDocId = lastDocId . ixs_documents $ hs }
}
emptySmallDocuments :: SmallDocuments a
emptySmallDocuments = CSD.emptyDocuments
-- ------------------------------------------------------------
defragmentHolumbusState :: (Binary di) =>
HolumbusState di -> HolumbusState di
defragmentHolumbusState IndexerState
{ ixs_index = ix
, ixs_documents = dt
} = IndexerState
{ ixs_index = ix'
, ixs_documents = dt'
}
where
(dt', ix') = defragmentDocIndex dt ix
-- ------------------------------------------------------------
mergeAndWritePartialRes' :: (MonadIO m, NFData i, Binary i) =>
(SmallDocuments i -> SmallDocuments i) -> [String] -> String -> m ()
mergeAndWritePartialRes' id' pxs out
= do notice $ ["merge partial doctables from"] ++ pxs
mdocs <- mergeSmallDocs $ map (++ ".doc") pxs
notice $ ["write merged doctable to", out ++ ".doc"]
liftIO $ encodeFile (out ++ ".doc") (id' mdocs)
notice $ ["merge partial indexes from"] ++ pxs
mixs <- mergeCompactIxs $ map (++ ".idx") pxs
notice $ ["write merged indexes to", out ++ ".idx"]
liftIO $ encodeFile (out ++ ".idx") mixs
notice $ ["merge partial 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 small 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 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 small document table into binary file", docFile]
liftIO $ encodeFile docFile (docTable2smallDocTable . ixs_documents $ state)
notice ["writing compressed inverted index into binary file", idxFile]
liftIO $ encodeFile idxFile (inverted2compactInverted . ixs_index $ state)
notice ["writing 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 .&&&. theResultInit)
(\ (r, _i) -> do r' <- writePartialIndex' xout fn r
return (r', r')
)
{- the above code is a bit tricky:
when crawling is done in parallel, then initial result is used as a unit value,
when merging results. When a partial index is written out, the document id count
must not be set back to its initial value, to avoid renumbering when merging then
partial indexes. As a consequence, not only the result accu must be changed
but also the initial value.
When this is not done, the indexer runs fine when using the sequential merge,
but when running the parallel one, the index ids will overlap.
-}
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 ()
let ixs' = flushHolumbusState ixs
rnf ixs' `seq`
return ixs'
-- ------------------------------------------------------------
notice :: MonadIO m => [String] -> m ()
notice = noticeC "compactIndex"
-- ------------------------------------------------------------