module Network.Gitit.Feed (FeedConfig(..), filestoreToXmlFeed) where
import Data.Time (UTCTime, formatTime, getCurrentTime, addUTCTime)
import System.Locale (defaultTimeLocale)
import Data.Foldable as F (concatMap)
import Data.List (intercalate, sortBy, nub)
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)
import Network.URI (isUnescapedInURI, escapeURIString)
import System.FilePath (dropExtension, takeExtension, (<.>))
import Data.FileStore.Types (history, Author(authorName), Change(..),
FileStore, Revision(..), TimeRange(..))
import Text.Atom.Feed (nullEntry, nullFeed, nullLink, nullPerson,
Date, Entry(..), Feed(..), Link(linkRel), Generator(..),
Person(personName), TextContent(TextString))
import Text.Atom.Feed.Export (xmlFeed)
import Text.XML.Light (ppTopElement)
import Data.Version (showVersion)
import Paths_gitit (version)
data FeedConfig = FeedConfig {
fcTitle :: String
, fcBaseUrl :: String
, fcFeedDays :: Integer
} deriving (Read, Show)
gititGenerator :: Generator
gititGenerator = Generator {genURI = Just "http://github.com/jgm/gitit"
, genVersion = Just (showVersion version)
, genText = "gitit"}
filestoreToXmlFeed :: FeedConfig -> FileStore -> Maybe FilePath -> IO String
filestoreToXmlFeed cfg f = fmap xmlFeedToString . generateFeed cfg gititGenerator f
xmlFeedToString :: Feed -> String
xmlFeedToString = ppTopElement . xmlFeed
generateFeed :: FeedConfig -> Generator -> FileStore -> Maybe FilePath -> IO Feed
generateFeed cfg generator fs mbPath = do
now <- getCurrentTime
revs <- changeLog (fcFeedDays cfg) fs mbPath now
let home = fcBaseUrl cfg ++ "/"
persons = map authorToPerson $ nub $ sortBy (comparing authorName) $ map revAuthor revs
basefeed = generateEmptyfeed generator (fcTitle cfg) home mbPath persons (formatFeedTime now)
revisions = map (revisionToEntry home) revs
return basefeed {feedEntries = revisions}
changeLog :: Integer -> FileStore -> Maybe FilePath -> UTCTime -> IO [Revision]
changeLog days a mbPath now' = do
let files = F.concatMap (\f -> [f, f <.> "page"]) mbPath
let startTime = addUTCTime (fromIntegral $ 60 * 60 * 24 * days) now'
rs <- history a files TimeRange{timeFrom = Just startTime, timeTo = Just now'}
(Just 200)
return $ sortBy (comparing revDateTime) rs
generateEmptyfeed :: Generator -> String ->String ->Maybe String -> [Person] -> Date -> Feed
generateEmptyfeed generator title home mbPath authors now =
baseNull {feedAuthors = authors,
feedGenerator = Just generator,
feedLinks = [ (nullLink $ home ++ "_feed/" ++ escape (fromMaybe "" mbPath))
{linkRel = Just (Left "self")}]
}
where baseNull = nullFeed home (TextString title) now
revisionToEntry :: String -> Revision -> Entry
revisionToEntry home Revision{ revId = rid, revDateTime = rdt,
revAuthor = ra, revDescription = rd,
revChanges = rv} =
baseEntry{ entrySummary = Just $ TextString rd
, entryAuthors = [authorToPerson ra], entryLinks = [ln] }
where baseEntry = nullEntry url (TextString (intercalate ", " $ map show rv))
(formatFeedTime rdt)
url = home ++ escape (extract $ head rv) ++ "?revision=" ++ rid
ln = (nullLink url) {linkRel = Just (Left "alternate")}
authorToPerson :: Author -> Person
authorToPerson ra = nullPerson {personName = authorName ra}
escape :: String -> String
escape = escapeURIString isUnescapedInURI
formatFeedTime :: UTCTime -> String
formatFeedTime = formatTime defaultTimeLocale "%FT%TZ"
extract :: Change -> FilePath
extract x = dePage $ case x of {Modified n -> n; Deleted n -> n; Added n -> n}
where dePage f = if takeExtension f == ".page" then dropExtension f else f