X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Rakka.git;a=blobdiff_plain;f=Rakka%2FStorage%2FImpl.hs;h=c763a304f51f187b6625bcebcb6478ae6dfd0032;hp=fed687f3c1266e992efc7973838cf8f41ced0ffb;hb=e751af5e3d23d7757f363bf4e86f9d732d90be7f;hpb=f7ff1639d50b827a8ce1e4dd3631ce300ecb3d19 diff --git a/Rakka/Storage/Impl.hs b/Rakka/Storage/Impl.hs index fed687f..c763a30 100644 --- a/Rakka/Storage/Impl.hs +++ b/Rakka/Storage/Impl.hs @@ -18,6 +18,7 @@ import Data.Set (Set) import qualified Data.Set as S import Network.HTTP.Lucu import Network.URI +import Prelude hiding (words) import Rakka.Attachment import Rakka.Page import Rakka.Storage.DefaultPage @@ -29,6 +30,7 @@ import Subversion.Repository import System.Directory import System.FilePath import System.IO +import System.IO.Unsafe import System.Log.Logger import Text.HyperEstraier hiding (WriteLock) @@ -183,16 +185,29 @@ syncIndex' index revFile repos mkDraft mapM_ (updateIndex index repos mkDraft newRev) (S.toList pages) -searchIndex :: Database -> Condition -> IO [(PageName, RevNum)] +searchIndex :: Database -> Condition -> IO [SearchResult] searchIndex index cond - = searchDatabase index cond >>= mapM fromId + = do (ids, hint) <- searchDatabase' index cond + mapM (fromId $ map fst hint) ids where - fromId :: DocumentID -> IO (PageName, RevNum) - fromId docId - = do uri <- getDocURI index docId - rev <- getDocAttr index docId "rakka:revision" - >>= return . read . fromJust - return (decodePageName $ uriPath uri, rev) + fromId :: [String] -> DocumentID -> IO SearchResult + fromId words docId + = do uri <- getDocURI index docId + rev <- getDocAttr index docId "rakka:revision" + >>= return . read . fromJust + 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 + } + + toFragment :: Either String (String, String) -> SnippetFragment + toFragment (Left t) = NormalText t + toFragment (Right (w, _)) = HighlightedWord w updateIndex :: Database