packages feed

gitit 0.7.3.8 → 0.7.3.9

raw patch · 13 files changed

+106/−67 lines, 13 filesdep +old-localedep +timedep +xss-sanitizedep −cautious-filedep −datetimedep ~HTTPdep ~filestoredep ~hslogger

Dependencies added: old-locale, time, xss-sanitize

Dependencies removed: cautious-file, datetime

Dependency ranges changed: HTTP, filestore, hslogger, network, pandoc

Files

Network/Gitit.hs view
@@ -100,6 +100,7 @@                      , module Network.Gitit.Framework                      , module Network.Gitit.Layout                      , module Network.Gitit.ContentTransformer+                     , module Network.Gitit.Page                      , getFileStore                      , getUser                      , getConfig@@ -117,6 +118,7 @@ import Network.Gitit.State         (getFileStore, getUser, getConfig, queryGititState, updateGititState) import Network.Gitit.ContentTransformer+import Network.Gitit.Page import Network.Gitit.Authentication (loginUserForm) import Paths_gitit (getDataFileName) import Control.Monad.Reader@@ -147,14 +149,14 @@ fileServeStrict' :: [FilePath] -> FilePath -> ServerPart Response fileServeStrict' ps p = do   rq <- askRq-  resp <- fileServeStrict ps p-  if rsCode resp == 404 || lastNote "fileServeStrict'" (rqUri rq) == '/'+  resp' <- fileServeStrict ps p+  if rsCode resp' == 404 || lastNote "fileServeStrict'" (rqUri rq) == '/'      then mzero  -- pass through if not found or directory index      else do        -- turn off compresion filter unless it's text-       case getHeader "Content-Type" resp of-            Just ct | B.pack "text/" `B.isPrefixOf` ct -> return resp-            _ -> ignoreFilters >> return resp+       case getHeader "Content-Type" resp' of+            Just ct | B.pack "text/" `B.isPrefixOf` ct -> return resp'+            _ -> ignoreFilters >> return resp'  wikiHandlers :: [Handler] wikiHandlers =
Network/Gitit/ContentTransformer.hs view
@@ -92,7 +92,7 @@ import qualified Data.ByteString.Lazy as L (toChunks, fromChunks) import Network.URL (encString) import Network.URI (isUnescapedInURI)-+import Text.HTML.SanitizeXSS (sanitizeBalance) -- -- ContentTransformer runners --@@ -225,14 +225,14 @@ -- | Caches a response (actually just the response body) on disk, -- unless the context indicates that the page is not cacheable.  cacheHtml :: Response -> ContentTransformer Response -cacheHtml resp = do+cacheHtml resp' = do   params <- getParams   file <- getFileName   cacheable <- getCacheable   cfg <- lift getConfig   when (useCache cfg && cacheable && isNothing (pRevision params) && not (pPrintable params)) $-    lift $ cacheContents file $ S.concat $ L.toChunks $ rsBody resp -  return resp +    lift $ cacheContents file $ S.concat $ L.toChunks $ rsBody resp'+  return resp'  -- | Returns cached page if available, otherwise mzero. cachedHtml :: ContentTransformer Response@@ -337,7 +337,8 @@   toc <- liftM ctxTOC get   bird <- liftM ctxBirdTracks get   cfg <- lift getConfig-  return $ writeHtml defaultWriterOptions{+  return $ primHtml $ sanitizeBalance $+           writeHtmlString defaultWriterOptions{                         writerStandalone = True                       , writerTemplate = "$if(toc)$\n$toc$\n$endif$\n$body$"                       , writerHTMLMathMethod =@@ -489,8 +490,7 @@  readerFor :: PageType -> Bool -> (String -> Pandoc) readerFor pt lhs =-  let defPS = defaultParserState{ stateSanitizeHTML = True-                                , stateSmart = True+  let defPS = defaultParserState{ stateSmart = True                                 , stateLiterateHaskell = lhs }   in case pt of        RST      -> readRST defPS
Network/Gitit/Feed.hs view
@@ -21,7 +21,8 @@  module Network.Gitit.Feed (FeedConfig(..), filestoreToXmlFeed) where -import Data.DateTime (addMinutes, formatDateTime, getCurrentTime)+import Data.Time (UTCTime, formatTime, getCurrentTime, addUTCTime)+import System.Locale (defaultTimeLocale) import Data.Foldable as F (concatMap) import Data.List (intercalate, sortBy, nub) import Data.Maybe (fromMaybe)@@ -29,7 +30,7 @@ import Network.URI (isUnescapedInURI, escapeURIString) import System.FilePath (dropExtension, takeExtension, (<.>)) import Data.FileStore.Types (history, Author(authorName), Change(..),-         DateTime, FileStore, Revision(..), TimeRange(..))+         FileStore, Revision(..), TimeRange(..)) import Text.Atom.Feed (nullEntry, nullFeed, nullLink, nullPerson,          Date, Entry(..), Feed(..), Link(linkRel), Generator(..),          Person(personName), TextContent(TextString))@@ -42,45 +43,46 @@     fcTitle    :: String   , fcBaseUrl  :: String   , fcFeedDays :: Integer- } deriving (Show, Read)+ } deriving (Read, Show) +gititGenerator :: Generator+gititGenerator = Generator {genURI = Just "http://github.com/jgm/gitit"+                                   , genVersion = Just (showVersion version)+                                   , genText = "gitit"}+ filestoreToXmlFeed :: FeedConfig -> FileStore -> Maybe FilePath -> IO String-filestoreToXmlFeed cfg f = fmap xmlFeedToString . generateFeed cfg f+filestoreToXmlFeed cfg f = fmap xmlFeedToString . generateFeed cfg gititGenerator f  xmlFeedToString :: Feed -> String xmlFeedToString = ppTopElement . xmlFeed -generateFeed :: FeedConfig -> FileStore -> Maybe FilePath -> IO Feed-generateFeed cfg fs mbPath = do+generateFeed :: FeedConfig -> Generator -> FileStore -> Maybe FilePath -> IO Feed+generateFeed cfg generator fs mbPath = do   now <- getCurrentTime   revs <- changeLog (fcFeedDays cfg) fs mbPath now   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 (fcTitle cfg) home mbPath persons (formatFeedTime now)+      basefeed = generateEmptyfeed generator (fcTitle cfg) home mbPath persons (formatFeedTime now)       revisions = map (revisionToEntry home) revs   return basefeed {feedEntries = revisions}  -- | Get the last N days history.-changeLog :: Integer -> FileStore -> Maybe FilePath ->DateTime -> IO [Revision]+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 = addMinutes (-60 * 24 * days) now'+  let startTime = addUTCTime (fromIntegral $ -60 * 60 * 24 * days) now'   rs <- history a files TimeRange{timeFrom = Just startTime, timeTo = Just now'}   return $ sortBy (comparing revDateTime) rs -generateEmptyfeed :: String ->String ->Maybe String -> [Person] -> Date -> Feed-generateEmptyfeed title home mbPath authors now =+generateEmptyfeed :: Generator -> String ->String ->Maybe String -> [Person] -> Date -> Feed+generateEmptyfeed generator title home mbPath authors now =   baseNull {feedAuthors = authors,-            feedGenerator = Just gititGenerator,+            feedGenerator = Just generator,             feedLinks = [ (nullLink $ home ++ "_feed/" ++ escape (fromMaybe "" mbPath))                            {linkRel = Just (Left "self")}]             }     where baseNull = nullFeed home (TextString title) now-          gititGenerator :: Generator-          gititGenerator = Generator {genURI = Just "http://github.com/jgm/gitit"-                                     , genVersion = Just (showVersion version)-                                     , genText = "gitit"}  revisionToEntry :: String -> Revision -> Entry revisionToEntry home Revision{ revId = rid, revDateTime = rdt,@@ -101,8 +103,8 @@ escape :: String -> String escape = escapeURIString isUnescapedInURI -formatFeedTime :: DateTime -> String-formatFeedTime = formatDateTime "%FT%TZ"+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
Network/Gitit/Handlers.hs view
@@ -81,7 +81,7 @@ import qualified Data.ByteString.Lazy as B import qualified Data.ByteString as S import Network.HTTP (urlEncodeVars)-import Data.DateTime (getCurrentTime, addMinutes)+import Data.Time (getCurrentTime, addUTCTime) import Data.FileStore import System.Log.Logger (logM, Priority(..)) @@ -326,7 +326,7 @@ showHistory :: String -> String -> Params -> Handler showHistory file page params =  do   currTime <- liftIO getCurrentTime-  let oneYearAgo = addMinutes (-1 * 60 * 24 * 365) currTime+  let oneYearAgo = addUTCTime (-60 * 60 * 24 * 365) currTime   let since = case pSince params of                    Nothing -> Just oneYearAgo                    Just t  -> Just t@@ -379,7 +379,7 @@ showActivity :: Handler showActivity = withData $ \(params :: Params) -> do   currTime <- liftIO getCurrentTime-  let oneMonthAgo = addMinutes (-1 * 60 * 24 * 30) currTime+  let oneMonthAgo = addUTCTime (-60 * 60 * 24 * 30) currTime   let since = case pSince params of                    Nothing -> Just oneMonthAgo                    Just t  -> Just t@@ -776,6 +776,6 @@             ok $ emptyResponse{rsBody = B.fromChunks [contents]}        _ -> do             fs <- getFileStore-            resp <- liftM toResponse $ liftIO (filestoreToXmlFeed fc fs mbPath)-            cacheContents file $ S.concat $ B.toChunks $ rsBody resp-            ok . setContentType "application/atom+xml; charset=UTF-8" $ resp+            resp' <- liftM toResponse $ liftIO (filestoreToXmlFeed fc fs mbPath)+            cacheContents file $ S.concat $ B.toChunks $ rsBody resp'+            ok . setContentType "application/atom+xml; charset=UTF-8" $ resp'
Network/Gitit/Initialize.hs view
@@ -118,8 +118,7 @@     let fs = filestoreFromConfig conf         pt = defaultPageType conf         toPandoc = readMarkdown-                   defaultParserState{ stateSanitizeHTML = True-                                     , stateSmart = True }+                   defaultParserState{ stateSmart = True }         defOpts = defaultWriterOptions{                           writerStandalone = False                         , writerHTMLMathMethod = JsMath
Network/Gitit/Plugins.hs view
@@ -56,7 +56,12 @@       pr <- findModule (mkModuleName "Prelude") Nothing       i <- findModule (mkModuleName "Network.Gitit.Interface") Nothing       m <- findModule (mkModuleName modName) Nothing-      setContext [] [m, i, pr]+      setContext []+#if MIN_VERSION_ghc(7,0,0)+        [(m, Nothing), (i, Nothing), (pr, Nothing)]+#else+        [m, i, pr]+#endif       value <- compileExpr (modName ++ ".plugin :: Plugin")       let value' = (unsafeCoerce value) :: Plugin       return value'
Network/Gitit/State.hs view
@@ -25,7 +25,6 @@ import System.Random (randomRIO) import Data.Digest.Pure.SHA (sha512, showDigest) import qualified Data.ByteString.Lazy.UTF8 as L (fromString)-import qualified System.IO.Cautious as C (writeFile) import Data.IORef import System.IO.Unsafe (unsafePerformIO) import Control.Monad.Reader@@ -101,7 +100,7 @@ writeUserFile :: Config -> IO () writeUserFile conf = do   usrs <- queryGititState users-  C.writeFile (userFile conf) $+  writeFile (userFile conf) $       "[" ++ intercalate "\n," (map show $ M.toList usrs) ++ "\n]"  getUser :: String -> GititServerPart (Maybe User)
Network/Gitit/Types.hs view
@@ -33,7 +33,8 @@ import qualified Data.ByteString.Lazy as L (empty) import qualified Data.Map as M import Data.List (intersect)-import Data.DateTime+import Data.Time (parseTime)+import System.Locale (defaultTimeLocale) import Data.Maybe (fromMaybe) import Data.FileStore.Types import Network.Gitit.Server@@ -252,7 +253,7 @@                      , pRevision     :: Maybe String                      , pDestination  :: String                      , pForUser      :: Maybe String-                     , pSince        :: Maybe DateTime+                     , pSince        :: Maybe UTCTime                      , pRaw          :: String                      , pLimit        :: Int                      , pPatterns     :: [String]@@ -289,7 +290,7 @@                  return (if null s then Nothing else Just s))                  `mplus` return Nothing          fu <- liftM Just (look' "forUser") `mplus` return Nothing-         si <- liftM (parseDateTime "%Y-%m-%d") (look' "since")+         si <- liftM (parseTime defaultTimeLocale "%Y-%m-%d") (look' "since")                  `mplus` return Nothing  -- YYYY-mm-dd format          ds <- look' "destination" `mplus` return ""          ra <- look' "raw"            `mplus` return ""
README.markdown view
@@ -297,7 +297,7 @@ To change the footer, modify `templates/footer.st`.  For more radical changes, you can override any of the default-templates in `$CABALDIR/share/gitit-x.y.z/templates` by copying+templates in `$CABALDIR/share/gitit-x.y.z/data/templates` by copying the file into `templates` and modifying it. The `page.st` template is the master template; it includes the others. Interpolated variables are surrounded by `$`s, so `literal $` must be backslash-escaped.
data/static/js/preview.js view
@@ -1,8 +1,15 @@ function updatePreviewPane() {     $("#previewpane").hide();     var url = location.pathname.replace(/_edit\//,"_preview/");-    $("#previewpane").load(url, { "raw" : $("#editedText").attr("value") }, function() {convert();} );-    $("#previewpane").fadeIn(1000);+    $.post(+      url,+      {"raw" : $("#editedText").attr("value")},+      function(data) {+        $('#previewpane').html(data);+        if (typeof(convert) == 'function') { convert(); }+      },+      "html");+    $('#previewpane').fadeIn(1000); }; $(document).ready(function(){     $("#previewButton").show();
data/templates/logo.st view
@@ -1,3 +1,3 @@ <div id="logo">-  <a href="$base$/" title="Go to top page"><img src="$base$/img/logo.png" /></a>+  <a href="$base$/" alt="site logo" title="Go to top page"><img src="$base$/img/logo.png" /></a> </div>
gitit.cabal view
@@ -1,5 +1,5 @@ name:                gitit-version:             0.7.3.8+version:             0.7.3.9 Cabal-version:       >= 1.2 build-type:          Simple synopsis:            Wiki using happstack, git or darcs, and pandoc.@@ -100,7 +100,7 @@     exposed-modules: Network.Gitit.Interface     build-depends:   ghc, ghc-paths     cpp-options:     -D_PLUGINS-  build-depends:     base >= 3, pandoc >= 1.6, filepath, safe+  build-depends:     base >= 3, pandoc >= 1.6 && < 1.7, filepath, safe   extensions:        CPP   if impl(ghc >= 6.12)     ghc-options:     -Wall -fno-warn-unused-do-bind@@ -111,21 +111,39 @@ Executable           gitit   hs-source-dirs:    .   main-is:           gitit.hs-  build-depends:     base >=3 && < 5, parsec, pretty, xhtml, containers,-                     pandoc >= 1.6, process, filepath, directory, mtl, cgi,-                     network, old-time, highlighting-kate >= 0.2.7.1, bytestring,+  build-depends:     base >=3 && < 5,+                     parsec,+                     pretty,+                     xhtml,+                     containers,+                     pandoc >= 1.6 && < 1.7,+                     process,+                     filepath,+                     directory,+                     mtl,+                     cgi,+                     network,+                     old-time,+                     highlighting-kate >= 0.2.7.1,+                     bytestring,+                     random,                      utf8-string >= 0.3 && < 0.4,-                     SHA > 1 && < 1.5, HTTP >= 4000.0 && < 4000.1,-                     HStringTemplate >= 0.6 && < 0.7, random,-                     network >= 2.1.0.0 && < 2.3,-                     recaptcha >= 0.1, filestore >= 0.3.4,-                     datetime >= 0.1 && < 0.3, zlib >= 0.5 && < 0.6,+                     SHA > 1 && < 1.5, HTTP >= 4000.0 && < 4000.2,+                     HStringTemplate >= 0.6 && < 0.7,+                     network >= 2.1.0.0 && < 2.4,+                     old-locale >= 1,+                     time >= 1.1 && < 1.2,+                     recaptcha >= 0.1,+                     filestore >= 0.4 && < 0.5,+                     zlib >= 0.5 && < 0.6,                      url >= 2.1 && < 2.2,                      happstack-server >= 0.5 && < 0.6,-                     happstack-util >= 0.5 && < 0.6, xml >= 1.3.5,-                     hslogger >= 1 && < 1.1, ConfigFile >= 1 && < 1.1,+                     happstack-util >= 0.5 && < 0.6,+                     xml >= 1.3.5,+                     hslogger >= 1 && < 1.2,+                     ConfigFile >= 1 && < 1.1,                      feed >= 0.3.6 && < 0.4,-                     cautious-file >= 0.1.5 && < 0.2+                     xss-sanitize >= 0.2 && < 0.3   if impl(ghc >= 6.10)     build-depends:   base >= 4, syb   if flag(plugins)
plugins/Subst.hs view
@@ -6,7 +6,8 @@  module Subst (plugin) where -import Data.FileStore (retrieve)+import Control.Monad.CatchIO (try)+import Data.FileStore (FileStoreError, retrieve) import Text.Pandoc (defaultParserState, readMarkdown) import Network.Gitit.ContentTransformer (inlinesToString) import Network.Gitit.Interface@@ -16,12 +17,17 @@ plugin = mkPageTransformM substituteIntoBlock  substituteIntoBlock :: [Block] -> PluginM [Block]-substituteIntoBlock (Para (Link ref ("!subst", _):_ ):xs) = -     do let target = inlinesToString ref ++ ".page"+substituteIntoBlock ((Para [Link ref ("!subst", _)]):xs) = +     do let target = inlinesToString ref          cfg <- askConfig         let fs = filestoreFromConfig cfg-        article <- liftIO (retrieve fs target Nothing)-        let (Pandoc _ content) = readMarkdown defaultParserState article-        (content ++) `fmap` substituteIntoBlock xs+        article <- try $ liftIO (retrieve fs (target ++ ".page") Nothing) +        case article :: Either FileStoreError String of+          Left  _    -> let txt = Str ("[" ++ target ++ "](!subst)")+                            alt = "'" ++ target ++ "' doesn't exist. Click here to create it."+                            lnk = Para [Link [txt] (target,alt)]+                        in  (lnk :) `fmap` substituteIntoBlock xs+          Right a    -> let (Pandoc _ content) = readMarkdown defaultParserState a+                        in  (content ++) `fmap` substituteIntoBlock xs substituteIntoBlock (x:xs) = (x:) `fmap` substituteIntoBlock xs substituteIntoBlock [] = return []