    {-# 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(..), 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 {
        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 ++ "/"
      -- TODO: 'nub . sort' `persons` - but no Eq or Ord instances!
          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}

    -- | Get the last N days history.
    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) -- hard limit of 200 to conserve resources
      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 $ T.pack $ concat $ map showContent $ map diffFile diffs
               , 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)

    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

    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

    enTag :: String -> [Content] -> Content
    enTag tag content = Elem blank_element{ elName=blank_name{qName=tag}
                                          , elContent=content
                                          }
    enTag1 :: String -> Content -> Content
    enTag1 tag content = enTag tag [content]
    enText :: String -> Content
    enText content = Text blank_cdata{cdData=content}

    -- gitit is set up not to reveal registration emails
    authorToPerson :: Author -> Person
    authorToPerson ra = nullPerson {personName = T.pack $ authorName ra}

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

    formatFeedTime :: UTCTime -> String
    formatFeedTime = formatTime defaultTimeLocale "%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 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

    -- 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")}
    -}