{-# 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 Data.Version (showVersion)
import Paths_gitit (version)
data FeedConfig = FeedConfig {
FeedConfig -> [Char]
fcTitle :: String
, FeedConfig -> [Char]
fcBaseUrl :: String
, FeedConfig -> Integer
fcFeedDays :: Integer
} deriving (ReadPrec [FeedConfig]
ReadPrec FeedConfig
Int -> ReadS FeedConfig
ReadS [FeedConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FeedConfig]
$creadListPrec :: ReadPrec [FeedConfig]
readPrec :: ReadPrec FeedConfig
$creadPrec :: ReadPrec FeedConfig
readList :: ReadS [FeedConfig]
$creadList :: ReadS [FeedConfig]
readsPrec :: Int -> ReadS FeedConfig
$creadsPrec :: Int -> ReadS FeedConfig
Read, Int -> FeedConfig -> ShowS
[FeedConfig] -> ShowS
FeedConfig -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FeedConfig] -> ShowS
$cshowList :: [FeedConfig] -> ShowS
show :: FeedConfig -> [Char]
$cshow :: FeedConfig -> [Char]
showsPrec :: Int -> FeedConfig -> ShowS
$cshowsPrec :: Int -> FeedConfig -> ShowS
Show)
gititGenerator :: Generator
gititGenerator :: Generator
gititGenerator = Generator {genURI :: Maybe NCName
genURI = forall a. a -> Maybe a
Just NCName
"http://github.com/jgm/gitit"
, genVersion :: Maybe NCName
genVersion = forall a. a -> Maybe a
Just ([Char] -> NCName
T.pack (Version -> [Char]
showVersion Version
version))
, genText :: NCName
genText = NCName
"gitit"}
filestoreToXmlFeed :: FeedConfig -> FileStore -> Maybe FilePath -> IO String
filestoreToXmlFeed :: FeedConfig -> FileStore -> Maybe [Char] -> IO [Char]
filestoreToXmlFeed FeedConfig
cfg FileStore
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Feed -> [Char]
xmlFeedToString forall b c a. (b -> c) -> (a -> b) -> a -> c
. FeedConfig -> Generator -> FileStore -> Maybe [Char] -> IO Feed
generateFeed FeedConfig
cfg Generator
gititGenerator FileStore
f
xmlFeedToString :: Feed -> String
xmlFeedToString :: Feed -> [Char]
xmlFeedToString Feed
elt = Text -> [Char]
TL.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderSettings -> Document -> Text
renderText forall a. Default a => a
def forall a b. (a -> b) -> a -> b
$
Document{ documentPrologue :: Prologue
documentPrologue = Prologue{ prologueBefore :: [Miscellaneous]
prologueBefore = []
, prologueDoctype :: Maybe Doctype
prologueDoctype = forall a. Maybe a
Nothing
, prologueAfter :: [Miscellaneous]
prologueAfter = [] }
, documentRoot :: Element
documentRoot = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Name -> Map Name NCName -> [Node] -> Element
Text.XML.Element Name
"feed" forall a. Monoid a => a
mempty []) forall a. a -> a
id
forall a b. (a -> b) -> a -> b
$ Element -> Either (Set NCName) Element
fromXMLElement forall a b. (a -> b) -> a -> b
$ Feed -> Element
xmlFeed Feed
elt
, documentEpilogue :: [Miscellaneous]
documentEpilogue = [] }
generateFeed :: FeedConfig -> Generator -> FileStore -> Maybe FilePath -> IO Feed
generateFeed :: FeedConfig -> Generator -> FileStore -> Maybe [Char] -> IO Feed
generateFeed FeedConfig
cfg Generator
generator FileStore
fs Maybe [Char]
mbPath = do
UTCTime
now <- IO UTCTime
getCurrentTime
[Revision]
revs <- Integer -> FileStore -> Maybe [Char] -> UTCTime -> IO [Revision]
changeLog (FeedConfig -> Integer
fcFeedDays FeedConfig
cfg) FileStore
fs Maybe [Char]
mbPath UTCTime
now
[[([Char], [Diff [[Char]]])]]
diffs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FileStore -> Revision -> IO [([Char], [Diff [[Char]]])]
getDiffs FileStore
fs) [Revision]
revs
let home :: [Char]
home = FeedConfig -> [Char]
fcBaseUrl FeedConfig
cfg forall a. [a] -> [a] -> [a]
++ [Char]
"/"
persons :: [Person]
persons = forall a b. (a -> b) -> [a] -> [b]
map Author -> Person
authorToPerson forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Author -> [Char]
authorName) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Revision -> Author
revAuthor [Revision]
revs
basefeed :: Feed
basefeed = Generator
-> [Char] -> [Char] -> Maybe [Char] -> [Person] -> NCName -> Feed
generateEmptyfeed Generator
generator (FeedConfig -> [Char]
fcTitle FeedConfig
cfg) [Char]
home Maybe [Char]
mbPath [Person]
persons ([Char] -> NCName
T.pack (UTCTime -> [Char]
formatFeedTime UTCTime
now))
revisions :: [Entry]
revisions = forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> (Revision, [([Char], [Diff [[Char]]])]) -> Entry
revisionToEntry [Char]
home) (forall a b. [a] -> [b] -> [(a, b)]
zip [Revision]
revs [[([Char], [Diff [[Char]]])]]
diffs)
forall (m :: * -> *) a. Monad m => a -> m a
return Feed
basefeed {feedEntries :: [Entry]
feedEntries = [Entry]
revisions}
changeLog :: Integer -> FileStore -> Maybe FilePath -> UTCTime -> IO [Revision]
changeLog :: Integer -> FileStore -> Maybe [Char] -> UTCTime -> IO [Revision]
changeLog Integer
days FileStore
a Maybe [Char]
mbPath UTCTime
now' = do
let files :: [[Char]]
files = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
F.concatMap (\[Char]
f -> [[Char]
f, [Char]
f [Char] -> ShowS
<.> [Char]
"page"]) Maybe [Char]
mbPath
let startTime :: UTCTime
startTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ -Integer
60 forall a. Num a => a -> a -> a
* Integer
60 forall a. Num a => a -> a -> a
* Integer
24 forall a. Num a => a -> a -> a
* Integer
days) UTCTime
now'
[Revision]
rs <- FileStore -> [[Char]] -> TimeRange -> Maybe Int -> IO [Revision]
history FileStore
a [[Char]]
files TimeRange{timeFrom :: Maybe UTCTime
timeFrom = forall a. a -> Maybe a
Just UTCTime
startTime, timeTo :: Maybe UTCTime
timeTo = forall a. a -> Maybe a
Just UTCTime
now'}
(forall a. a -> Maybe a
Just Int
200)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
$ forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Revision -> UTCTime
revDateTime) [Revision]
rs
getDiffs :: FileStore -> Revision -> IO [(FilePath, [Diff [String]])]
getDiffs :: FileStore -> Revision -> IO [([Char], [Diff [[Char]]])]
getDiffs FileStore
fs Revision{ revId :: Revision -> [Char]
revId = [Char]
to, revDateTime :: Revision -> UTCTime
revDateTime = UTCTime
rd, revChanges :: Revision -> [Change]
revChanges = [Change]
rv } = do
[Revision]
revPair <- FileStore -> [[Char]] -> TimeRange -> Maybe Int -> IO [Revision]
history FileStore
fs [] (Maybe UTCTime -> Maybe UTCTime -> TimeRange
TimeRange forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just UTCTime
rd) (forall a. a -> Maybe a
Just Int
2)
let from :: Maybe [Char]
from = if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Revision]
revPair forall a. Ord a => a -> a -> Bool
>= Int
2
then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Revision -> [Char]
revId forall a b. (a -> b) -> a -> b
$ [Revision]
revPair forall a. [a] -> Int -> a
!! Int
1
else forall a. Maybe a
Nothing
[[Diff [[Char]]]]
diffs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FileStore
-> Maybe [Char] -> Maybe [Char] -> Change -> IO [Diff [[Char]]]
getDiff FileStore
fs Maybe [Char]
from (forall a. a -> Maybe a
Just [Char]
to)) [Change]
rv
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. ([Char], [a]) -> ([Char], [a])
filterPages forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map Change -> [Char]
getFP [Change]
rv) [[Diff [[Char]]]]
diffs
where getFP :: Change -> [Char]
getFP (Added [Char]
fp) = [Char]
fp
getFP (Modified [Char]
fp) = [Char]
fp
getFP (Deleted [Char]
fp) = [Char]
fp
filterPages :: ([Char], [a]) -> ([Char], [a])
filterPages ([Char]
fp, [a]
d) = case (forall a. [a] -> [a]
reverse [Char]
fp) of
Char
'e':Char
'g':Char
'a':Char
'p':Char
'.':[Char]
x -> (forall a. [a] -> [a]
reverse [Char]
x, [a]
d)
[Char]
_ -> ([Char]
fp, [])
getDiff :: FileStore -> Maybe RevisionId -> Maybe RevisionId -> Change -> IO [Diff [String]]
getDiff :: FileStore
-> Maybe [Char] -> Maybe [Char] -> Change -> IO [Diff [[Char]]]
getDiff FileStore
fs Maybe [Char]
from Maybe [Char]
_ (Deleted [Char]
fp) = do
[Char]
contents <- FileStore -> forall a. Contents a => [Char] -> Maybe [Char] -> IO a
retrieve FileStore
fs [Char]
fp Maybe [Char]
from
forall (m :: * -> *) a. Monad m => a -> m a
return [forall a b. a -> PolyDiff a b
First forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
lines [Char]
contents]
getDiff FileStore
fs Maybe [Char]
from Maybe [Char]
to (Modified [Char]
fp) = FileStore
-> [Char] -> Maybe [Char] -> Maybe [Char] -> IO [Diff [[Char]]]
diff FileStore
fs [Char]
fp Maybe [Char]
from Maybe [Char]
to
getDiff FileStore
fs Maybe [Char]
_ Maybe [Char]
to (Added [Char]
fp) = do
[Char]
contents <- FileStore -> forall a. Contents a => [Char] -> Maybe [Char] -> IO a
retrieve FileStore
fs [Char]
fp Maybe [Char]
to
forall (m :: * -> *) a. Monad m => a -> m a
return [forall a b. b -> PolyDiff a b
Second forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
lines [Char]
contents]
generateEmptyfeed :: Generator -> String ->String ->Maybe String -> [Person] -> Date -> Feed
generateEmptyfeed :: Generator
-> [Char] -> [Char] -> Maybe [Char] -> [Person] -> NCName -> Feed
generateEmptyfeed Generator
generator [Char]
title [Char]
home Maybe [Char]
mbPath [Person]
authors NCName
now =
Feed
baseNull {feedAuthors :: [Person]
feedAuthors = [Person]
authors,
feedGenerator :: Maybe Generator
feedGenerator = forall a. a -> Maybe a
Just Generator
generator,
feedLinks :: [Link]
feedLinks = [ (NCName -> Link
nullLink forall a b. (a -> b) -> a -> b
$ [Char] -> NCName
T.pack forall a b. (a -> b) -> a -> b
$
[Char]
home forall a. [a] -> [a] -> [a]
++ [Char]
"_feed/" forall a. [a] -> [a] -> [a]
++ ShowS
escape (forall a. a -> Maybe a -> a
fromMaybe [Char]
"" Maybe [Char]
mbPath))
{linkRel :: Maybe (Either NCName NCName)
linkRel = forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left NCName
"self")}]
}
where baseNull :: Feed
baseNull = NCName -> TextContent -> NCName -> Feed
nullFeed ([Char] -> NCName
T.pack [Char]
home) (NCName -> TextContent
TextString ([Char] -> NCName
T.pack [Char]
title)) NCName
now
revisionToEntry :: String -> (Revision, [(FilePath, [Diff [String]])]) -> Entry
revisionToEntry :: [Char] -> (Revision, [([Char], [Diff [[Char]]])]) -> Entry
revisionToEntry [Char]
home (Revision{ revId :: Revision -> [Char]
revId = [Char]
rid, revDateTime :: Revision -> UTCTime
revDateTime = UTCTime
rdt,
revAuthor :: Revision -> Author
revAuthor = Author
ra, revDescription :: Revision -> [Char]
revDescription = [Char]
rd,
revChanges :: Revision -> [Change]
revChanges = [Change]
rv}, [([Char], [Diff [[Char]]])]
diffs) =
Entry
baseEntry{ entryContent :: Maybe EntryContent
entryContent = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ NCName -> EntryContent
HTMLContent NCName
content
, entryAuthors :: [Person]
entryAuthors = [Author -> Person
authorToPerson Author
ra], entryLinks :: [Link]
entryLinks = [Link
ln] }
where baseEntry :: Entry
baseEntry = NCName -> TextContent -> NCName -> Entry
nullEntry ([Char] -> NCName
T.pack [Char]
url) TextContent
title
([Char] -> NCName
T.pack forall a b. (a -> b) -> a -> b
$ UTCTime -> [Char]
formatFeedTime UTCTime
rdt)
url :: [Char]
url = [Char]
home forall a. [a] -> [a] -> [a]
++ ShowS
escape (Change -> [Char]
extract forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [Change]
rv) forall a. [a] -> [a] -> [a]
++ [Char]
"?revision=" forall a. [a] -> [a] -> [a]
++ [Char]
rid
ln :: Link
ln = (NCName -> Link
nullLink ([Char] -> NCName
T.pack [Char]
url)) {linkRel :: Maybe (Either NCName NCName)
linkRel = forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left NCName
"alternate")}
title :: TextContent
title = NCName -> TextContent
TextString forall a b. (a -> b) -> a -> b
$ [Char] -> NCName
T.pack forall a b. (a -> b) -> a -> b
$ (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char
'\n' forall a. Eq a => a -> a -> Bool
/=) [Char]
rd) forall a. [a] -> [a] -> [a]
++ [Char]
" - " forall a. [a] -> [a] -> [a]
++ (forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> [Char]
show [Change]
rv)
df :: [Content]
df = forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Diff [[Char]]]) -> Content
diffFile [([Char], [Diff [[Char]]])]
diffs
#if MIN_VERSION_feed(1, 3, 0) || (! MIN_VERSION_feed(1, 2, 0))
content :: NCName
content = [Char] -> NCName
T.pack forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Content -> [Char]
showContent [Content]
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 :: ([Char], [Diff [[Char]]]) -> Content
diffFile ([Char]
fp, [Diff [[Char]]]
d) =
[Char] -> [Content] -> Content
enTag [Char]
"div" forall a b. (a -> b) -> a -> b
$ Content
header forall a. a -> [a] -> [a]
: [Content]
text
where
header :: Content
header = [Char] -> Content -> Content
enTag1 [Char]
"h1" forall a b. (a -> b) -> a -> b
$ [Char] -> Content
enText [Char]
fp
text :: [Content]
text = forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Content -> Content
enTag1 [Char]
"p") forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Diff [[Char]] -> [Content]
diffLines [Diff [[Char]]]
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 :: Diff [[Char]] -> [Content]
diffLines (First [[Char]]
x) = forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Content -> Content
enTag1 [Char]
"s" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Content
enText) [[Char]]
x
diffLines (Second [[Char]]
x) = forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Content -> Content
enTag1 [Char]
"b" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Content
enText) [[Char]]
x
diffLines (Both [[Char]]
x [[Char]]
_) = forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Content
enText [[Char]]
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 :: [Char] -> [Content] -> Content
enTag [Char]
tag [Content]
content = Element -> Content
Elem Element
blank_element{ elName :: QName
elName=QName
blank_name{qName :: [Char]
qName=[Char]
tag}
, elContent :: [Content]
elContent=[Content]
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 :: [Char] -> Content -> Content
enTag1 [Char]
tag Content
content = [Char] -> [Content] -> Content
enTag [Char]
tag [Content
content]
#if MIN_VERSION_feed(1, 3, 0) || (! MIN_VERSION_feed(1, 2, 0))
enText :: String -> Content
enText :: [Char] -> Content
enText [Char]
content = CData -> Content
Text CData
blank_cdata{cdData :: [Char]
cdData=[Char]
content}
#else
enText :: T.Text -> XMLTypes.Node
enText content = XMLTypes.NodeContent (XMLTypes.ContentText content)
#endif
authorToPerson :: Author -> Person
authorToPerson :: Author -> Person
authorToPerson Author
ra = Person
nullPerson {personName :: NCName
personName = [Char] -> NCName
T.pack forall a b. (a -> b) -> a -> b
$ Author -> [Char]
authorName Author
ra}
escape :: String -> String
escape :: ShowS
escape = (Char -> Bool) -> ShowS
escapeURIString Char -> Bool
isUnescapedInURI
formatFeedTime :: UTCTime -> String
formatFeedTime :: UTCTime -> [Char]
formatFeedTime = forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%FT%TZ"
extract :: Change -> FilePath
Change
x = ShowS
dePage forall a b. (a -> b) -> a -> b
$ case Change
x of {Modified [Char]
n -> [Char]
n; Deleted [Char]
n -> [Char]
n; Added [Char]
n -> [Char]
n}
where dePage :: ShowS
dePage [Char]
f = if ShowS
takeExtension [Char]
f forall a. Eq a => a -> a -> Bool
== [Char]
".page" then ShowS
dropExtension [Char]
f else [Char]
f