{-# LANGUAGE OverloadedStrings #-}
module Network.Gitit.Feed (FeedConfig(..), filestoreToXmlFeed) where
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Data.Time (UTCTime, formatTime, getCurrentTime, addUTCTime)
#if MIN_VERSION_time(1,5,0)
import Data.Time (defaultTimeLocale)
#else
import System.Locale (defaultTimeLocale)
#endif
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.Generic (Diff, PolyDiff(..), diff)
import Data.FileStore.Types (history, retrieve, Author(authorName), Change(..),
FileStore, Revision(..), TimeRange(..), RevisionId)
import Text.Atom.Feed (nullEntry, nullFeed, nullLink, nullPerson,
Date, Entry(..), Feed(..), Link(linkRel), Generator(..),
Person(personName), EntryContent(..), TextContent(TextString))
import Text.Atom.Feed.Export (xmlFeed)
import Text.XML.Light as XML (showContent, Content(..), Element(..), blank_element, QName(..), blank_name, CData(..), blank_cdata)
import Text.XML as Text.XML (renderText, Document(..), Element(..),
Prologue(..), def, fromXMLElement)
import qualified Data.XML.Types as XMLTypes
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 (T.pack (showVersion version))
, genText = "gitit"}
filestoreToXmlFeed :: FeedConfig -> FileStore -> Maybe FilePath -> IO String
filestoreToXmlFeed cfg f = fmap xmlFeedToString . generateFeed cfg gititGenerator f
xmlFeedToString :: Feed -> String
xmlFeedToString elt = TL.unpack . renderText def $
Document{ documentPrologue = Prologue{ prologueBefore = []
, prologueDoctype = Nothing
, prologueAfter = [] }
, documentRoot = either (const $ Text.XML.Element "feed" mempty []) id
$ fromXMLElement $ xmlFeed elt
, documentEpilogue = [] }
generateFeed :: FeedConfig -> Generator -> FileStore -> Maybe FilePath -> IO Feed
generateFeed cfg generator fs mbPath = do
now <- getCurrentTime
revs <- changeLog (fcFeedDays cfg) fs mbPath now
diffs <- mapM (getDiffs fs) revs
let home = fcBaseUrl cfg ++ "/"
persons = map authorToPerson $ nub $ sortBy (comparing authorName) $ map revAuthor revs
basefeed = generateEmptyfeed generator (fcTitle cfg) home mbPath persons (T.pack (formatFeedTime now))
revisions = map (revisionToEntry home) (zip revs diffs)
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 (flip $ comparing revDateTime) rs
getDiffs :: FileStore -> Revision -> IO [(FilePath, [Diff [String]])]
getDiffs fs Revision{ revId = to, revDateTime = rd, revChanges = rv } = do
revPair <- history fs [] (TimeRange Nothing $ Just rd) (Just 2)
let from = if length revPair >= 2
then Just $ revId $ revPair !! 1
else Nothing
diffs <- mapM (getDiff fs from (Just to)) rv
return $ map filterPages $ zip (map getFP rv) diffs
where getFP (Added fp) = fp
getFP (Modified fp) = fp
getFP (Deleted fp) = fp
filterPages (fp, d) = case (reverse fp) of
'e':'g':'a':'p':'.':x -> (reverse x, d)
_ -> (fp, [])
getDiff :: FileStore -> Maybe RevisionId -> Maybe RevisionId -> Change -> IO [Diff [String]]
getDiff fs from _ (Deleted fp) = do
contents <- retrieve fs fp from
return [First $ lines contents]
getDiff fs from to (Modified fp) = diff fs fp from to
getDiff fs _ to (Added fp) = do
contents <- retrieve fs fp to
return [Second $ lines contents]
generateEmptyfeed :: Generator -> String ->String ->Maybe String -> [Person] -> Date -> Feed
generateEmptyfeed generator title home mbPath authors now =
baseNull {feedAuthors = authors,
feedGenerator = Just generator,
feedLinks = [ (nullLink $ T.pack $
home ++ "_feed/" ++ escape (fromMaybe "" mbPath))
{linkRel = Just (Left "self")}]
}
where baseNull = nullFeed (T.pack home) (TextString (T.pack title)) now
revisionToEntry :: String -> (Revision, [(FilePath, [Diff [String]])]) -> Entry
revisionToEntry home (Revision{ revId = rid, revDateTime = rdt,
revAuthor = ra, revDescription = rd,
revChanges = rv}, diffs) =
baseEntry{ entryContent = Just $ HTMLContent content
, entryAuthors = [authorToPerson ra], entryLinks = [ln] }
where baseEntry = nullEntry (T.pack url) title
(T.pack $ formatFeedTime rdt)
url = home ++ escape (extract $ head rv) ++ "?revision=" ++ rid
ln = (nullLink (T.pack url)) {linkRel = Just (Left "alternate")}
title = TextString $ T.pack $ (takeWhile ('\n' /=) rd) ++ " - " ++ (intercalate ", " $ map show rv)
df = map diffFile diffs
#if MIN_VERSION_feed(1, 3, 0) || (! MIN_VERSION_feed(1, 2, 0))
content = T.pack $ concat $ map showContent df
#else
content = XMLTypes.Element (XMLTypes.Name "div" Nothing Nothing) [] df
#endif
#if MIN_VERSION_feed(1, 3, 0) || (! MIN_VERSION_feed(1, 2, 0))
diffFile :: (FilePath, [Diff [String]]) -> Content
diffFile (fp, d) =
enTag "div" $ header : text
where
header = enTag1 "h1" $ enText fp
text = map (enTag1 "p") $ concat $ map diffLines d
#else
diffFile :: (FilePath, [Diff [String]]) -> XMLTypes.Node
diffFile (fp, d) =
enTag "div" $ header : text
where
header = enTag1 "h1" $ enText $ T.pack fp
text = map (enTag1 "p") $ concat $ map diffLines d
#endif
#if MIN_VERSION_feed(1, 3, 0) || (! MIN_VERSION_feed(1, 2, 0))
diffLines :: Diff [String] -> [Content]
diffLines (First x) = map (enTag1 "s" . enText) x
diffLines (Second x) = map (enTag1 "b" . enText) x
diffLines (Both x _) = map enText x
#else
diffLines :: Diff [String] -> [XMLTypes.Node]
diffLines (First x) = map (enTag1 "s" . enText . T.pack) x
diffLines (Second x) = map (enTag1 "b" . enText . T.pack) x
diffLines (Both x _) = map (enText . T.pack) x
#endif
#if MIN_VERSION_feed(1, 3, 0) || (! MIN_VERSION_feed(1, 2, 0))
enTag :: String -> [Content] -> Content
enTag tag content = Elem blank_element{ elName=blank_name{qName=tag}
, elContent=content
}
#else
enTag :: T.Text -> [XMLTypes.Node] -> XMLTypes.Node
enTag tag content = XMLTypes.NodeElement $
XMLTypes.Element
(XMLTypes.Name tag Nothing Nothing)
[] content
#endif
#if MIN_VERSION_feed(1, 3, 0) || (! MIN_VERSION_feed(1, 2, 0))
enTag1 :: String -> Content -> Content
#else
enTag1 :: T.Text -> XMLTypes.Node -> XMLTypes.Node
#endif
enTag1 tag content = enTag tag [content]
#if MIN_VERSION_feed(1, 3, 0) || (! MIN_VERSION_feed(1, 2, 0))
enText :: String -> Content
enText content = Text blank_cdata{cdData=content}
#else
enText :: T.Text -> XMLTypes.Node
enText content = XMLTypes.NodeContent (XMLTypes.ContentText content)
#endif
authorToPerson :: Author -> Person
authorToPerson ra = nullPerson {personName = T.pack $ 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