From b4c0033f297c28d95ad9298b489126331224bc42 Mon Sep 17 00:00:00 2001 From: pho Date: Tue, 5 Feb 2008 16:45:55 +0900 Subject: [PATCH] improvements related to page search darcs-hash:20080205074555-62b54-9ef4decb06a30917e91b83dec4a70f319c853898.gz --- Rakka/Resource/PageEntity.hs | 2 +- Rakka/Resource/Search.hs | 22 ++++++++++++++-------- Rakka/Storage.hs | 3 ++- Rakka/Storage/Impl.hs | 26 +++++++++++++++++++------- Rakka/Storage/Types.hs | 17 +++++++++++++---- Rakka/Wiki/Interpreter/PageList.hs | 8 ++++---- 6 files changed, 53 insertions(+), 25 deletions(-) diff --git a/Rakka/Resource/PageEntity.hs b/Rakka/Resource/PageEntity.hs index 1dd185f..09b5ecd 100644 --- a/Rakka/Resource/PageEntity.hs +++ b/Rakka/Resource/PageEntity.hs @@ -550,7 +550,7 @@ findFeeds sto addAttrCond cond "rakka:isFeed STREQ yes" setOrder cond "@uri STRA" result <- searchPages sto cond - return (map srPageName result) + return (map hpPageName $ srPages result) mkFeedURIStr :: URI -> PageName -> String diff --git a/Rakka/Resource/Search.hs b/Rakka/Resource/Search.hs index a7e7628..af90bfa 100644 --- a/Rakka/Resource/Search.hs +++ b/Rakka/Resource/Search.hs @@ -41,6 +41,10 @@ resSearch env } +defaultResultsPerPage :: Int +defaultResultsPerPage = 20 + + {- do tree <- ( eelem "/" @@ -73,8 +79,8 @@ handleSearch env += sattr "query" query += sattr "from" (show from) += sattr "to" (show to') - += sattr "total" (show $ length result) - += ( constL result + += sattr "total" (show $ srTotal result) + += ( constL (srPages result) >>> mkPageElem ) @@ -90,10 +96,10 @@ handleSearch env setMax cond (to - from) return cond - mkPageElem :: ArrowXml a => a SearchResult XmlTree + mkPageElem :: ArrowXml a => a HitPage XmlTree mkPageElem = ( eelem "page" - += attr "name" (arr srPageName >>> mkText) - += ( arrL srSnippet + += attr "name" (arr hpPageName >>> mkText) + += ( arrL hpSnippet >>> mkSnippetTree ) diff --git a/Rakka/Storage.hs b/Rakka/Storage.hs index 03b8c54..73bc734 100644 --- a/Rakka/Storage.hs +++ b/Rakka/Storage.hs @@ -3,6 +3,7 @@ module Rakka.Storage -- re-export from Rakka.Storage.Types , SearchResult(..) + , HitPage(..) , SnippetFragment(..) , mkStorage -- private @@ -92,7 +93,7 @@ getDirContentsA :: ArrowIO a => Storage -> a (PageName, Maybe RevNum) [PageName] getDirContentsA = arrIO2 . getDirContents -searchPages :: MonadIO m => Storage -> Condition -> m [SearchResult] +searchPages :: MonadIO m => Storage -> Condition -> m SearchResult searchPages sto cond = liftIO $ do var <- newEmptyTMVarIO diff --git a/Rakka/Storage/Impl.hs b/Rakka/Storage/Impl.hs index 200423f..c9c2de2 100644 --- a/Rakka/Storage/Impl.hs +++ b/Rakka/Storage/Impl.hs @@ -186,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" @@ -200,10 +212,10 @@ searchIndex index cond do doc <- getDocument index docId [NoAttributes, NoKeywords] sn <- makeSnippet doc words 300 80 80 return (trim (== Boundary) $ map toFragment sn) - return SearchResult { - srPageName = decodePageName $ uriPath uri - , srPageRev = rev - , srSnippet = snippet + return HitPage { + hpPageName = decodePageName $ uriPath uri + , hpPageRev = rev + , hpSnippet = snippet } toFragment :: Either String (String, String) -> SnippetFragment diff --git a/Rakka/Storage/Types.hs b/Rakka/Storage/Types.hs index c83e53e..28184a6 100644 --- a/Rakka/Storage/Types.hs +++ b/Rakka/Storage/Types.hs @@ -2,6 +2,7 @@ module Rakka.Storage.Types ( Storage(..) , IndexReq(..) , SearchResult(..) + , HitPage(..) , SnippetFragment(..) ) where @@ -23,14 +24,22 @@ data Storage data IndexReq = RebuildIndex | SyncIndex - | SearchIndex !Condition !(TMVar [SearchResult]) + | SearchIndex !Condition !(TMVar SearchResult) data SearchResult = SearchResult { - srPageName :: !PageName - , srPageRev :: !RevNum - , srSnippet :: [SnippetFragment] + srTotal :: !Int + , srPages :: ![HitPage] + } + deriving (Show, Eq) + + +data HitPage + = HitPage { + hpPageName :: !PageName + , hpPageRev :: !RevNum + , hpSnippet :: [SnippetFragment] } deriving (Show, Eq) diff --git a/Rakka/Wiki/Interpreter/PageList.hs b/Rakka/Wiki/Interpreter/PageList.hs index 6afae0f..cffd938 100644 --- a/Rakka/Wiki/Interpreter/PageList.hs +++ b/Rakka/Wiki/Interpreter/PageList.hs @@ -53,14 +53,14 @@ recentUpdatesInterp setMax cond items result <- searchPages sto cond - pages <- mapM (getPageBySR sto) result + pages <- mapM (getPageByHP sto) (srPages result) mkPageList showSummary pages } where - getPageBySR :: Storage -> SearchResult -> IO Page - getPageBySR sto sr - = getPage sto (srPageName sr) (Just (srPageRev sr)) >>= return . fromJust + getPageByHP :: Storage -> HitPage -> IO Page + getPageByHP sto hp + = getPage sto (hpPageName hp) (Just (hpPageRev hp)) >>= return . fromJust mkPageList :: Bool -> [Page] -> IO BlockElement mkPageList showSummary pages -- 2.40.0