{-# LANGUAGE OverloadedStrings #-}
{-
Copyright (C) 2009 Gwern Branwen <gwern0@gmail.com> and
John MacFarlane <jgm@berkeley.edu>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}

-- | Functions for creating Atom feeds for Gitit wikis and pages.

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 -> String
fcTitle    :: String
  , FeedConfig -> String
fcBaseUrl  :: String
  , FeedConfig -> Integer
fcFeedDays :: Integer
 } deriving (ReadPrec [FeedConfig]
ReadPrec FeedConfig
Int -> ReadS FeedConfig
ReadS [FeedConfig]
(Int -> ReadS FeedConfig)
-> ReadS [FeedConfig]
-> ReadPrec FeedConfig
-> ReadPrec [FeedConfig]
-> Read 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 -> String
(Int -> FeedConfig -> ShowS)
-> (FeedConfig -> String)
-> ([FeedConfig] -> ShowS)
-> Show FeedConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FeedConfig] -> ShowS
$cshowList :: [FeedConfig] -> ShowS
show :: FeedConfig -> String
$cshow :: FeedConfig -> String
showsPrec :: Int -> FeedConfig -> ShowS
$cshowsPrec :: Int -> FeedConfig -> ShowS
Show)

gititGenerator :: Generator
gititGenerator :: Generator
gititGenerator = Generator :: Maybe URI -> Maybe URI -> URI -> Generator
Generator {genURI :: Maybe URI
genURI = URI -> Maybe URI
forall a. a -> Maybe a
Just URI
"http://github.com/jgm/gitit"
                                   , genVersion :: Maybe URI
genVersion = URI -> Maybe URI
forall a. a -> Maybe a
Just (String -> URI
T.pack (Version -> String
showVersion Version
version))
                                   , genText :: URI
genText = URI
"gitit"}

filestoreToXmlFeed :: FeedConfig -> FileStore -> Maybe FilePath -> IO String
filestoreToXmlFeed :: FeedConfig -> FileStore -> Maybe String -> IO String
filestoreToXmlFeed FeedConfig
cfg FileStore
f = (Feed -> String) -> IO Feed -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Feed -> String
xmlFeedToString (IO Feed -> IO String)
-> (Maybe String -> IO Feed) -> Maybe String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FeedConfig -> Generator -> FileStore -> Maybe String -> IO Feed
generateFeed FeedConfig
cfg Generator
gititGenerator FileStore
f

xmlFeedToString :: Feed -> String
xmlFeedToString :: Feed -> String
xmlFeedToString Feed
elt = Text -> String
TL.unpack (Text -> String) -> (Document -> Text) -> Document -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenderSettings -> Document -> Text
renderText RenderSettings
forall a. Default a => a
def (Document -> String) -> Document -> String
forall a b. (a -> b) -> a -> b
$
  Document :: Prologue -> Element -> [Miscellaneous] -> Document
Document{ documentPrologue :: Prologue
documentPrologue = Prologue :: [Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue{ prologueBefore :: [Miscellaneous]
prologueBefore = []
                                       , prologueDoctype :: Maybe Doctype
prologueDoctype = Maybe Doctype
forall a. Maybe a
Nothing
                                       , prologueAfter :: [Miscellaneous]
prologueAfter = [] }
          , documentRoot :: Element
documentRoot = (Set URI -> Element)
-> (Element -> Element) -> Either (Set URI) Element -> Element
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Element -> Set URI -> Element
forall a b. a -> b -> a
const (Element -> Set URI -> Element) -> Element -> Set URI -> Element
forall a b. (a -> b) -> a -> b
$ Name -> Map Name URI -> [Node] -> Element
Text.XML.Element Name
"feed" Map Name URI
forall a. Monoid a => a
mempty []) Element -> Element
forall a. a -> a
id
                            (Either (Set URI) Element -> Element)
-> Either (Set URI) Element -> Element
forall a b. (a -> b) -> a -> b
$ Element -> Either (Set URI) Element
fromXMLElement (Element -> Either (Set URI) Element)
-> Element -> Either (Set URI) Element
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 String -> IO Feed
generateFeed FeedConfig
cfg Generator
generator FileStore
fs Maybe String
mbPath = do
  UTCTime
now <- IO UTCTime
getCurrentTime
  [Revision]
revs <- Integer -> FileStore -> Maybe String -> UTCTime -> IO [Revision]
changeLog (FeedConfig -> Integer
fcFeedDays FeedConfig
cfg) FileStore
fs Maybe String
mbPath UTCTime
now
  [[(String, [Diff [String]])]]
diffs <- (Revision -> IO [(String, [Diff [String]])])
-> [Revision] -> IO [[(String, [Diff [String]])]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FileStore -> Revision -> IO [(String, [Diff [String]])]
getDiffs FileStore
fs) [Revision]
revs
  let home :: String
home = FeedConfig -> String
fcBaseUrl FeedConfig
cfg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/"
  -- TODO: 'nub . sort' `persons` - but no Eq or Ord instances!
      persons :: [Person]
persons = (Author -> Person) -> [Author] -> [Person]
forall a b. (a -> b) -> [a] -> [b]
map Author -> Person
authorToPerson ([Author] -> [Person]) -> [Author] -> [Person]
forall a b. (a -> b) -> a -> b
$ [Author] -> [Author]
forall a. Eq a => [a] -> [a]
nub ([Author] -> [Author]) -> [Author] -> [Author]
forall a b. (a -> b) -> a -> b
$ (Author -> Author -> Ordering) -> [Author] -> [Author]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Author -> String) -> Author -> Author -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Author -> String
authorName) ([Author] -> [Author]) -> [Author] -> [Author]
forall a b. (a -> b) -> a -> b
$ (Revision -> Author) -> [Revision] -> [Author]
forall a b. (a -> b) -> [a] -> [b]
map Revision -> Author
revAuthor [Revision]
revs
      basefeed :: Feed
basefeed = Generator
-> String -> String -> Maybe String -> [Person] -> URI -> Feed
generateEmptyfeed Generator
generator (FeedConfig -> String
fcTitle FeedConfig
cfg) String
home Maybe String
mbPath [Person]
persons (String -> URI
T.pack (UTCTime -> String
formatFeedTime UTCTime
now))
      revisions :: [Entry]
revisions = ((Revision, [(String, [Diff [String]])]) -> Entry)
-> [(Revision, [(String, [Diff [String]])])] -> [Entry]
forall a b. (a -> b) -> [a] -> [b]
map (String -> (Revision, [(String, [Diff [String]])]) -> Entry
revisionToEntry String
home) ([Revision]
-> [[(String, [Diff [String]])]]
-> [(Revision, [(String, [Diff [String]])])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Revision]
revs [[(String, [Diff [String]])]]
diffs)
  Feed -> IO Feed
forall (m :: * -> *) a. Monad m => a -> m a
return Feed
basefeed {feedEntries :: [Entry]
feedEntries = [Entry]
revisions}

-- | Get the last N days history.
changeLog :: Integer -> FileStore -> Maybe FilePath -> UTCTime -> IO [Revision]
changeLog :: Integer -> FileStore -> Maybe String -> UTCTime -> IO [Revision]
changeLog Integer
days FileStore
a Maybe String
mbPath UTCTime
now' = do
  let files :: [String]
files = (String -> [String]) -> Maybe String -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
F.concatMap (\String
f -> [String
f, String
f String -> ShowS
<.> String
"page"]) Maybe String
mbPath
  let startTime :: UTCTime
startTime = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Integer -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> NominalDiffTime) -> Integer -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ -Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
24 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
days) UTCTime
now'
  [Revision]
rs <- FileStore -> [String] -> TimeRange -> Maybe Int -> IO [Revision]
history FileStore
a [String]
files TimeRange :: Maybe UTCTime -> Maybe UTCTime -> TimeRange
TimeRange{timeFrom :: Maybe UTCTime
timeFrom = UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
startTime, timeTo :: Maybe UTCTime
timeTo = UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
now'}
          (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
200) -- hard limit of 200 to conserve resources
  [Revision] -> IO [Revision]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Revision] -> IO [Revision]) -> [Revision] -> IO [Revision]
forall a b. (a -> b) -> a -> b
$ (Revision -> Revision -> Ordering) -> [Revision] -> [Revision]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Revision -> Revision -> Ordering)
-> Revision -> Revision -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Revision -> Revision -> Ordering)
 -> Revision -> Revision -> Ordering)
-> (Revision -> Revision -> Ordering)
-> Revision
-> Revision
-> Ordering
forall a b. (a -> b) -> a -> b
$ (Revision -> UTCTime) -> Revision -> Revision -> Ordering
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 [(String, [Diff [String]])]
getDiffs FileStore
fs Revision{ revId :: Revision -> String
revId = String
to, revDateTime :: Revision -> UTCTime
revDateTime = UTCTime
rd, revChanges :: Revision -> [Change]
revChanges = [Change]
rv } = do
  [Revision]
revPair <- FileStore -> [String] -> TimeRange -> Maybe Int -> IO [Revision]
history FileStore
fs [] (Maybe UTCTime -> Maybe UTCTime -> TimeRange
TimeRange Maybe UTCTime
forall a. Maybe a
Nothing (Maybe UTCTime -> TimeRange) -> Maybe UTCTime -> TimeRange
forall a b. (a -> b) -> a -> b
$ UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
rd) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2)
  let from :: Maybe String
from = if [Revision] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Revision]
revPair Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
                then String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Revision -> String
revId (Revision -> String) -> Revision -> String
forall a b. (a -> b) -> a -> b
$ [Revision]
revPair [Revision] -> Int -> Revision
forall a. [a] -> Int -> a
!! Int
1
                else Maybe String
forall a. Maybe a
Nothing
  [[Diff [String]]]
diffs <- (Change -> IO [Diff [String]]) -> [Change] -> IO [[Diff [String]]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FileStore
-> Maybe String -> Maybe String -> Change -> IO [Diff [String]]
getDiff FileStore
fs Maybe String
from (String -> Maybe String
forall a. a -> Maybe a
Just String
to)) [Change]
rv
  [(String, [Diff [String]])] -> IO [(String, [Diff [String]])]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, [Diff [String]])] -> IO [(String, [Diff [String]])])
-> [(String, [Diff [String]])] -> IO [(String, [Diff [String]])]
forall a b. (a -> b) -> a -> b
$ ((String, [Diff [String]]) -> (String, [Diff [String]]))
-> [(String, [Diff [String]])] -> [(String, [Diff [String]])]
forall a b. (a -> b) -> [a] -> [b]
map (String, [Diff [String]]) -> (String, [Diff [String]])
forall a. (String, [a]) -> (String, [a])
filterPages ([(String, [Diff [String]])] -> [(String, [Diff [String]])])
-> [(String, [Diff [String]])] -> [(String, [Diff [String]])]
forall a b. (a -> b) -> a -> b
$ [String] -> [[Diff [String]]] -> [(String, [Diff [String]])]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Change -> String) -> [Change] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Change -> String
getFP [Change]
rv) [[Diff [String]]]
diffs
  where getFP :: Change -> String
getFP (Added String
fp) = String
fp
        getFP (Modified String
fp) = String
fp
        getFP (Deleted String
fp) = String
fp
        filterPages :: (String, [a]) -> (String, [a])
filterPages (String
fp, [a]
d) = case (ShowS
forall a. [a] -> [a]
reverse String
fp) of
                                   Char
'e':Char
'g':Char
'a':Char
'p':Char
'.':String
x -> (ShowS
forall a. [a] -> [a]
reverse String
x, [a]
d)
                                   String
_ -> (String
fp, [])

getDiff :: FileStore -> Maybe RevisionId -> Maybe RevisionId -> Change -> IO [Diff [String]]
getDiff :: FileStore
-> Maybe String -> Maybe String -> Change -> IO [Diff [String]]
getDiff FileStore
fs Maybe String
from Maybe String
_ (Deleted String
fp) = do
  String
contents <- FileStore -> String -> Maybe String -> IO String
FileStore -> forall a. Contents a => String -> Maybe String -> IO a
retrieve FileStore
fs String
fp Maybe String
from
  [Diff [String]] -> IO [Diff [String]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[String] -> Diff [String]
forall a b. a -> PolyDiff a b
First ([String] -> Diff [String]) -> [String] -> Diff [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
contents]
getDiff FileStore
fs Maybe String
from Maybe String
to (Modified String
fp) = FileStore
-> String -> Maybe String -> Maybe String -> IO [Diff [String]]
diff FileStore
fs String
fp Maybe String
from Maybe String
to
getDiff FileStore
fs Maybe String
_ Maybe String
to (Added String
fp) = do
  String
contents <- FileStore -> String -> Maybe String -> IO String
FileStore -> forall a. Contents a => String -> Maybe String -> IO a
retrieve FileStore
fs String
fp Maybe String
to
  [Diff [String]] -> IO [Diff [String]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[String] -> Diff [String]
forall a b. b -> PolyDiff a b
Second ([String] -> Diff [String]) -> [String] -> Diff [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
contents]

generateEmptyfeed :: Generator -> String ->String ->Maybe String -> [Person] -> Date -> Feed
generateEmptyfeed :: Generator
-> String -> String -> Maybe String -> [Person] -> URI -> Feed
generateEmptyfeed Generator
generator String
title String
home Maybe String
mbPath [Person]
authors URI
now =
  Feed
baseNull {feedAuthors :: [Person]
feedAuthors = [Person]
authors,
            feedGenerator :: Maybe Generator
feedGenerator = Generator -> Maybe Generator
forall a. a -> Maybe a
Just Generator
generator,
            feedLinks :: [Link]
feedLinks = [ (URI -> Link
nullLink (URI -> Link) -> URI -> Link
forall a b. (a -> b) -> a -> b
$ String -> URI
T.pack (String -> URI) -> String -> URI
forall a b. (a -> b) -> a -> b
$
                            String
home String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_feed/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escape (String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
mbPath))
                           {linkRel :: Maybe (Either URI URI)
linkRel = Either URI URI -> Maybe (Either URI URI)
forall a. a -> Maybe a
Just (URI -> Either URI URI
forall a b. a -> Either a b
Left URI
"self")}]
            }
    where baseNull :: Feed
baseNull = URI -> TextContent -> URI -> Feed
nullFeed (String -> URI
T.pack String
home) (URI -> TextContent
TextString (String -> URI
T.pack String
title)) URI
now

-- Several of the following functions have been given an alternate
-- version patched in using CPP specifically when the `feed` library
-- used is version 1.2.x
--
-- The 1.2.0.0 release of `feed` introduced an API change that was
-- reverted in 1.3.0.0.  When feed-1.2.x is sufficiently out of use,
-- the dependency lower-bound for feed should be updated to >= 1.3 and
-- the second alternative (#else condition) in each of the CPP
-- invocations below can be removed.
--
-- https://github.com/bergmark/feed/issues/35

revisionToEntry :: String -> (Revision, [(FilePath, [Diff [String]])]) -> Entry
revisionToEntry :: String -> (Revision, [(String, [Diff [String]])]) -> Entry
revisionToEntry String
home (Revision{ revId :: Revision -> String
revId = String
rid, revDateTime :: Revision -> UTCTime
revDateTime = UTCTime
rdt,
                               revAuthor :: Revision -> Author
revAuthor = Author
ra, revDescription :: Revision -> String
revDescription = String
rd,
                               revChanges :: Revision -> [Change]
revChanges = [Change]
rv}, [(String, [Diff [String]])]
diffs) =
  Entry
baseEntry{ entryContent :: Maybe EntryContent
entryContent = EntryContent -> Maybe EntryContent
forall a. a -> Maybe a
Just (EntryContent -> Maybe EntryContent)
-> EntryContent -> Maybe EntryContent
forall a b. (a -> b) -> a -> b
$ URI -> EntryContent
HTMLContent URI
content
           , entryAuthors :: [Person]
entryAuthors = [Author -> Person
authorToPerson Author
ra], entryLinks :: [Link]
entryLinks = [Link
ln] }
   where baseEntry :: Entry
baseEntry = URI -> TextContent -> URI -> Entry
nullEntry (String -> URI
T.pack String
url) TextContent
title
                          (String -> URI
T.pack (String -> URI) -> String -> URI
forall a b. (a -> b) -> a -> b
$ UTCTime -> String
formatFeedTime UTCTime
rdt)
         url :: String
url = String
home String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escape (Change -> String
extract (Change -> String) -> Change -> String
forall a b. (a -> b) -> a -> b
$ [Change] -> Change
forall a. [a] -> a
head [Change]
rv) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"?revision=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rid
         ln :: Link
ln = (URI -> Link
nullLink (String -> URI
T.pack String
url)) {linkRel :: Maybe (Either URI URI)
linkRel = Either URI URI -> Maybe (Either URI URI)
forall a. a -> Maybe a
Just (URI -> Either URI URI
forall a b. a -> Either a b
Left URI
"alternate")}
         title :: TextContent
title = URI -> TextContent
TextString (URI -> TextContent) -> URI -> TextContent
forall a b. (a -> b) -> a -> b
$ String -> URI
T.pack (String -> URI) -> String -> URI
forall a b. (a -> b) -> a -> b
$ ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char
'\n' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=) String
rd) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Change -> String) -> [Change] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Change -> String
forall a. Show a => a -> String
show [Change]
rv)
         df :: [Content]
df = ((String, [Diff [String]]) -> Content)
-> [(String, [Diff [String]])] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map (String, [Diff [String]]) -> Content
diffFile [(String, [Diff [String]])]
diffs
#if MIN_VERSION_feed(1, 3, 0) || (! MIN_VERSION_feed(1, 2, 0))
         content :: URI
content = String -> URI
T.pack (String -> URI) -> String -> URI
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Content -> String) -> [Content] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Content -> String
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 :: (String, [Diff [String]]) -> Content
diffFile (String
fp, [Diff [String]]
d) =
    String -> [Content] -> Content
enTag String
"div" ([Content] -> Content) -> [Content] -> Content
forall a b. (a -> b) -> a -> b
$ Content
header Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content]
text
  where
    header :: Content
header = String -> Content -> Content
enTag1 String
"h1" (Content -> Content) -> Content -> Content
forall a b. (a -> b) -> a -> b
$ String -> Content
enText String
fp
    text :: [Content]
text = (Content -> Content) -> [Content] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Content -> Content
enTag1 String
"p") ([Content] -> [Content]) -> [Content] -> [Content]
forall a b. (a -> b) -> a -> b
$ [[Content]] -> [Content]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Content]] -> [Content]) -> [[Content]] -> [Content]
forall a b. (a -> b) -> a -> b
$ (Diff [String] -> [Content]) -> [Diff [String]] -> [[Content]]
forall a b. (a -> b) -> [a] -> [b]
map Diff [String] -> [Content]
diffLines [Diff [String]]
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 [String] -> [Content]
diffLines (First [String]
x) = (String -> Content) -> [String] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Content -> Content
enTag1 String
"s" (Content -> Content) -> (String -> Content) -> String -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Content
enText) [String]
x
diffLines (Second [String]
x) = (String -> Content) -> [String] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Content -> Content
enTag1 String
"b" (Content -> Content) -> (String -> Content) -> String -> Content
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Content
enText) [String]
x
diffLines (Both [String]
x [String]
_) = (String -> Content) -> [String] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map String -> Content
enText [String]
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 :: String -> [Content] -> Content
enTag String
tag [Content]
content = Element -> Content
Elem Element
blank_element{ elName :: QName
elName=QName
blank_name{qName :: String
qName=String
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 :: String -> Content -> Content
enTag1 String
tag Content
content = String -> [Content] -> Content
enTag String
tag [Content
content]

#if MIN_VERSION_feed(1, 3, 0) || (! MIN_VERSION_feed(1, 2, 0))
enText :: String -> Content
enText :: String -> Content
enText String
content = CData -> Content
Text CData
blank_cdata{cdData :: String
cdData=String
content}
#else
enText :: T.Text -> XMLTypes.Node
enText content = XMLTypes.NodeContent (XMLTypes.ContentText content)
#endif

-- gitit is set up not to reveal registration emails
authorToPerson :: Author -> Person
authorToPerson :: Author -> Person
authorToPerson Author
ra = Person
nullPerson {personName :: URI
personName = String -> URI
T.pack (String -> URI) -> String -> URI
forall a b. (a -> b) -> a -> b
$ Author -> String
authorName Author
ra}

-- TODO: replace with Network.URI version of shortcut if it ever is added
escape :: String -> String
escape :: ShowS
escape = (Char -> Bool) -> ShowS
escapeURIString Char -> Bool
isUnescapedInURI

formatFeedTime :: UTCTime -> String
formatFeedTime :: UTCTime -> String
formatFeedTime = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%FT%TZ"

-- TODO: this boilerplate can be removed by changing Data.FileStore.Types to say
-- data Change = Modified {extract :: FilePath} | Deleted {extract :: FilePath} | Added
--                   {extract :: FilePath}
-- so then it would be just 'escape (extract $ head rv)' without the 4 line definition
extract :: Change -> FilePath
extract :: Change -> String
extract Change
x = ShowS
dePage ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ case Change
x of {Modified String
n -> String
n; Deleted String
n -> String
n; Added String
n -> String
n}
          where dePage :: ShowS
dePage String
f = if ShowS
takeExtension String
f String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".page" then ShowS
dropExtension String
f else String
f

-- TODO: figure out how to create diff links in a non-broken manner
{-
diff :: String -> String -> Revision -> Link
diff home path' Revision{revId = rid} =
                        let n = nullLink (home ++ "_diff/" ++ escape path' ++ "?to=" ++ rid) -- ++ fromrev)
                        in n {linkRel = Just (Left "alternate")}
-}