module Network.Gitit.Feed (FeedConfig(..), filestoreToXmlFeed) where
import Data.DateTime (addMinutes, formatDateTime, getCurrentTime)
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(..),
DateTime, 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 (Show, Read)
filestoreToXmlFeed :: FeedConfig -> FileStore -> Maybe FilePath -> IO String
filestoreToXmlFeed cfg f = fmap xmlFeedToString . generateFeed cfg f
xmlFeedToString :: Feed -> String
xmlFeedToString = ppTopElement . xmlFeed
generateFeed :: FeedConfig -> FileStore -> Maybe FilePath -> IO Feed
generateFeed cfg 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 (fcTitle cfg) home mbPath persons (formatFeedTime now)
revisions = map (revisionToEntry home) revs
return basefeed {feedEntries = revisions}
changeLog :: Integer -> FileStore -> Maybe FilePath ->DateTime -> IO [Revision]
changeLog days a mbPath now' = do
let files = F.concatMap (\f -> [f, f <.> "page"]) mbPath
let startTime = addMinutes (60 * 24 * days) now'
rs <- history a files TimeRange{timeFrom = Just startTime, timeTo = Just now'}
return $ sortBy (comparing revDateTime) rs
generateEmptyfeed :: String ->String ->Maybe String -> [Person] -> Date -> Feed
generateEmptyfeed title home mbPath authors now =
baseNull {feedAuthors = authors,
feedGenerator = Just gititGenerator,
feedLinks = [ (nullLink $ home ++ "_feed/" ++ escape (fromMaybe "" mbPath))
{linkRel = Just (Left "self")}]
}
where baseNull = nullFeed home (TextString title) now
gititGenerator :: Generator
gititGenerator = Generator {genURI = Just "http://github.com/jgm/gitit"
, genVersion = Just (showVersion version)
, genText = "gitit"}
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 :: DateTime -> String
formatFeedTime = formatDateTime "%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