diff --git a/Holumbus-Searchengine.cabal b/Holumbus-Searchengine.cabal --- a/Holumbus-Searchengine.cabal +++ b/Holumbus-Searchengine.cabal @@ -1,9 +1,9 @@ name: Holumbus-Searchengine -version: 1.2.0 +version: 1.2.1 license: MIT license-file: LICENSE author: Sebastian M. Gauck, Timo B. Huebel, Uwe Schmidt -copyright: Copyright (c) 2007 - 2012 Uwe Schmidt, Sebastian M. Gauck and Timo B. Huebel +copyright: Copyright (c) 2007 - 2012 Uwe Schmidt, Sebastian M. Gauck and Timo B. Kranz maintainer: Timo B. Huebel , Uwe Schmidt stability: experimental category: Text, Data @@ -24,8 +24,6 @@ , binary >= 0.5 && < 1 , bytestring >= 0.9 && < 1 , bzlib >= 0.4 && < 1 - , containers >= 0.2 && < 1 - , deepseq >= 1.1 && < 2 , directory >= 1 && < 2 , enummapset >= 0 && < 1 , filepath >= 1 && < 2 @@ -42,6 +40,14 @@ , process >= 1 && < 2 , unix >= 2.3 && < 3 + -- instance NFData (Map k v) has moved from deepseq into containers (dependency hell) + if impl(ghc < 7.4) + build-depends: containers >= 0.2 && < 0.4.2 + , deepseq >= 1.1 && < 1.2 + else + build-depends: containers >= 0.4.2 + , deepseq >= 1.2 + exposed-modules: Control.Concurrent.MapFold Control.Monad.ReaderStateIO @@ -94,4 +100,8 @@ ghc-options: -Wall -funbox-strict-fields -fwarn-tabs - extensions: + extensions: MultiParamTypeClasses + FlexibleContexts + FlexibleInstances + GeneralizedNewtypeDeriving + TypeSynonymInstances diff --git a/src/Control/Monad/ReaderStateIO.hs b/src/Control/Monad/ReaderStateIO.hs --- a/src/Control/Monad/ReaderStateIO.hs +++ b/src/Control/Monad/ReaderStateIO.hs @@ -1,4 +1,5 @@ -{-# OPTIONS -XMultiParamTypeClasses -XFunctionalDependencies -XFlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} -- ------------------------------------------------------------ diff --git a/src/Holumbus/Index/Common.hs b/src/Holumbus/Index/Common.hs --- a/src/Holumbus/Index/Common.hs +++ b/src/Holumbus/Index/Common.hs @@ -1,10 +1,16 @@ -{-# OPTIONS -XMultiParamTypeClasses -XFlexibleContexts -XFlexibleInstances -XGeneralizedNewtypeDeriving -XTypeSynonymInstances -fno-warn-orphans #-} +{-# OPTIONS -fno-warn-orphans #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeSynonymInstances #-} + -- ---------------------------------------------------------------------------- {- | Module : Holumbus.Index.Common - Copyright : Copyright (C) 2007 Sebastian M. Schlatt, Timo B. Huebel + Copyright : Copyright (C) 2007-2012 Sebastian M. Schlatt, Timo B. Huebel, Uwe Schmidt License : MIT Maintainer : Timo B. Huebel (tbh@holumbus.org) 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 @@ -1,4 +1,4 @@ -{-# OPTIONS -XGeneralizedNewtypeDeriving #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- ---------------------------------------------------------------------------- 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 @@ -1,10 +1,10 @@ -{-# OPTIONS -XTypeSynonymInstances -fno-warn-orphans #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- ---------------------------------------------------------------------------- {- | Module : Holumbus.Index.Common.DocIdMap - Copyright : Copyright (C) 2011 Sebastian M. Schlatt, Timo B. Huebel, Uwe Schmidt + Copyright : Copyright (C) 2012 Sebastian M. Schlatt, Timo B. Huebel, Uwe Schmidt License : MIT Maintainer : Timo B. Huebel (tbh@holumbus.org) @@ -18,56 +18,92 @@ -- ---------------------------------------------------------------------------- module Holumbus.Index.Common.DocIdMap + ( DocIdMap + , emptyDocIdMap + , singletonDocIdMap + , nullDocIdMap + , memberDocIdMap + , lookupDocIdMap + , insertDocIdMap + , deleteDocIdMap + , insertWithDocIdMap + , sizeDocIdMap + , minKeyDocIdMap + , maxKeyDocIdMap + , isIntervallDocIdMap + , unionDocIdMap + , differenceDocIdMap + , unionWithDocIdMap + , intersectionWithDocIdMap + , differenceWithDocIdMap + , unionsWithDocIdMap + , mapDocIdMap + , filterDocIdMap + , filterWithKeyDocIdMap + , mapWithKeyDocIdMap + , foldDocIdMap + , foldWithKeyDocIdMap + , fromListDocIdMap + , toListDocIdMap + , keysDocIdMap + , elemsDocIdMap + ) where import Control.DeepSeq -import Data.Binary ( Binary (..) ) -import qualified - Data.Binary as B -import qualified - Data.EnumMap as IM +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 Text.XML.HXT.Core - -- ------------------------------------------------------------ -type DocIdMap v = IM.EnumMap DocId v +newtype DocIdMap v = DIM { unDIM :: IM.EnumMap DocId v } + deriving (Eq, Show, Foldable) +liftDIM :: (IM.EnumMap DocId v -> IM.EnumMap DocId r) -> + (DocIdMap v -> DocIdMap r) +liftDIM f = DIM . f . unDIM + +liftDIM2 :: (IM.EnumMap DocId v -> IM.EnumMap DocId v -> IM.EnumMap DocId v) -> + (DocIdMap v -> DocIdMap v -> DocIdMap v) +liftDIM2 f x y = DIM $ f (unDIM x) (unDIM y) + emptyDocIdMap :: DocIdMap v -emptyDocIdMap = IM.empty +emptyDocIdMap = DIM $ IM.empty singletonDocIdMap :: DocId -> v -> DocIdMap v singletonDocIdMap d v = insertDocIdMap d v emptyDocIdMap nullDocIdMap :: DocIdMap v -> Bool -nullDocIdMap = IM.null +nullDocIdMap = IM.null . unDIM memberDocIdMap :: DocId -> DocIdMap v -> Bool -memberDocIdMap = IM.member +memberDocIdMap x = IM.member x . unDIM lookupDocIdMap :: DocId -> DocIdMap v -> Maybe v -lookupDocIdMap = IM.lookup +lookupDocIdMap x = IM.lookup x . unDIM insertDocIdMap :: DocId -> v -> DocIdMap v -> DocIdMap v -insertDocIdMap = IM.insert +insertDocIdMap x y = liftDIM $ IM.insert x y deleteDocIdMap :: DocId -> DocIdMap v -> DocIdMap v -deleteDocIdMap = IM.delete +deleteDocIdMap x = liftDIM $ IM.delete x insertWithDocIdMap :: (v -> v -> v) -> DocId -> v -> DocIdMap v -> DocIdMap v -insertWithDocIdMap = IM.insertWith +insertWithDocIdMap f x y = liftDIM $ IM.insertWith f x y sizeDocIdMap :: DocIdMap v -> Int -sizeDocIdMap = IM.size +sizeDocIdMap = IM.size . unDIM minKeyDocIdMap :: DocIdMap v -> DocId -minKeyDocIdMap = maybe nullDocId (fst . fst) . IM.minViewWithKey +minKeyDocIdMap = maybe nullDocId (fst . fst) . IM.minViewWithKey . unDIM maxKeyDocIdMap :: DocIdMap v -> DocId -maxKeyDocIdMap = maybe nullDocId (fst . fst) . IM.maxViewWithKey +maxKeyDocIdMap = maybe nullDocId (fst . fst) . IM.maxViewWithKey . unDIM isIntervallDocIdMap :: DocIdMap v -> Bool isIntervallDocIdMap m = nullDocIdMap m @@ -77,55 +113,92 @@ ) unionDocIdMap :: DocIdMap v -> DocIdMap v -> DocIdMap v -unionDocIdMap = IM.union +unionDocIdMap = liftDIM2 $ IM.union differenceDocIdMap :: DocIdMap v -> DocIdMap v -> DocIdMap v -differenceDocIdMap = IM.difference +differenceDocIdMap = liftDIM2 $ IM.difference unionWithDocIdMap :: (v -> v -> v) -> DocIdMap v -> DocIdMap v -> DocIdMap v -unionWithDocIdMap = IM.unionWith +unionWithDocIdMap f = liftDIM2 $ IM.unionWith f intersectionWithDocIdMap :: (v -> v -> v) -> DocIdMap v -> DocIdMap v -> DocIdMap v -intersectionWithDocIdMap = IM.intersectionWith +intersectionWithDocIdMap f = liftDIM2 $ IM.intersectionWith f +differenceWithDocIdMap :: (v -> v -> Maybe v) -> DocIdMap v -> DocIdMap v -> DocIdMap v +differenceWithDocIdMap f = liftDIM2 $ IM.differenceWith f + unionsWithDocIdMap :: (v -> v -> v) -> [DocIdMap v] -> DocIdMap v -unionsWithDocIdMap = IM.unionsWith +unionsWithDocIdMap f = DIM . IM.unionsWith f . map unDIM mapDocIdMap :: (v -> r) -> DocIdMap v -> DocIdMap r -mapDocIdMap = IM.map +mapDocIdMap f = liftDIM $ IM.map f filterDocIdMap :: (v -> Bool) -> DocIdMap v -> DocIdMap v -filterDocIdMap = IM.filter +filterDocIdMap p = liftDIM $ IM.filter p filterWithKeyDocIdMap :: (DocId -> v -> Bool) -> DocIdMap v -> DocIdMap v -filterWithKeyDocIdMap = IM.filterWithKey +filterWithKeyDocIdMap p = liftDIM $ IM.filterWithKey p mapWithKeyDocIdMap :: (DocId -> v -> r) -> DocIdMap v -> DocIdMap r -mapWithKeyDocIdMap = IM.mapWithKey +mapWithKeyDocIdMap f = liftDIM $ IM.mapWithKey f foldDocIdMap :: (v -> b -> b) -> b -> DocIdMap v -> b -foldDocIdMap = IM.fold +foldDocIdMap f u = IM.fold f u . unDIM foldWithKeyDocIdMap :: (DocId -> v -> b -> b) -> b -> DocIdMap v -> b -foldWithKeyDocIdMap = IM.foldWithKey +foldWithKeyDocIdMap f u = IM.foldWithKey f u . unDIM fromListDocIdMap :: [(DocId, v)] -> DocIdMap v -fromListDocIdMap = IM.fromList +fromListDocIdMap = DIM . IM.fromList toListDocIdMap :: DocIdMap v -> [(DocId, v)] -toListDocIdMap = IM.toList +toListDocIdMap = IM.toList . unDIM keysDocIdMap :: DocIdMap v -> [DocId] -keysDocIdMap = IM.keys +keysDocIdMap = IM.keys . unDIM elemsDocIdMap :: DocIdMap v -> [v] -elemsDocIdMap = IM.elems +elemsDocIdMap = IM.elems . unDIM instance NFData v => NFData (DocIdMap v) where - rnf m = rnf (IM.toList m) + rnf = rnf . toListDocIdMap instance Binary v => Binary (DocIdMap v) where - put = B.put . IM.toList - get = B.get >>= return . IM.fromList + put = B.put . toListDocIdMap + get = B.get >>= return . fromListDocIdMap + + +-- ------------------------------------------------------------ + +{-# INLINE liftDIM #-} +{-# INLINE liftDIM2 #-} +{-# INLINE emptyDocIdMap #-} +{-# INLINE singletonDocIdMap #-} +{-# INLINE nullDocIdMap #-} +{-# INLINE memberDocIdMap #-} +{-# INLINE lookupDocIdMap #-} +{-# INLINE insertDocIdMap #-} +{-# INLINE deleteDocIdMap #-} +{-# INLINE insertWithDocIdMap #-} +{-# INLINE sizeDocIdMap #-} +{-# INLINE minKeyDocIdMap #-} +{-# INLINE maxKeyDocIdMap #-} +{-# INLINE isIntervallDocIdMap #-} +{-# INLINE unionDocIdMap #-} +{-# INLINE differenceDocIdMap #-} +{-# INLINE unionWithDocIdMap #-} +{-# INLINE intersectionWithDocIdMap #-} +{-# INLINE differenceWithDocIdMap #-} +{-# INLINE unionsWithDocIdMap #-} +{-# INLINE mapDocIdMap #-} +{-# INLINE filterDocIdMap #-} +{-# INLINE filterWithKeyDocIdMap #-} +{-# INLINE mapWithKeyDocIdMap #-} +{-# INLINE foldDocIdMap #-} +{-# INLINE foldWithKeyDocIdMap #-} +{-# INLINE fromListDocIdMap #-} +{-# INLINE toListDocIdMap #-} +{-# INLINE keysDocIdMap #-} +{-# INLINE elemsDocIdMap #-} -- ------------------------------------------------------------ diff --git a/src/Holumbus/Index/Common/Document.hs b/src/Holumbus/Index/Common/Document.hs --- a/src/Holumbus/Index/Common/Document.hs +++ b/src/Holumbus/Index/Common/Document.hs @@ -24,8 +24,6 @@ import Control.DeepSeq import Data.Binary ( Binary (..) ) -import qualified - Data.Binary as B import Holumbus.Index.Common.BasicTypes diff --git a/src/Holumbus/Index/Common/Occurences.hs b/src/Holumbus/Index/Common/Occurences.hs --- a/src/Holumbus/Index/Common/Occurences.hs +++ b/src/Holumbus/Index/Common/Occurences.hs @@ -26,7 +26,6 @@ import qualified Data.Binary as B -import qualified Data.EnumMap as IM import qualified Data.EnumSet as IS import Holumbus.Index.Common.BasicTypes @@ -44,39 +43,40 @@ -- | Create an empty set of positions. emptyOccurrences :: Occurrences -emptyOccurrences = IM.empty +emptyOccurrences = emptyDocIdMap -- | Create an empty set of positions. singletonOccurrence :: DocId -> Position -> Occurrences -singletonOccurrence d p = insertOccurrence d p IM.empty +singletonOccurrence d p = insertOccurrence d p emptyDocIdMap -- | Test on empty set of positions. nullOccurrences :: Occurrences -> Bool -nullOccurrences = IM.null +nullOccurrences = nullDocIdMap -- | Determine the number of positions in a set of occurrences. sizeOccurrences :: Occurrences -> Int -sizeOccurrences = IM.fold ((+) . IS.size) 0 +sizeOccurrences = foldDocIdMap ((+) . IS.size) 0 insertOccurrence :: DocId -> Position -> Occurrences -> Occurrences -insertOccurrence d p = IM.insertWith IS.union d (singletonPos p) +insertOccurrence d p = insertWithDocIdMap IS.union d (singletonPos p) deleteOccurrence :: DocId -> Position -> Occurrences -> Occurrences -deleteOccurrence d p = substractOccurrences (IM.singleton d (singletonPos p)) +deleteOccurrence d p = substractOccurrences (singletonDocIdMap d (singletonPos p)) updateOccurrences :: (DocId -> DocId) -> Occurrences -> Occurrences -updateOccurrences f = IM.foldWithKey (\ d ps res -> IM.insertWith IS.union (f d) ps res) emptyOccurrences +updateOccurrences f = foldWithKeyDocIdMap + (\ d ps res -> insertWithDocIdMap IS.union (f d) ps res) emptyOccurrences -- | Merge two occurrences. mergeOccurrences :: Occurrences -> Occurrences -> Occurrences -mergeOccurrences = IM.unionWith IS.union +mergeOccurrences = unionWithDocIdMap IS.union diffOccurrences :: Occurrences -> Occurrences -> Occurrences -diffOccurrences = IM.difference +diffOccurrences = differenceDocIdMap -- | Substract occurrences from some other occurrences. substractOccurrences :: Occurrences -> Occurrences -> Occurrences -substractOccurrences = IM.differenceWith substractPositions +substractOccurrences = differenceWithDocIdMap substractPositions where substractPositions p1 p2 = if IS.null diffPos @@ -88,7 +88,7 @@ -- | The XML pickler for the occurrences of a word. xpOccurrences :: PU Occurrences -xpOccurrences = xpWrap (IM.fromList, IM.toList) +xpOccurrences = xpWrap (fromListDocIdMap, toListDocIdMap) (xpList xpOccurrence) where xpOccurrence = xpElem "doc" $ diff --git a/src/Holumbus/Index/Common/RawResult.hs b/src/Holumbus/Index/Common/RawResult.hs --- a/src/Holumbus/Index/Common/RawResult.hs +++ b/src/Holumbus/Index/Common/RawResult.hs @@ -1,4 +1,4 @@ -{-# OPTIONS #-} {-XMultiParamTypeClasses -XFlexibleContexts -XFlexibleInstances -XGeneralizedNewtypeDeriving -XTypeSynonymInstances -fno-warn-orphans #-} +{-# OPTIONS #-} -- ---------------------------------------------------------------------------- @@ -20,8 +20,6 @@ module Holumbus.Index.Common.RawResult where -import qualified Data.EnumMap as IM - import Data.Map (Map) import qualified Data.Map as M @@ -46,7 +44,7 @@ resultByDocument :: Context -> RawResult -> DocIdMap (Map Context (Map Word Positions)) resultByDocument c os = mapDocIdMap transform $ - IM.unionsWith (flip $ (:) . head) (map insertWords os) + unionsWithDocIdMap (flip $ (:) . head) (map insertWords os) where insertWords (w, o) = mapDocIdMap (\p -> [(w, p)]) o transform w = M.singleton c (M.fromList w) 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 @@ -1,4 +1,5 @@ -{-# OPTIONS -XFlexibleInstances -XMultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} -- ---------------------------------------------------------------------------- diff --git a/src/Holumbus/Index/CompactSmallDocuments.hs b/src/Holumbus/Index/CompactSmallDocuments.hs --- a/src/Holumbus/Index/CompactSmallDocuments.hs +++ b/src/Holumbus/Index/CompactSmallDocuments.hs @@ -1,4 +1,5 @@ -{-# OPTIONS -XFlexibleInstances -XMultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} -- ---------------------------------------------------------------------------- diff --git a/src/Holumbus/Index/Inverted/CompressedPrefixMem.hs b/src/Holumbus/Index/Inverted/CompressedPrefixMem.hs --- a/src/Holumbus/Index/Inverted/CompressedPrefixMem.hs +++ b/src/Holumbus/Index/Inverted/CompressedPrefixMem.hs @@ -1,3 +1,5 @@ +{-# OPTIONS #-} + module Holumbus.Index.Inverted.CompressedPrefixMem ( Inverted(..) , Parts diff --git a/src/Holumbus/Index/Inverted/PrefixMem.hs b/src/Holumbus/Index/Inverted/PrefixMem.hs --- a/src/Holumbus/Index/Inverted/PrefixMem.hs +++ b/src/Holumbus/Index/Inverted/PrefixMem.hs @@ -1,3 +1,5 @@ +{-# OPTIONS #-} + -- ---------------------------------------------------------------------------- {- | @@ -19,8 +21,6 @@ -} -- ---------------------------------------------------------------------------- - -{-# OPTIONS -XTypeSynonymInstances -XFlexibleInstances -XMultiParamTypeClasses #-} module Holumbus.Index.Inverted.PrefixMem (