preparation for feed generation

darcs-hash:20080123061759-62b54-4415d6ee76fd2eaad25de840bef6087028b5c497.gz

diff --git a/Rakka.cabal b/Rakka.cabal
index 41ea3678a31750bbf4bfdd7febc7463213836bb2..fa0bbe4eac2fadf8f556ea2c38366af09ee196aa 100644 (file)
--- a/Rakka.cabal
+++ b/Rakka.cabal
@@ -13,6 +13,7 @@ Tested-With:   GHC == 6.6.1
 Cabal-Version: >= 1.2
 
 Data-Files:
 Cabal-Version: >= 1.2
 
 Data-Files:

+    defaultPages/Feed.xml

     defaultpages/Help/SampleImage/Large.xml
     defaultpages/Help/SampleImage/Small.xml
     defaultPages/Help/Syntax.xml
     defaultpages/Help/SampleImage/Large.xml
     defaultpages/Help/SampleImage/Small.xml
     defaultPages/Help/Syntax.xml

diff --git a/Rakka/Page.hs b/Rakka/Page.hs
index 2785a201df626f216f27d309b88a3d46115902b3..62606b35af111daa344d37d738dfabd4aa273172 100644 (file)
--- a/Rakka/Page.hs
+++ b/Rakka/Page.hs
@@ -240,6 +240,7 @@ xmlizePage
                   += ( eelem "page"
                        += sattr "name"     (redirName page)
                        += sattr "redirect" (redirDest page)
                   += ( eelem "page"
                        += sattr "name"     (redirName page)
                        += sattr "redirect" (redirDest page)

+                       += sattr "isLocked" (yesOrNo $ redirIsLocked page)

                        += sattr "revision" (show $ redirRevision page)
                        += sattr "lastModified" (formatW3CDateTime lastMod)
                      )) -<< ()
                        += sattr "revision" (show $ redirRevision page)
                        += sattr "lastModified" (formatW3CDateTime lastMod)
                      )) -<< ()


@@ -344,7 +345,7 @@ parseEntity
           let (isBinary, content)
                   = case (textData, binaryData) of
                       (Just text, Nothing    ) -> (False, L.pack $ UTF8.encode text )
           let (isBinary, content)
                   = case (textData, binaryData) of
                       (Just text, Nothing    ) -> (False, L.pack $ UTF8.encode text )

-                      (Nothing  , Just binary) -> (True , L.pack $ fromJust $ B64.decode binary)
+                      (Nothing  , Just binary) -> (True , L.pack $ fromJust $ B64.decode $ dropWhitespace binary)

                       _                        -> error "one of textData or binaryData is required"
               mimeType
                   =  if isBinary then
                       _                        -> error "one of textData or binaryData is required"
               mimeType
                   =  if isBinary then


@@ -370,6 +371,14 @@ parseEntity
                       , entityContent    = content
                       , entityUpdateInfo = updateInfo
                       }
                       , entityContent    = content
                       , entityUpdateInfo = updateInfo
                       }

+    where
+      dropWhitespace :: String -> String
+      dropWhitespace [] = []
+      dropWhitespace (x:xs)
+          | x == ' ' || x == '\t' || x == '\n'
+              = dropWhitespace xs
+          | otherwise
+              = x : dropWhitespace xs

 
 
 parseUpdateInfo :: (ArrowXml a, ArrowChoice a) => a XmlTree UpdateInfo
 
 
 parseUpdateInfo :: (ArrowXml a, ArrowChoice a) => a XmlTree UpdateInfo

diff --git a/Rakka/Storage/Impl.hs b/Rakka/Storage/Impl.hs
index 1908b48165f380c1fd29b56e8772e9945ad2c7d7..3b48f0c10150c50c5550664cd5d9c47df81669ed 100644 (file)
--- a/Rakka/Storage/Impl.hs
+++ b/Rakka/Storage/Impl.hs
@@ -131,6 +131,7 @@ openIndex indexDir revFile
                               $ removeFile revFile
 
                      Right index <- openDatabase indexDir (Writer [Create []])
                               $ removeFile revFile
 
                      Right index <- openDatabase indexDir (Writer [Create []])

+                     addAttrIndex index "@type"          StrIndex

                      addAttrIndex index "@uri"           SeqIndex
                      addAttrIndex index "rakka:revision" SeqIndex
                      noticeM logger ("Created an H.E. index on " ++ indexDir)
                      addAttrIndex index "@uri"           SeqIndex
                      addAttrIndex index "rakka:revision" SeqIndex
                      noticeM logger ("Created an H.E. index on " ++ indexDir)

diff --git a/Rakka/Wiki/Interpreter/PageList.hs b/Rakka/Wiki/Interpreter/PageList.hs
index 2815bda638878a098715b57dd82d11988b445aa4..1ad6728c3ba370649cb961b8deeb8e452727ab2a 100644 (file)
--- a/Rakka/Wiki/Interpreter/PageList.hs
+++ b/Rakka/Wiki/Interpreter/PageList.hs
@@ -3,11 +3,13 @@ module Rakka.Wiki.Interpreter.PageList
     )
     where
 
     )
     where
 

+import           Control.Monad

 import           Data.Maybe
 import           Data.Time
 import           Network.HTTP.Lucu.RFC1123DateTime
 import           Rakka.Page
 import           Rakka.Storage
 import           Data.Maybe
 import           Data.Time
 import           Network.HTTP.Lucu.RFC1123DateTime
 import           Rakka.Page
 import           Rakka.Storage

+import           Rakka.Utils

 import           Rakka.Wiki
 import           Rakka.Wiki.Interpreter
 import           Text.HyperEstraier
 import           Rakka.Wiki
 import           Rakka.Wiki.Interpreter
 import           Text.HyperEstraier


@@ -35,12 +37,18 @@ recentUpdatesInterp
         bciName      = "recentUpdates"
       , bciInterpret
           = \ ctx (BlockCommand _ args _)
         bciName      = "recentUpdates"
       , bciInterpret
           = \ ctx (BlockCommand _ args _)

-          -> do let items = fromMaybe 10 $ fmap read $ lookup "items" args
-                    sto   = ctxStorage ctx
+          -> do let items          = fromMaybe 10   $ fmap read         $ lookup "items" args
+                    showSummary    = fromMaybe True $ fmap parseYesOrNo $ lookup "showSummary" args
+                    onlyEntity     = fromMaybe True $ fmap parseYesOrNo $ lookup "onlyEntity" args
+                    onlySummarized = fromMaybe True $ fmap parseYesOrNo $ lookup "onlySummarized" args
+                    sto            = ctxStorage ctx

                 
                 cond <- newCondition
                 setPhrase   cond "[UVSET]"
                 
                 cond <- newCondition
                 setPhrase   cond "[UVSET]"

-                addAttrCond cond "rakka:summary STRNE" -- summary が空でない
+                when onlyEntity
+                    $ addAttrCond cond "@type STRNE application/x-rakka-redirection"
+                when onlySummarized
+                    $ addAttrCond cond "rakka:summary STRNE" -- summary が空でない

                 setOrder    cond "@mdate NUMD"
                 setMax      cond items
 
                 setOrder    cond "@mdate NUMD"
                 setMax      cond items
 


@@ -49,17 +57,17 @@ recentUpdatesInterp
                                      -> getPage sto name (Just rev) >>= return . fromJust
                                ) result
 
                                      -> getPage sto name (Just rev) >>= return . fromJust
                                ) result
 

-                mkPageList pages
+                mkPageList showSummary pages

       }
     where
       }
     where

-      mkPageList :: [Page] -> IO BlockElement
-      mkPageList pages
-          = do items <- mapM mkListItem pages
+      mkPageList :: Bool -> [Page] -> IO BlockElement
+      mkPageList showSummary pages
+          = do items <- mapM (mkListItem showSummary) pages

                return (Div [("class", "recentUpdates")]
                        [ Block (List Bullet items) ])
 
                return (Div [("class", "recentUpdates")]
                        [ Block (List Bullet items) ])
 

-      mkListItem :: Page -> IO ListItem
-      mkListItem page
+      mkListItem :: Bool -> Page -> IO ListItem
+      mkListItem showSummary page

           = do lastMod <- utcToLocalZonedTime (entityLastMod page)
                return ( [ Inline ( PageLink {
                                      linkPage     = Just (pageName page)
           = do lastMod <- utcToLocalZonedTime (entityLastMod page)
                return ( [ Inline ( PageLink {
                                      linkPage     = Just (pageName page)


@@ -72,7 +80,8 @@ recentUpdatesInterp
                                 )
                         ]
                         ++
                                 )
                         ]
                         ++

-                        case entitySummary page of
-                          Just s  -> [ Block (Paragraph [Text s]) ]
-                          Nothing -> []
+                        case (showSummary, entitySummary page) of
+                          (True, Just s)
+                              -> [ Block (Paragraph [Text s]) ]
+                          _   -> []

                       )
                       )

diff --git a/defaultPages/Feed.xml b/defaultPages/Feed.xml
new file mode 100644 (file)
index 0000000..90a61a0
--- /dev/null
+++ b/defaultPages/Feed.xml
@@ -0,0 +1,9 @@
+<?xml version="1.0" encoding="utf-8"?>
+<page xmlns="http://cielonegro.org/schema/Rakka/Page/1.0"
+      type="text/x-rakka">
+
+  <textData><![CDATA[
+<recentUpdates items="30" showSummary="yes" onlyEntity="yes" onlySummarized="no" />
+]]></textData>
+
+</page>
\ No newline at end of file