Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
152 lines (135 sloc) 6.79 KB
{-
Copyright (C) 2009 Gwern Branwen <gwern0@gmail.com> and
John MacFarlane <jgm@berkeley.edu>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
{- Functions for creating atom feeds for gitit wikis and pages.
-}
module Network.Gitit.Feed (FeedConfig(..), filestoreToXmlFeed) where
import Text.Atom.Feed
import Text.Atom.Feed.Export
import Text.XML.Light
import Data.FileStore.Types
import Data.Maybe
import Data.DateTime
import System.FilePath
import Control.Monad
import Data.List (intercalate, sortBy)
import Data.Ord (comparing)
data FeedConfig = FeedConfig {
fcTitle :: String
, fcBaseUrl :: String
, fcFeedDays :: Integer
} deriving (Show, Read)
filestoreToXmlFeed :: FeedConfig -> FileStore -> (Maybe FilePath) -> IO String
filestoreToXmlFeed cfg f mbPath = filestoreToFeed cfg f mbPath >>= return . ppTopElement . xmlFeed
filestoreToFeed :: FeedConfig -> FileStore -> (Maybe FilePath) -> IO Feed
filestoreToFeed cfg a mbPath = do
let path' = maybe "" id mbPath
when (null $ fcBaseUrl cfg) $ error "base-url in the config file is null."
rs <- changeLog cfg a mbPath
{- let rsShifted = if null rs
then []
else head rs : init rs -- so we can get revids for diffs
-}
let rsShifted = case rs of
[] -> []
(x:_) -> x : init rs -- so we can get revids for diffs
now <- liftM formatFeedTime getCurrentTime
return $ Feed { feedId = fcBaseUrl cfg ++ "/" ++ path'
, feedTitle = TextString $ fcTitle cfg
, feedUpdated = now
, feedAuthors = []
, feedCategories = []
, feedContributors = []
, feedGenerator = Just Generator{ genURI = Just "http://github.com/jgm/gitit"
, genVersion = Nothing
, genText = "gitit" }
, feedIcon = Nothing
, feedLinks = []
, feedLogo = Nothing
, feedRights = Nothing
, feedSubtitle = Nothing
, feedAttrs = []
, feedOther = []
, feedEntries = reverse $ zipWith (revToEntry cfg path') rs rsShifted }
-- | Get the last N days history.
changeLog :: FeedConfig -> FileStore -> (Maybe FilePath) -> IO [Revision]
changeLog cfg a mbPath = do
let files = maybe [] (\f -> [f, f <.> "page"]) mbPath
now <- getCurrentTime
let startTime = addMinutes (-60 * 24 * fcFeedDays cfg) now
rs <- history a files TimeRange{timeFrom = Just startTime, timeTo = Just now}
return $ sortBy (comparing revDateTime) rs
revToEntry :: FeedConfig -> String -> Revision -> Revision -> Entry
revToEntry cfg path' Revision{
revId = rid,
revDateTime = rdt,
revAuthor = ra,
revDescription = rd,
revChanges = rv } prevRevision =
baseEntry{ entrySummary = Just $ TextString rd
, entryAuthors = [Person { personName = authorName ra
, personURI = Nothing
, personEmail = Just $ authorEmail ra
, personOther = [] }]
, entryLinks = [diffLink]
-- Comments omitted; needs to be done by Gitit
-- only Gitit knows the Url of the Talk: page. See
-- http://www.rssboard.org/rss-2-0-1-rv-6#ltcommentsgtSubelementOfLtitemgt
-- FIXME: True field seems to tell Guid that it's a 'long-term'/'permanent'
-- GUID. This may not be correct. See
-- https://secure.wikimedia.org/wikipedia/en/wiki/Globally_Unique_Identifier
-- entryId = rid,
-- Source is not entirely relevant, and is only handleable by web software,
-- not by a filestore-level function. See
-- http://www.rssboard.org/rss-2-0-1-rv-6#ltsourcegtSubelementOfLtitemgt
-- The following are omitted:
-- Category is omitted, see
-- http://www.rssboard.org/rss-2-0-1-rv-6#syndic8
-- Enclosure seems to be for conveying media, see
-- https://secure.wikimedia.org/wikipedia/en/wiki/RSS_enclosure
}
where diffLink = Link{ linkHref = fcBaseUrl cfg ++ "/_diff/" ++ firstpath ++ "?to=" ++ rid ++ fromrev
, linkRel = Nothing
, linkType = Nothing
, linkHrefLang = Nothing
, linkTitle = Nothing
, linkLength = Nothing
, linkAttrs = []
, linkOther = [] }
(firstpath, fromrev) =
if null path'
{- then case head rv of
Modified f -> (dePage f, "&from=" ++ revId prevRevision)
Added f -> (dePage f, "")
Deleted f -> (dePage f, "&from=" ++ revId prevRevision)
else (path',"") -}
then case rv of
[] -> error "revToEntry, null rv"
(rev:_) -> case rev of
Modified f -> (dePage f, "&from=" ++ revId prevRevision)
Added f -> (dePage f, "")
Deleted f -> (dePage f, "&from=" ++ revId prevRevision)
else (path',"")
baseEntry = nullEntry (fcBaseUrl cfg ++ "/" ++ path' ++ "?revision=" ++ rid)
(TextString (intercalate ", " $ map showRev rv)) (formatFeedTime rdt)
showRev (Modified f) = dePage f
showRev (Added f) = "added " ++ dePage f
showRev (Deleted f) = "deleted " ++ dePage f
dePage f = if takeExtension f == ".page"
then dropExtension f
else f
formatFeedTime :: DateTime -> String
formatFeedTime = formatDateTime "%Y-%m%--%dT%TZ" -- Why the double hyphen between %m and %d? It works.
-- A single hyphen seems to disappear - I don't know why!
Something went wrong with that request. Please try again.