module Hoogle.Search.Results(
mergeDataBaseResults, mergeQueryResults
) where
import General.Base
import General.Util
import qualified Data.Map as Map
import Hoogle.Store.All
import Hoogle.Type.All
import Hoogle.Query.All
data Key k v = Key k v
instance Eq k => Eq (Key k v) where
Key k1 v1 == Key k2 v2 = k1 == k2
instance Ord k => Ord (Key k v) where
compare (Key k1 v1) (Key k2 v2) = compare k1 k2
toKey f v = Key (f v) v
fromKey (Key k v) = v
sortWith f = map fromKey . sort . map (toKey f)
mergeDataBaseResults :: [[Result]] -> [Result]
mergeDataBaseResults = map fromKey . fold [] merge . map (map $ toKey f)
where f r = (resultScore r, entryScore $ resultEntry r)
mergeQueryResults :: Query -> [[Result]] -> [Result]
mergeQueryResults q = filterResults q . joinResults
joinResults :: [[Result]] -> [Result]
joinResults [] = []
joinResults [x] = x
joinResults xs = sortWith resultScore $ Map.elems $
fold1 (Map.intersectionWith join) $
map asSet xs
where
asSet = Map.fromList . map (entryUnique . resultEntry &&& id)
join r1 r2 = r1{resultScore = mappend (resultScore r1) (resultScore r2)
,resultView = resultView r1 ++ resultView r2
,resultEntry = resultEntry r1 `entryJoin` resultEntry r2}
filterResults :: Query -> [Result] -> [Result]
filterResults q = f mods correctModule . f pkgs correctPackage
where
f [] act = id
f xs act = filter (act xs . resultEntry)
mods = [x | x@(Scope _ Module _) <- scope q]
pkgs = [x | Scope False Package x <- scope q]
correctPackage :: [String] -> Entry -> Bool
correctPackage pkgs x = null myPkgs || any (maybe True (`notElem` map (map toLower) pkgs)) myPkgs
where myPkgs = map (fmap (map toLower . entryName . fromOnce) . listToMaybe . snd) $ entryLocations x
correctModule :: [Scope] -> Entry -> Bool
correctModule mods x = null myMods || any (maybe True (f base mods)) myMods
where
myMods = map (fmap (map toLower . entryName . fromOnce) . listToMaybe . drop 1 . snd) $
entryLocations x
base = case head mods of Scope False Module _ -> True; _ -> False
f z [] y = z
f z (Scope b Module x:xs) y | doesMatch (map toLower x) y = f b xs y
f z (x:xs) y = f z xs y
doesMatch x y = x `isPrefixOf` y || ('.':x) `isInfixOf` y