List all pages

darcs-hash:20080315062049-62b54-38e0100d656ea99fb2019d4f22babffcd3a69094.gz

diff --git a/Rakka/Page.hs b/Rakka/Page.hs
index a9dbe4ff2967c9b83909b8d831fbfcfeba57fd50..114e2d09db163e1be1f6effa69c7736fad34107d 100644 (file)
--- a/Rakka/Page.hs
+++ b/Rakka/Page.hs
@@ -12,7 +12,6 @@ module Rakka.Page
     , pageUpdateInfo
     , pageRevision
 
     , pageUpdateInfo
     , pageRevision
 

-    , isSafeChar

     , encodePageName
     , decodePageName
 
     , encodePageName
     , decodePageName
 


@@ -133,14 +132,6 @@ encodePageName = escapeURIString isSafeChar . UTF8.encodeString . fixPageName
       fixPageName = (\ (x:xs) -> toUpper x : xs) . map (\ c -> if c == ' ' then '_' else c)
 
 
       fixPageName = (\ (x:xs) -> toUpper x : xs) . map (\ c -> if c == ' ' then '_' else c)
 
 

-isSafeChar :: Char -> Bool
-isSafeChar c
-    | c == '/'            = True
-    | isReserved c        = False
-    | c > ' ' && c <= '~' = True
-    | otherwise           = False
-
-

 -- URI unescape して UTF-8 から decode する。
 decodePageName :: FilePath -> PageName
 decodePageName = UTF8.decodeString . unEscapeString
 -- URI unescape して UTF-8 から decode する。
 decodePageName :: FilePath -> PageName
 decodePageName = UTF8.decodeString . unEscapeString

diff --git a/Rakka/Resource/Search.hs b/Rakka/Resource/Search.hs
index 6624e9e8baeafcd2f44c9a2d57c4c777be7216f2..6f72195b41c0ffb172c5ee499242381c1805da7f 100644 (file)
--- a/Rakka/Resource/Search.hs
+++ b/Rakka/Resource/Search.hs
@@ -70,12 +70,13 @@ handleSearch env
     = do params <- getQueryForm
 
          let query = UTF8.decodeString $ fromMaybe ""  $ lookup "q" params
     = do params <- getQueryForm
 
          let query = UTF8.decodeString $ fromMaybe ""  $ lookup "q" params

+             order = fmap UTF8.decodeString (lookup "order" params)

              from  = fromMaybe 0
                      $ fmap read $ lookup "from" params
              to    = fromMaybe (from + resultsPerSection)
                      $ fmap read $ lookup "to"   params
 
              from  = fromMaybe 0
                      $ fmap read $ lookup "from" params
              to    = fromMaybe (from + resultsPerSection)
                      $ fmap read $ lookup "to"   params
 

-         cond   <- liftIO $ mkCond query from to
+         cond   <- liftIO $ mkCond query order from to

          result <- searchPages (envStorage env) cond
 
          let to' = min (from + length (srPages result)) to
          result <- searchPages (envStorage env) cond
 
          let to' = min (from + length (srPages result)) to


@@ -85,6 +86,10 @@ handleSearch env
              -> do tree <- ( eelem "/"
                              += ( eelem "searchResult"
                                   += sattr "query" query
              -> do tree <- ( eelem "/"
                              += ( eelem "searchResult"
                                   += sattr "query" query

+                                  += ( case order of
+                                         Just o  -> sattr "order" o
+                                         Nothing -> none
+                                     )

                                   += sattr "from"  (show from)
                                   += sattr "to"    (show to')
                                   += sattr "total" (show $ srTotal result)
                                   += sattr "from"  (show from)
                                   += sattr "to"    (show to')
                                   += sattr "total" (show $ srTotal result)


@@ -96,12 +101,15 @@ handleSearch env
                            ) -< ()
                    returnA -< outputXmlPage' tree (searchResultToXHTML env)
     where
                            ) -< ()
                    returnA -< outputXmlPage' tree (searchResultToXHTML env)
     where

-      mkCond :: String -> Int -> Int -> IO Condition
-      mkCond query from to
+      mkCond :: String -> Maybe String -> Int -> Int -> IO Condition
+      mkCond query order from to

           = do cond <- newCondition
                setPhrase cond query
           = do cond <- newCondition
                setPhrase cond query

+               case order of
+                 Just o  -> setOrder cond o
+                 Nothing -> return ()

                setSkip   cond from
                setSkip   cond from

-               setMax    cond (to - from)
+               setMax    cond (to - from + 1)

                return cond
 
       mkPageElem :: (ArrowChoice a, ArrowXml a, ArrowIO a) => a HitPage XmlTree
                return cond
 
       mkPageElem :: (ArrowChoice a, ArrowXml a, ArrowIO a) => a HitPage XmlTree


@@ -208,6 +216,11 @@ searchResultToXHTML env
                                          getText
                                        )
                                        &&&
                                          getText
                                        )
                                        &&&

+                                       maybeA ( getXPathTreesInDoc "/searchResult/@order/text()"
+                                                >>>
+                                                getText
+                                              )
+                                       &&&

                                        ( getXPathTreesInDoc "/searchResult/@from/text()"
                                          >>>
                                          getText
                                        ( getXPathTreesInDoc "/searchResult/@from/text()"
                                          >>>
                                          getText


@@ -219,11 +232,11 @@ searchResultToXHTML env
                                          >>>
                                          getText
                                          >>>
                                          >>>
                                          getText
                                          >>>

-                                         arr ((+ 1) . (`div` resultsPerSection) . read)
+                                         arr ((+ 1) . (`div` resultsPerSection) . (\ x -> x - 1) . read)

                                        )
                                      )
                                      >>>
                                        )
                                      )
                                      >>>

-                                     ( ((> 1) . snd . snd)
+                                     ( ((> 1) . snd . snd . snd)

                                        `guardsP`
                                        formatPager baseURI
                                      )
                                        `guardsP`
                                        formatPager baseURI
                                      )


@@ -292,7 +305,7 @@ searchResultToXHTML env
                  )
             )
 
                  )
             )
 

-      formatPager :: (ArrowChoice a, ArrowXml a) => URI -> a (String, (Int, Int)) XmlTree
+      formatPager :: (ArrowChoice a, ArrowXml a) => URI -> a (String, (Maybe String, (Int, Int))) XmlTree

       formatPager baseURI
           = ( eelem "div"
               += sattr "class" "pager"
       formatPager baseURI
           = ( eelem "div"
               += sattr "class" "pager"


@@ -301,13 +314,15 @@ searchResultToXHTML env
                      &&&
                      arr (fst . snd)
                      &&&
                      &&&
                      arr (fst . snd)
                      &&&

-                     ( arr snd
+                     arr (fst . snd . snd)
+                     &&&
+                     ( arr (snd . snd)

                        >>>
                        mkSectionWindow
                      )
                    )
                    >>>
                        >>>
                        mkSectionWindow
                      )
                    )
                    >>>

-                   proc (query, (currentSection, section))
+                   proc (query, (order, (currentSection, section)))

                        -> if currentSection == section then
                               ( txt " "
                                 <+> 
                        -> if currentSection == section then
                               ( txt " "
                                 <+> 


@@ -323,8 +338,8 @@ searchResultToXHTML env
                                                  >>>
                                                  uriToText
                                                )
                                                  >>>
                                                  uriToText
                                                )

-                                += (arr (show . snd) >>> mkText)
-                              ) -< (query, section)
+                                += (arr (show . snd . snd) >>> mkText)
+                              ) -< (query, (order, section))

                  )
             )
 
                  )
             )
 


@@ -347,31 +362,25 @@ searchResultToXHTML env
                arrL id -< [begin .. end]
                        
 
                arrL id -< [begin .. end]
                        
 

-      mkSectionURI :: Arrow a => URI -> a (String, Int) URI
+      mkSectionURI :: Arrow a => URI -> a (String, (Maybe String, Int)) URI

       mkSectionURI baseURI
       mkSectionURI baseURI

-          = arr $ \ (query, section)
+          = arr $ \ (query, (order, section))

           -> baseURI {
           -> baseURI {

-               uriPath  = uriPath baseURI </> "search"
-             , uriQuery = '?' : mkQueryString [ ("q"   , query)
-                                              , ("from", show $ section * resultsPerSection)
-                                              , ("to"  , show $ (section + 1) * resultsPerSection - 1)
-                                              ]
+               uriPath  = uriPath baseURI </> "search.html"
+             , uriQuery = '?' : mkQueryString ( [ ("q"   , query)
+                                                , ("from", show $ section * resultsPerSection)
+                                                , ("to"  , show $ (section + 1) * resultsPerSection - 1)
+                                                ]
+                                                ++ 
+                                                case order of
+                                                  Just o  -> [("order", o)]
+                                                  Nothing -> []
+                                              )

              }
 
       uriToText :: ArrowXml a => a URI XmlTree
       uriToText = arr (\ uri -> uriToString id uri "") >>> mkText
 
              }
 
       uriToText :: ArrowXml a => a URI XmlTree
       uriToText = arr (\ uri -> uriToString id uri "") >>> mkText
 

-      mkQueryString :: [(String, String)] -> String
-      mkQueryString []            = ""
-      mkQueryString ((k, v) : xs) = encode k ++ "=" ++ encode v ++
-                                    if xs == [] then
-                                        ""
-                                    else
-                                        ';' : mkQueryString(xs)
-
-      encode :: String -> String
-      encode = escapeURIString isSafeChar . UTF8.encodeString
-

 
 readSubPage :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
                Environment
 
 readSubPage :: (ArrowXml a, ArrowChoice a, ArrowIO a) =>
                Environment

diff --git a/Rakka/Utils.hs b/Rakka/Utils.hs
index 693fdf2ebae8b695e7b1c30596c2e81d5bd09c40..15bc6f4043f5a87f149cd09a5147c4cb4cb5be7c 100644 (file)
--- a/Rakka/Utils.hs
+++ b/Rakka/Utils.hs
@@ -6,15 +6,19 @@ module Rakka.Utils
     , deleteIfEmpty
     , chomp
     , guessMIMEType
     , deleteIfEmpty
     , chomp
     , guessMIMEType

+    , isSafeChar
+    , mkQueryString

     )
     where
 
     )
     where
 

+import qualified Codec.Binary.UTF8.String as UTF8

 import           Control.Arrow
 import           Control.Arrow.ArrowList
 import qualified Data.ByteString.Lazy as Lazy (ByteString)
 import qualified Data.ByteString.Lazy.Char8 as L8 hiding (ByteString)
 import           Magic
 import           Network.HTTP.Lucu
 import           Control.Arrow
 import           Control.Arrow.ArrowList
 import qualified Data.ByteString.Lazy as Lazy (ByteString)
 import qualified Data.ByteString.Lazy.Char8 as L8 hiding (ByteString)
 import           Magic
 import           Network.HTTP.Lucu

+import           Network.URI

 import           System.IO.Unsafe
 
 
 import           System.IO.Unsafe
 
 


@@ -63,3 +67,23 @@ guessMIMEType = read . unsafePerformIO . magicString magic . L8.unpack
               $ do m <- magicOpen [MagicMime]
                    magicLoadDefault m
                    return m
               $ do m <- magicOpen [MagicMime]
                    magicLoadDefault m
                    return m

+
+
+isSafeChar :: Char -> Bool
+isSafeChar c
+    | c == '/'            = True
+    | isReserved c        = False
+    | c > ' ' && c <= '~' = True
+    | otherwise           = False
+
+
+mkQueryString :: [(String, String)] -> String
+mkQueryString []            = ""
+mkQueryString ((k, v) : xs) = encode k ++ "=" ++ encode v ++
+                              if xs == [] then
+                                  ""
+                              else
+                                  ';' : mkQueryString(xs)
+    where
+      encode :: String -> String
+      encode = escapeURIString isSafeChar . UTF8.encodeString
\ No newline at end of file

diff --git a/Rakka/Wiki/Interpreter/PageList.hs b/Rakka/Wiki/Interpreter/PageList.hs
index 8631c8b4bae98d3929b98bbe369ce69925ed429a..fd4d364ebde2ad6af3c7ae37f9bdfb72c935ad1d 100644 (file)
--- a/Rakka/Wiki/Interpreter/PageList.hs
+++ b/Rakka/Wiki/Interpreter/PageList.hs
@@ -7,15 +7,36 @@ import           Control.Monad
 import           Data.Maybe
 import           Data.Time
 import           Network.HTTP.Lucu.RFC1123DateTime
 import           Data.Maybe
 import           Data.Time
 import           Network.HTTP.Lucu.RFC1123DateTime

+import           Network.URI

 import           Rakka.Storage
 import           Rakka.Storage

+import           Rakka.SystemConfig

 import           Rakka.Utils
 import           Rakka.Wiki
 import           Rakka.Wiki.Interpreter
 import           Rakka.Utils
 import           Rakka.Wiki
 import           Rakka.Wiki.Interpreter

+import           System.FilePath

 import           Text.HyperEstraier
 
 
 interpreters :: [Interpreter]
 import           Text.HyperEstraier
 
 
 interpreters :: [Interpreter]

-interpreters = [ recentUpdatesInterp ]
+interpreters = [ recentUpdatesURLInterp
+               , recentUpdatesInterp
+               ]
+
+
+recentUpdatesURLInterp :: Interpreter
+recentUpdatesURLInterp
+    = InlineCommandInterpreter {
+        iciName = "recentUpdatesURL"
+      , iciInterpret
+          = \ ctx _ -> do BaseURI baseURI <- getSysConf (ctxSysConf ctx)
+                          let uri = baseURI {
+                                      uriPath  = uriPath baseURI </> "search.html"
+                                    , uriQuery = '?' : mkQueryString [ ("q"    , "[UVSET]")
+                                                                     , ("order", "@mdate NUMD")
+                                                                     ]
+                                    }
+                          return $ ExternalLink uri (Just "List all pages")
+      }

 
 
 -- <div class="recentUpdates">
 
 
 -- <div class="recentUpdates">

diff --git a/defaultPages/SideBar/Right.xml b/defaultPages/SideBar/Right.xml
index e2a00a2ae02d11967572758501492ec97e18090b..982e863537df12d792418fe81c56bbe506bdbcb6 100644 (file)
--- a/defaultPages/SideBar/Right.xml
+++ b/defaultPages/SideBar/Right.xml
@@ -12,6 +12,7 @@
 <inOtherLanguages />
 
 = Recent updates =
 <inOtherLanguages />
 
 = Recent updates =

+<recentUpdatesURL />

 <recentUpdates items="20" />
 
 ]]></textData>
 <recentUpdates items="20" />
 
 ]]></textData>