From: pho Date: Thu, 24 Jan 2008 07:28:18 +0000 (+0900) Subject: improvements related to RSS feed X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=commitdiff_plain;h=f57c5c5ae6c95e68b11400718e7ce5de4ea1317a;p=Rakka.git improvements related to RSS feed darcs-hash:20080124072818-62b54-456ed8a309a2c38e7e654e945372c7bec6265b80.gz --- diff --git a/Rakka/Page.hs b/Rakka/Page.hs index 6d3dff0..ec43df8 100644 --- 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 963101f..d0d9c48 100644 --- 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 efb9216..208b0b5 100644 --- 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 3b48f0c..7910892 100644 --- 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 90ed666..2738696 100644 --- 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)