improvements related to page search

darcs-hash:20080205074555-62b54-9ef4decb06a30917e91b83dec4a70f319c853898.gz

diff --git a/Rakka/Resource/PageEntity.hs b/Rakka/Resource/PageEntity.hs
index 1dd185f3b8d4e3269d401c412545c918897ed619..09b5ecd367caa2ab24569f595447070f98d45f7b 100644 (file)
--- 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 a7e7628918732f050a5759aa99e339ef261b001a..af90bfa3844395a6d70392767a07c7fe130c36c1 100644 (file)
--- a/Rakka/Resource/Search.hs
+++ b/Rakka/Resource/Search.hs
@@ -41,6 +41,10 @@ resSearch env
       }
 
 
+defaultResultsPerPage :: Int
+defaultResultsPerPage = 20
+
+
 {-
   <searchResult query="foo bar baz"
                 from="0"
@@ -59,13 +63,15 @@ handleSearch env
     = do params <- getQueryForm
 
          let query = UTF8.decodeString $ fromMaybe ""  $ lookup "q" params
-             from  = read $ fromMaybe "0"  $ lookup "from" params
-             to    = read $ fromMaybe "20" $ lookup "to"   params
+             from  = fromMaybe 0
+                     $ fmap read $ lookup "from" params
+             to    = fromMaybe defaultResultsPerPage
+                     $ fmap read $ lookup "to"   params
 
          cond   <- liftIO $ mkCond query from to
          result <- searchPages (envStorage env) cond
 
-         let to' = min (from + length result) to
+         let to' = min (from + length (srPages result)) to
 
          runIdempotentA $ proc ()
              -> 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 03b8c54134c3a3316e03bb18c57c145b3583d831..73bc73499b762fdcc3ed1b56f407562e5831c8c7 100644 (file)
--- 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 200423ffc644f94c02860bab754323b7896f64f4..c9c2de2858320725b75c30396e54e179bcc6b3da 100644 (file)
--- 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 c83e53e0cd3bf8663eba2883573eeda9f2775708..28184a676e574d54989cecc80af2301dbb95a5b2 100644 (file)
--- 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 6afae0fd8750ec9f989a4a0e29a1a7db5871562e..cffd93806f20c50b490dec6af1a9ac5596198a72 100644 (file)
--- 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