improvements related to RSS feed

darcs-hash:20080124072818-62b54-456ed8a309a2c38e7e654e945372c7bec6265b80.gz

diff --git a/Rakka/Page.hs b/Rakka/Page.hs
index 6d3dff0bdb927ff15c863fd165ed49197b10dc4d..ec43df852c2d252ab758bfffe0e0e22ecf981c9d 100644 (file)
--- a/Rakka/Page.hs
+++ b/Rakka/Page.hs
@@ -20,7 +20,7 @@ module Rakka.Page
     , mkObjectURI
     , mkFragmentURI
     , mkAuxiliaryURI
-    , mkRDFURI
+    , mkFeedURI
     , mkRakkaURI
 
     , xmlizePage
@@ -182,8 +182,8 @@ mkAuxiliaryURI baseURI basePath name
       }
 
 
-mkRDFURI :: URI -> PageName -> URI
-mkRDFURI baseURI name
+mkFeedURI :: URI -> PageName -> URI
+mkFeedURI baseURI name
     = baseURI {
         uriPath = foldl (</>) "/" [uriPath baseURI, encodePageName name ++ ".rdf"]
       }

diff --git a/Rakka/Resource.hs b/Rakka/Resource.hs
index 963101ff1f5220b0f562ce61a0c05b5268c62739..d0d9c4866d06665732ab91344ed96dc87dc2ac2a 100644 (file)
--- a/Rakka/Resource.hs
+++ b/Rakka/Resource.hs
@@ -128,7 +128,7 @@ getEntityType
     where
       extMap :: [(String, MIMEType)]
       extMap = [ ("html", read "application/xhtml+xml")
-               , ( "rdf", read "application/rdf+xml"  )
+               , ( "rdf", read "application/rss+xml"  )
                , ( "xml", read "text/xml"             )
                ]
 

diff --git a/Rakka/Resource/PageEntity.hs b/Rakka/Resource/PageEntity.hs
index efb92162f874808624972730ee430d5a7e867b71..208b0b5946d07c8b45ded213f1c09b1ba742c464 100644 (file)
--- a/Rakka/Resource/PageEntity.hs
+++ b/Rakka/Resource/PageEntity.hs
@@ -23,6 +23,7 @@ import           Rakka.Utils
 import           Rakka.W3CDateTime
 import           Rakka.Wiki.Engine
 import           System.FilePath
+import           Text.HyperEstraier hiding (getText)
 import           Text.XML.HXT.Arrow.Namespace
 import           Text.XML.HXT.Arrow.WriteDocument
 import           Text.XML.HXT.Arrow.XmlArrow
@@ -113,7 +114,7 @@ handleGetEntity env
                                    rev -> foundEntity (strongETag $ show rev) (entityLastMod page)
 
                         outputXmlPage tree [ (MIMEType "application" "xhtml+xml" [], entityToXHTML env)
-                                           , (MIMEType "application" "rdf+xml"   [], entityToRSS   env)
+                                           , (MIMEType "application" "rss+xml"   [], entityToRSS   env)
                                            ]
 
 
@@ -131,6 +132,8 @@ entityToXHTML env
           let cssHref   = [uriToString id (mkObjectURI baseURI styleSheet) ""]
               scriptSrc = [uriToString id (baseURI { uriPath = uriPath baseURI </> "js" }) ""]
 
+          feeds <- arrIO0 (findFeeds (envStorage env)) -< ()
+
           pageTitle    <- listA (readSubPage env) -< (name, Just page, "PageTitle")
           leftSideBar  <- listA (readSubPage env) -< (name, Just page, "SideBar/Left")
           rightSideBar <- listA (readSubPage env) -< (name, Just page, "SideBar/Right")
@@ -157,6 +160,14 @@ entityToXHTML env
                            += sattr "type" "text/css"
                            += attr "href" (arr id >>> mkText)
                          )
+                      += ( constL feeds
+                           >>>
+                           eelem "link"
+                           += sattr "rel"   "alternate"
+                           += sattr "type"  "application/rss+xml"
+                           += attr  "title" (txt siteName <+> txt " - " <+> mkText)
+                           += attr  "href"  (arr (mkFeedURIStr baseURI) >>> mkText)
+                         )
                       += ( constL scriptSrc
                            >>>
                            eelem "script"
@@ -225,7 +236,7 @@ entityToRSS env
                  += sattr "xmlns:dc"        "http://purl.org/dc/elements/1.1/"
                  += sattr "xmlns:trackback" "http://madskills.com/public/xml/rss/module/trackback/"
                  += ( eelem "channel"
-                      += sattr "rdf:about" (uriToString id (mkRDFURI baseURI name) "")
+                      += sattr "rdf:about" (uriToString id (mkFeedURI baseURI name) "")
                       += ( eelem "title"
                            += txt siteName
                            += txt " - "
@@ -540,3 +551,18 @@ handleDelete env name
     = do userID <- getUserID env
          status <- deletePage (envStorage env) userID name
          setStatus status
+
+
+findFeeds :: Storage -> IO [PageName]
+findFeeds sto
+    = do cond <- newCondition
+         setPhrase   cond "[UVSET]"
+         addAttrCond cond "rakka:isFeed STREQ yes"
+         setOrder    cond "@uri STRA"
+         result <- searchPages sto cond
+         return (map fst result)
+
+
+mkFeedURIStr :: URI -> PageName -> String
+mkFeedURIStr baseURI name
+    = uriToString id (mkFeedURI baseURI name) ""
\ No newline at end of file

diff --git a/Rakka/Storage/Impl.hs b/Rakka/Storage/Impl.hs
index 3b48f0c10150c50c5550664cd5d9c47df81669ed..79108927435d271904e66172aa2b8944ae4f0c76 100644 (file)
--- a/Rakka/Storage/Impl.hs
+++ b/Rakka/Storage/Impl.hs
@@ -134,6 +134,8 @@ openIndex indexDir revFile
                      addAttrIndex index "@type"          StrIndex
                      addAttrIndex index "@uri"           SeqIndex
                      addAttrIndex index "rakka:revision" SeqIndex
+                     addAttrIndex index "rakka:isTheme"  StrIndex
+                     addAttrIndex index "rakka:isFeed"   StrIndex
                      noticeM logger ("Created an H.E. index on " ++ indexDir)
 
                      return index

diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs
index 90ed666a25db4da0ca9134a4e73b64b154fcc2ef..27386961fe4e7416623e6d752679c0579adf56f6 100644 (file)
--- a/Rakka/Wiki/Engine.hs
+++ b/Rakka/Wiki/Engine.hs
@@ -266,7 +266,6 @@ makeDraft interpTable
                pIsBinary <- getXPathTreesInDoc "/page/@isBinary/text()"     >>> getText -< tree
                pRevision <- getXPathTreesInDoc "/page/@revision/text()"     >>> getText -< tree
                pLang     <- maybeA (getXPathTreesInDoc "/page/@lang/text()"     >>> getText) -< tree
-               pFileName <- maybeA (getXPathTreesInDoc "/page/@fileName/text()" >>> getText) -< tree
                pIsTheme  <- maybeA (getXPathTreesInDoc "/page/@isTheme/text()"  >>> getText) -< tree
                pIsFeed   <- maybeA (getXPathTreesInDoc "/page/@isFeed/text()"   >>> getText) -< tree
                pSummary  <- maybeA (getXPathTreesInDoc "/page/summary/text()"   >>> getText) -< tree
@@ -276,7 +275,6 @@ makeDraft interpTable
                arrIO2 (flip setAttribute "@type"         ) -< (doc, Just pType)
                arrIO2 (flip setAttribute "@mdate"        ) -< (doc, Just pLastMod)
                arrIO2 (flip setAttribute "@lang"         ) -< (doc, pLang)
-               arrIO2 (flip setAttribute "rakka:fileName") -< (doc, pFileName)
                arrIO2 (flip setAttribute "rakka:isLocked") -< (doc, Just pIsLocked)
                arrIO2 (flip setAttribute "rakka:isBinary") -< (doc, Just pIsBinary)
                arrIO2 (flip setAttribute "rakka:revision") -< (doc, Just pRevision)