Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 125 lines (105 sloc) 5.656 kb
586399e @jgm Added atom feeds.
authored
1 {-
2 Copyright (C) 2009 Gwern Branwen <gwern0@gmail.com> and
3 John MacFarlane <jgm@berkeley.edu>
4
5 This program is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2 of the License, or
8 (at your option) any later version.
9
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
14
15 You should have received a copy of the GNU General Public License
16 along with this program; if not, write to the Free Software
17 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
18 -}
19
428956e Fixed up Feed module.
John MacFarlane authored
20 -- | Functions for creating Atom feeds for Gitit wikis and pages.
586399e @jgm Added atom feeds.
authored
21
06d4b45 @jgm Introduced FeedConfig for Feed module.
authored
22 module Network.Gitit.Feed (FeedConfig(..), filestoreToXmlFeed) where
586399e @jgm Added atom feeds.
authored
23
adef0e4 @jgm Removed dependency on datetime package.
authored
24 import Data.Time (UTCTime, formatTime, getCurrentTime, addUTCTime)
25 import System.Locale (defaultTimeLocale)
428956e Fixed up Feed module.
John MacFarlane authored
26 import Data.Foldable as F (concatMap)
27 import Data.List (intercalate, sortBy, nub)
28 import Data.Maybe (fromMaybe)
586399e @jgm Added atom feeds.
authored
29 import Data.Ord (comparing)
fdb1684 Use isUnescapedInURI with escapeURIString rather than isAllowedInURI.
John MacFarlane authored
30 import Network.URI (isUnescapedInURI, escapeURIString)
428956e Fixed up Feed module.
John MacFarlane authored
31 import System.FilePath (dropExtension, takeExtension, (<.>))
32 import Data.FileStore.Types (history, Author(authorName), Change(..),
adef0e4 @jgm Removed dependency on datetime package.
authored
33 FileStore, Revision(..), TimeRange(..))
428956e Fixed up Feed module.
John MacFarlane authored
34 import Text.Atom.Feed (nullEntry, nullFeed, nullLink, nullPerson,
35 Date, Entry(..), Feed(..), Link(linkRel), Generator(..),
36 Person(personName), TextContent(TextString))
37 import Text.Atom.Feed.Export (xmlFeed)
38 import Text.XML.Light (ppTopElement)
39 import Data.Version (showVersion)
40 import Paths_gitit (version)
586399e @jgm Added atom feeds.
authored
41
06d4b45 @jgm Introduced FeedConfig for Feed module.
authored
42 data FeedConfig = FeedConfig {
43 fcTitle :: String
44 , fcBaseUrl :: String
45 , fcFeedDays :: Integer
11f2b5e @jgm Updateds to Feed module to make it decouplable from gitit.
authored
46 } deriving (Read, Show)
47
48 gititGenerator :: Generator
49 gititGenerator = Generator {genURI = Just "http://github.com/jgm/gitit"
50 , genVersion = Just (showVersion version)
51 , genText = "gitit"}
586399e @jgm Added atom feeds.
authored
52
428956e Fixed up Feed module.
John MacFarlane authored
53 filestoreToXmlFeed :: FeedConfig -> FileStore -> Maybe FilePath -> IO String
11f2b5e @jgm Updateds to Feed module to make it decouplable from gitit.
authored
54 filestoreToXmlFeed cfg f = fmap xmlFeedToString . generateFeed cfg gititGenerator f
428956e Fixed up Feed module.
John MacFarlane authored
55
56 xmlFeedToString :: Feed -> String
57 xmlFeedToString = ppTopElement . xmlFeed
58
11f2b5e @jgm Updateds to Feed module to make it decouplable from gitit.
authored
59 generateFeed :: FeedConfig -> Generator -> FileStore -> Maybe FilePath -> IO Feed
60 generateFeed cfg generator fs mbPath = do
586399e @jgm Added atom feeds.
authored
61 now <- getCurrentTime
428956e Fixed up Feed module.
John MacFarlane authored
62 revs <- changeLog (fcFeedDays cfg) fs mbPath now
63 let home = fcBaseUrl cfg ++ "/"
64 -- TODO: 'nub . sort' `persons` - but no Eq or Ord instances!
65 persons = map authorToPerson $ nub $ sortBy (comparing authorName) $ map revAuthor revs
11f2b5e @jgm Updateds to Feed module to make it decouplable from gitit.
authored
66 basefeed = generateEmptyfeed generator (fcTitle cfg) home mbPath persons (formatFeedTime now)
428956e Fixed up Feed module.
John MacFarlane authored
67 revisions = map (revisionToEntry home) revs
68 return basefeed {feedEntries = revisions}
69
70 -- | Get the last N days history.
adef0e4 @jgm Removed dependency on datetime package.
authored
71 changeLog :: Integer -> FileStore -> Maybe FilePath -> UTCTime -> IO [Revision]
428956e Fixed up Feed module.
John MacFarlane authored
72 changeLog days a mbPath now' = do
73 let files = F.concatMap (\f -> [f, f <.> "page"]) mbPath
adef0e4 @jgm Removed dependency on datetime package.
authored
74 let startTime = addUTCTime (fromIntegral $ -60 * 60 * 24 * days) now'
428956e Fixed up Feed module.
John MacFarlane authored
75 rs <- history a files TimeRange{timeFrom = Just startTime, timeTo = Just now'}
51df006 @jgm Limit of 200 on entries in one atom feed (to prevent overload).
authored
76 (Just 200) -- hard limit of 200 to conserve resources
586399e @jgm Added atom feeds.
authored
77 return $ sortBy (comparing revDateTime) rs
428956e Fixed up Feed module.
John MacFarlane authored
78
11f2b5e @jgm Updateds to Feed module to make it decouplable from gitit.
authored
79 generateEmptyfeed :: Generator -> String ->String ->Maybe String -> [Person] -> Date -> Feed
80 generateEmptyfeed generator title home mbPath authors now =
428956e Fixed up Feed module.
John MacFarlane authored
81 baseNull {feedAuthors = authors,
11f2b5e @jgm Updateds to Feed module to make it decouplable from gitit.
authored
82 feedGenerator = Just generator,
428956e Fixed up Feed module.
John MacFarlane authored
83 feedLinks = [ (nullLink $ home ++ "_feed/" ++ escape (fromMaybe "" mbPath))
84 {linkRel = Just (Left "self")}]
85 }
86 where baseNull = nullFeed home (TextString title) now
87
88 revisionToEntry :: String -> Revision -> Entry
89 revisionToEntry home Revision{ revId = rid, revDateTime = rdt,
90 revAuthor = ra, revDescription = rd,
91 revChanges = rv} =
586399e @jgm Added atom feeds.
authored
92 baseEntry{ entrySummary = Just $ TextString rd
428956e Fixed up Feed module.
John MacFarlane authored
93 , entryAuthors = [authorToPerson ra], entryLinks = [ln] }
94 where baseEntry = nullEntry url (TextString (intercalate ", " $ map show rv))
95 (formatFeedTime rdt)
96 url = home ++ escape (extract $ head rv) ++ "?revision=" ++ rid
97 ln = (nullLink url) {linkRel = Just (Left "alternate")}
586399e @jgm Added atom feeds.
authored
98
428956e Fixed up Feed module.
John MacFarlane authored
99 -- gitit is set up not to reveal registration emails
100 authorToPerson :: Author -> Person
101 authorToPerson ra = nullPerson {personName = authorName ra}
102
103 -- TODO: replace with Network.URI version of shortcut if it ever is added
43fc323 @jgm Modified feed handling so that feeds validate.
authored
104 escape :: String -> String
fdb1684 Use isUnescapedInURI with escapeURIString rather than isAllowedInURI.
John MacFarlane authored
105 escape = escapeURIString isUnescapedInURI
43fc323 @jgm Modified feed handling so that feeds validate.
authored
106
adef0e4 @jgm Removed dependency on datetime package.
authored
107 formatFeedTime :: UTCTime -> String
108 formatFeedTime = formatTime defaultTimeLocale "%FT%TZ"
428956e Fixed up Feed module.
John MacFarlane authored
109
110 -- TODO: this boilerplate can be removed by changing Data.FileStore.Types to say
111 -- data Change = Modified {extract :: FilePath} | Deleted {extract :: FilePath} | Added
112 -- {extract :: FilePath}
113 -- so then it would be just 'escape (extract $ head rv)' without the 4 line definition
114 extract :: Change -> FilePath
115 extract x = dePage $ case x of {Modified n -> n; Deleted n -> n; Added n -> n}
116 where dePage f = if takeExtension f == ".page" then dropExtension f else f
117
118 -- TODO: figure out how to create diff links in a non-broken manner
119 {-
120 diff :: String -> String -> Revision -> Link
121 diff home path' Revision{revId = rid} =
122 let n = nullLink (home ++ "_diff/" ++ escape path' ++ "?to=" ++ rid) -- ++ fromrev)
123 in n {linkRel = Just (Left "alternate")}
124 -}
Something went wrong with that request. Please try again.