X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FStorage%2FImpl.hs;h=c9c2de2858320725b75c30396e54e179bcc6b3da;hb=b4c0033f297c28d95ad9298b489126331224bc42;hp=c763a304f51f187b6625bcebcb6478ae6dfd0032;hpb=e751af5e3d23d7757f363bf4e86f9d732d90be7f;p=Rakka.git diff --git a/Rakka/Storage/Impl.hs b/Rakka/Storage/Impl.hs index c763a30..c9c2de2 100644 --- a/Rakka/Storage/Impl.hs +++ b/Rakka/Storage/Impl.hs @@ -17,6 +17,7 @@ import Data.Maybe import Data.Set (Set) import qualified Data.Set as S import Network.HTTP.Lucu +import Network.HTTP.Lucu.Utils import Network.URI import Prelude hiding (words) import Rakka.Attachment @@ -185,12 +186,24 @@ syncIndex' index revFile repos mkDraft mapM_ (updateIndex index repos mkDraft newRev) (S.toList pages) -searchIndex :: Database -> Condition -> IO [SearchResult] +searchIndex :: Database -> Condition -> IO SearchResult searchIndex index cond = do (ids, hint) <- searchDatabase' index cond - mapM (fromId $ map fst hint) ids + let (total, words) = parseHint hint + pages <- mapM (fromId words) ids + return SearchResult { + srTotal = total + , srPages = pages + } where - fromId :: [String] -> DocumentID -> IO SearchResult + parseHint :: [(String, Int)] -> (Int, [String]) + parseHint xs + = let total = fromJust $ lookup "" xs + words = filter (/= "") $ map fst xs + in + (total, words) + + fromId :: [String] -> DocumentID -> IO HitPage fromId words docId = do uri <- getDocURI index docId rev <- getDocAttr index docId "rakka:revision" @@ -198,14 +211,15 @@ searchIndex index cond snippet <- unsafeInterleaveIO $ do doc <- getDocument index docId [NoAttributes, NoKeywords] sn <- makeSnippet doc words 300 80 80 - return (map toFragment sn) - return SearchResult { - srPageName = decodePageName $ uriPath uri - , srPageRev = rev - , srSnippet = snippet + return (trim (== Boundary) $ map toFragment sn) + return HitPage { + hpPageName = decodePageName $ uriPath uri + , hpPageRev = rev + , hpSnippet = snippet } toFragment :: Either String (String, String) -> SnippetFragment + toFragment (Left "") = Boundary toFragment (Left t) = NormalText t toFragment (Right (w, _)) = HighlightedWord w