gitit 0.7.2.1 → 0.7.3
raw patch · 28 files changed
+542/−336 lines, 28 filesdep −texmathdep ~ConfigFiledep ~HStringTemplatedep ~HTTP
Dependencies removed: texmath
Dependency ranges changed: ConfigFile, HStringTemplate, HTTP, SHA, datetime, feed, highlighting-kate, network, pandoc, url, utf8-string, zlib
Files
- CHANGES +49/−2
- Network/Gitit.hs +17/−11
- Network/Gitit/Authentication.hs +2/−1
- Network/Gitit/Cache.hs +12/−1
- Network/Gitit/Config.hs +22/−15
- Network/Gitit/ContentTransformer.hs +20/−45
- Network/Gitit/Export.hs +99/−20
- Network/Gitit/Feed.hs +79/−116
- Network/Gitit/Framework.hs +3/−8
- Network/Gitit/Handlers.hs +5/−3
- Network/Gitit/Initialize.hs +36/−23
- Network/Gitit/Layout.hs +31/−19
- Network/Gitit/Plugins.hs +5/−5
- Network/Gitit/Types.hs +7/−1
- README.markdown +32/−8
- data/default.conf +21/−1
- data/templates/sitenav.st +3/−1
- gitit.cabal +19/−11
- plugins/CapitalizeEmphasis.hs +1/−1
- plugins/Deprofanizer.hs +1/−1
- plugins/Dot.hs +4/−4
- plugins/ImgTex.hs +9/−13
- plugins/Interwiki.hs +28/−15
- plugins/PigLatin.hs +2/−1
- plugins/ShowUser.hs +0/−1
- plugins/Signature.hs +5/−7
- plugins/Subst.hs +27/−0
- plugins/WebArchiver.hs +3/−2
CHANGES view
@@ -1,6 +1,53 @@-Version 0.7.2.1 released 20 Mar 2010+Version 0.7.3 released 20 Mar 2010 -* Version bump to 0.7.2.1, depend on pandoc < 1.5.+* Added PDF export option and pdf-export config field.+ (Based on a patch by gwern.)++* Added markdown export.++* Use pandoc's new MathML math mode for more efficient+ MathML.++* Improved multi-wiki example code in haddocks.++* Added session-timeout config setting.++* Config module: Added readSize (recognizing K,M,G suffix).+ Previously readNumber always recognized K,M,G suffixes,+ but these only make sense in some contexts (not e.g. for+ times).++* Added Subst plugin (thanks to gwern).++* Added notes on PDF caching and idle.++* Fixed table of contents in wiki pages (resolving Issue #91).++* Added pandoc-user-data config option, allowing the user+ to specify a directory with e.g. templates that override+ the defaults used for exported pages.++* Fix filesToClean GHC panic when loading plugins on GHC HEAD++* Fixed problem with doubled // in updir links.+ Resolves Issue #88.++* Updated interwiki plugin.++* Fixed caching for feeds. Thanks to brian.sniffen for pointing+ out the need to normalize the time diff. Resolves Issue #87.++* Improved Feed module (gwern).++* Use line anchors from highlighting-source, so that you can link+ directly to a particular line in a source file.++* Disable upload functionality if maxUploadSize is 0.++* Exported queryGititState, updateGititState, Network.Gitit.Layout.+ Exported filledPageTemplate. (Thanks to tphyahoo.)+ Split off and expose createDefaultPages.+ Exposed compilePageTemplate. * Use charset=utf-8 on output from Layout.
Network/Gitit.hs view
@@ -38,7 +38,6 @@ > import Control.Monad > import Text.XHtml hiding (dir) > import Happstack.Server.SimpleHTTP-> import My.Auth.System (myGetUser, myLoginUser, myLogoutUser) > > type WikiSpec = (String, FileStoreType, PageType) > @@ -46,14 +45,16 @@ > , ("latexWiki", Darcs, LaTeX) ] > > -- custom authentication-> withUser :: Handler -> Handler-> withUser handler = do-> user <- myGetUser+> myWithUser :: Handler -> Handler+> myWithUser handler = do+> -- replace the following with a function that retrieves+> -- the logged in user for your happstack app:+> user <- return "testuser" > localRq (setHeader "REMOTE_USER" user) handler > > myAuthHandler = msum-> [ dir "_login" myLoginUser-> , dir "_logout" myLogoutUser ]+> [ dir "_login" $ seeOther "/your/login/url" $ toResponse ()+> , dir "_logout" $ seeOther "/your/logout/url" $ toResponse () ] > > handlerFor :: Config -> WikiSpec -> ServerPart Response > handlerFor conf (path', fstype, pagetype) = dir path' $@@ -68,7 +69,7 @@ > > main = do > conf <- getDefaultConfig-> let conf' = conf{authHandler = myAuthHandler}+> let conf' = conf{authHandler = myAuthHandler, withUser = myWithUser} > forM wikis $ \(path', fstype, pagetype) -> do > let conf'' = conf'{ repositoryPath = path' > , repositoryType = fstype@@ -81,7 +82,6 @@ > simpleHTTP nullConf{port = 5001} $ > (nullDir >> indexPage) `mplus` msum (map (handlerFor conf') wikis) - -} module Network.Gitit (@@ -98,10 +98,13 @@ , module Network.Gitit.Types -- * Tools for building handlers , module Network.Gitit.Framework+ , module Network.Gitit.Layout , module Network.Gitit.ContentTransformer , getFileStore , getUser , getConfig+ , queryGititState+ , updateGititState ) where import Network.Gitit.Types@@ -110,7 +113,9 @@ import Network.Gitit.Handlers import Network.Gitit.Initialize import Network.Gitit.Config-import Network.Gitit.State (getFileStore, getUser, getConfig)+import Network.Gitit.Layout+import Network.Gitit.State+ (getFileStore, getUser, getConfig, queryGititState, updateGititState) import Network.Gitit.ContentTransformer import Network.Gitit.Authentication (loginUserForm) import Paths_gitit (getDataFileName)@@ -160,8 +165,9 @@ , dir "_activity" showActivity , dir "_go" goToPage , dir "_search" searchResults- , dir "_upload" $ methodOnly GET >> requireUser uploadForm - , dir "_upload" $ methodOnly POST >> requireUser uploadFile+ , dir "_upload" $ do guard =<< return . uploadsAllowed =<< getConfig+ msum [ methodOnly GET >> requireUser uploadForm + , methodOnly POST >> requireUser uploadFile ] , dir "_random" $ methodOnly GET >> randomPage , dir "_index" indexPage , dir "_feed" feedHandler
Network/Gitit/Authentication.hs view
@@ -362,10 +362,11 @@ let pword = pPassword params let destination = pDestination params allowed <- authUser uname pword+ cfg <- getConfig if allowed then do key <- newSession (SessionData uname)- addCookie sessionTime (mkCookie "sid" (show key))+ addCookie (sessionTimeout cfg) (mkCookie "sid" (show key)) seeOther (encUrl destination) $ toResponse $ p << ("Welcome, " ++ uname) else withMessages ["Invalid username or password."] loginUserForm
Network/Gitit/Cache.hs view
@@ -34,6 +34,7 @@ import Control.Monad.Trans (liftIO) -- | Expire a cached file, identified by its filename in the filestore.+-- If there is an associated exported PDF, expire it too. -- Returns () after deleting a file from the cache, fails if no cached file. expireCachedFile :: String -> GititServerPart () expireCachedFile file = do@@ -41,9 +42,18 @@ let target = cacheDir cfg </> file exists <- liftIO $ doesFileExist target if exists- then liftIO (removeFile target)+ then liftIO $ do+ removeFile target+ expireCachedPDF (cacheDir cfg </> file) else mzero +expireCachedPDF :: String -> IO ()+expireCachedPDF file =+ when (takeExtension file == ".page") $ do+ let pdfname = file ++ ".export.pdf"+ exists <- doesFileExist pdfname+ when exists $ removeFile pdfname+ lookupCache :: String -> GititServerPart (Maybe (ClockTime, B.ByteString)) lookupCache file = do cfg <- getConfig@@ -64,3 +74,4 @@ liftIO $ do createDirectoryIfMissing True targetDir B.writeFile (cacheDir cfg </> file) contents+ expireCachedPDF (cacheDir cfg </> file)
Network/Gitit/Config.hs view
@@ -24,7 +24,6 @@ , getDefaultConfig , readMimeTypesFile ) where-import Safe import Network.Gitit.Types import Network.Gitit.Server (mimeTypes) import Network.Gitit.Framework@@ -46,7 +45,7 @@ import System.IO.UTF8 #endif import System.FilePath ((</>))-import Text.Pandoc+import Text.Pandoc hiding (MathML) forceEither :: Show e => Either e a -> a forceEither = either (error . show) id@@ -76,6 +75,7 @@ cfShowLHSBirdTracks <- get cp "DEFAULT" "show-lhs-bird-tracks" cfAuthenticationMethod <- get cp "DEFAULT" "authentication-method" cfUserFile <- get cp "DEFAULT" "user-file"+ cfSessionTimeout <- get cp "DEFAULT" "session-timeout" cfTemplatesDir <- get cp "DEFAULT" "templates-dir" cfLogFile <- get cp "DEFAULT" "log-file" cfLogLevel <- get cp "DEFAULT" "log-level"@@ -105,6 +105,8 @@ cfWikiTitle <- get cp "DEFAULT" "wiki-title" cfFeedDays <- get cp "DEFAULT" "feed-days" cfFeedRefreshTime <- get cp "DEFAULT" "feed-refresh-time"+ cfPDFExport <- get cp "DEFAULT" "pdf-export"+ cfPandocUserData <- get cp "DEFAULT" "pandoc-user-data" let (pt, lhs) = parsePageType cfDefaultPageType let markupHelpFile = show pt ++ if lhs then "+LHS" else "" markupHelpPath <- liftIO $ getDataFileName $ "data" </> "markupHelp" </> markupHelpFile@@ -139,6 +141,7 @@ "http" -> msum httpAuthHandlers _ -> mzero , userFile = cfUserFile+ , sessionTimeout = readNumber "session-timeout" cfSessionTimeout * 60 -- convert minutes -> seconds , templatesDir = cfTemplatesDir , logFile = cfLogFile , logLevel = let levelString = map toUpper cfLogLevel@@ -150,7 +153,7 @@ , staticDir = cfStaticDir , pluginModules = splitCommaList cfPlugins , tableOfContents = cfTableOfContents- , maxUploadSize = readNumber "max-upload-size" cfMaxUploadSize+ , maxUploadSize = readSize "max-upload-size" cfMaxUploadSize , portNumber = readNumber "port" cfPort , debugMode = cfDebugMode , frontPage = cfFrontPage@@ -174,7 +177,11 @@ , baseUrl = stripTrailingSlash cfBaseUrl , wikiTitle = cfWikiTitle , feedDays = readNumber "feed-days" cfFeedDays- , feedRefreshTime = readNumber "feed-refresh-time" cfFeedRefreshTime }+ , feedRefreshTime = readNumber "feed-refresh-time" cfFeedRefreshTime+ , pdfExport = cfPDFExport+ , pandocUserData = if null cfPandocUserData+ then Nothing+ else Just cfPandocUserData } case config' of Left (ParseError e, e') -> error $ "Parse error: " ++ e ++ "\n" ++ e' Left e -> error (show e)@@ -187,17 +194,17 @@ dropGt ('>':xs) = xs dropGt x = x -readNumber :: (Read a) => String -> String -> a-readNumber opt "" = error $ opt ++ " must be a number."-readNumber opt x =- let x' = case lastNote "readNumber" x of- 'K' -> init x ++ "000"- 'M' -> init x ++ "000000"- 'G' -> init x ++ "000000000"- _ -> x- in if all isDigit x'- then read x'- else error $ opt ++ " must be a number."+readNumber :: (Num a, Read a) => String -> String -> a+readNumber _ x | all isDigit x = read x+readNumber opt _ = error $ opt ++ " must be a number."++readSize :: (Num a, Read a) => String -> String -> a+readSize opt x =+ case reverse x of+ ('K':_) -> readNumber opt (init x) * 1000+ ('M':_) -> readNumber opt (init x) * 1000000+ ('G':_) -> readNumber opt (init x) * 1000000000+ _ -> readNumber opt x splitCommaList :: String -> [String] splitCommaList l =
Network/Gitit/ContentTransformer.hs view
@@ -79,7 +79,8 @@ import Network.Gitit.Cache (lookupCache, cacheContents) import qualified Data.FileStore as FS import Data.Maybe (mapMaybe)-import Text.Pandoc+import Text.Pandoc hiding (MathML)+import qualified Text.Pandoc as Pandoc import Text.Pandoc.Shared (ObfuscationMethod(..)) import Text.XHtml hiding ( (</>), dir, method, password, rev ) import Text.Highlighting.Kate@@ -91,8 +92,6 @@ import Network.URI (isUnescapedInURI, escapeURIString) import qualified Data.ByteString as S (concat) import qualified Data.ByteString.Lazy as L (toChunks, fromChunks)-import Text.XML.Light-import Text.TeXMath -- -- ContentTransformer runners@@ -289,8 +288,9 @@ exportPandoc doc = do params <- getParams page <- getPageName+ cfg <- lift getConfig let format = pFormat params- case lookup format exportFormats of+ case lookup format (exportFormats cfg) of Nothing -> error $ "Unknown export format: " ++ format Just writer -> lift (writer page doc) @@ -336,10 +336,15 @@ base' <- lift getWikiBase toc <- liftM ctxTOC get bird <- liftM ctxBirdTracks get+ cfg <- lift getConfig return $ writeHtml defaultWriterOptions{- writerStandalone = False- , writerHTMLMathMethod = JsMath- (Just $ base' ++ "/js/jsMath/easy/load.js")+ writerStandalone = True+ , writerTemplate = "$if(toc)$\n$toc$\n$endif$\n$body$"+ , writerHTMLMathMethod =+ case mathMethod cfg of+ MathML -> Pandoc.MathML Nothing+ _ -> JsMath (Just $ base' +++ "/js/jsMath/easy/load.js") , writerTableOfContents = toc , writerLiterateHaskell = bird -- note: javascript obfuscation gives problems on preview@@ -351,13 +356,12 @@ highlightSource Nothing = mzero highlightSource (Just source) = do file <- getFileName- -- let lang' = head $ languagesByExtension $ takeExtension file- let lang' = case languagesByExtension $ takeExtension file of- [] -> error "highlightSource, no lang'"- (l:_) -> l- case highlightAs lang' (filter (/='\r') source) of- Left _ -> mzero- Right res -> return $ formatAsXHtml [OptNumberLines] lang' $! res+ let formatOpts = [OptNumberLines, OptLineAnchors]+ case languagesByExtension $ takeExtension file of+ [] -> mzero+ (l:_) -> case highlightAs l (filter (/='\r') source) of+ Left _ -> mzero+ Right res -> return $ formatAsXHtml formatOpts l $! res -- -- Plugin combinators@@ -400,12 +404,7 @@ applyPageTransforms :: Pandoc -> ContentTransformer Pandoc applyPageTransforms c = do xforms <- getPageTransforms- cfg <- lift getConfig- params <- getParams- let xforms' = case mathMethod cfg of- MathML -> mathMLTransform (pFormat params) : xforms- _ -> xforms- foldM applyTransform c (wikiLinksTransform : xforms')+ foldM applyTransform c (wikiLinksTransform : xforms) -- | Applies all the pre-parse transform plugins to a Page object. applyPreParseTransforms :: Page -> ContentTransformer Page@@ -447,9 +446,7 @@ updateLayout $ \l -> case mathMethod conf of JsMathScript -> addScripts l ["jsMath/easy/load.js"]- -- for MathML, the script is added by mathMLTransform, only- -- if the page contains math:- MathML -> l+ MathML -> addScripts l ["MathMLInHTML.js"] RawTeX -> l return c @@ -507,28 +504,6 @@ convertWikiLinks (Link ref ("", "")) = Link ref (inlinesToURL ref, "Go to wiki page") convertWikiLinks x = x--mathMLTransform :: String -> Pandoc -> PluginM Pandoc-mathMLTransform format inp | format `elem` ["","S5"] = do- let (Pandoc m blks, mathUsed) = runState (processWithM convertTeXMathToMathML inp) False- let scriptLink = RawHtml "<script type=\"text/javascript\" src=\"/js/MathMLinHTML.js\"></script>"- let blks' = if mathUsed- then blks ++ [scriptLink]- else blks- return $ Pandoc m blks'-mathMLTransform _ inp = return inp---- | Convert math to MathML. We put this in a Writer monad--- to keep track of whether we've actually got any MathML; if not,--- we can avoid linking a script.-convertTeXMathToMathML :: Inline -> State Bool Inline-convertTeXMathToMathML (Math t x) = do- case texMathToMathML t' x of- Left _ -> return $ Math t x- Right v -> put True >> return (HtmlInline $ showXml v)- where t' = if t == DisplayMath then DisplayBlock else DisplayInline- showXml = ppcElement (useShortEmptyTags (const False) defaultConfigPP)-convertTeXMathToMathML x = return x -- | Derives a URL from a list of Pandoc Inline elements. inlinesToURL :: [Inline] -> String
Network/Gitit/Export.hs view
@@ -19,24 +19,33 @@ {- Functions for exporting wiki pages in various formats. -} -module Network.Gitit.Export ( exportFormats )-where+module Network.Gitit.Export ( exportFormats ) where import Text.Pandoc import Text.Pandoc.Writers.S5 (s5HeaderIncludes) import Text.Pandoc.ODT (saveOpenDocumentAsODT)+import Text.Pandoc.Shared (escapeStringUsing) import Network.Gitit.Server+import Network.Gitit.Framework (pathForPage) import Network.Gitit.Util (withTempDir)-import Network.Gitit.State+import Network.Gitit.State (getConfig) import Network.Gitit.Types+import Network.Gitit.Cache (cacheContents, lookupCache) import Control.Monad.Trans (liftIO)+import Control.Monad (unless, when) import Text.XHtml (noHtml)-import qualified Data.ByteString.Lazy as B+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L import System.FilePath ((<.>), (</>)) import Control.Exception (throwIO)+import System.Environment (getEnvironment)+import System.Exit (ExitCode(..))+import System.IO (openTempFile)+import System.Directory (getCurrentDirectory, setCurrentDirectory, removeFile)+import System.Process (runProcess, waitForProcess)+import Codec.Binary.UTF8.String (encodeString) defaultRespOptions :: WriterOptions-defaultRespOptions = defaultWriterOptions { writerStandalone = True- , writerWrapText = True }+defaultRespOptions = defaultWriterOptions { writerStandalone = True } respond :: String -> String@@ -49,9 +58,10 @@ toResponse . fn respondX :: String -> String -> String -> (WriterOptions -> Pandoc -> String)- -> WriterOptions -> String -> Pandoc -> Handler+ -> WriterOptions -> String -> Pandoc -> Handler respondX templ mimetype ext fn opts page doc = do- template' <- liftIO $ getDefaultTemplate templ+ cfg <- getConfig+ template' <- liftIO $ getDefaultTemplate (pandocUserData cfg) templ template <- case template' of Right t -> return t Left e -> liftIO $ throwIO e@@ -65,6 +75,7 @@ respondConTeXt = respondX "context" "application/x-context" "tex" writeConTeXt defaultRespOptions + respondRTF :: String -> Pandoc -> Handler respondRTF = respondX "rtf" "application/rtf" "rtf" writeRTF defaultRespOptions@@ -73,13 +84,17 @@ respondRST = respondX "rst" "text/plain; charset=utf-8" "" writeRST defaultRespOptions{writerReferenceLinks = True} +respondMarkdown :: String -> Pandoc -> Handler+respondMarkdown = respondX "markdown" "text/plain; charset=utf-8" ""+ writeMarkdown defaultRespOptions{writerReferenceLinks = True}+ respondMan :: String -> Pandoc -> Handler respondMan = respondX "man" "text/plain; charset=utf-8" "" writeMan defaultRespOptions -respondS5 :: String -> Pandoc -> Handler-respondS5 pg doc = do- inc <- liftIO $ s5HeaderIncludes+respondS5 :: Config -> String -> Pandoc -> Handler+respondS5 cfg pg doc = do+ inc <- liftIO $ s5HeaderIncludes (pandocUserData cfg) respondX "s5" "text/html; charset=utf-8" "" writeS5String defaultRespOptions{writerS5 = True, writerIncremental = True,@@ -98,9 +113,9 @@ respondMediaWiki = respondX "mediawiki" "text/plain; charset=utf-8" "" writeMediaWiki defaultRespOptions -respondODT :: String -> Pandoc -> Handler-respondODT page doc = do- template' <- liftIO $ getDefaultTemplate "odt"+respondODT :: Config -> String -> Pandoc -> Handler+respondODT cfg page doc = do+ template' <- liftIO $ getDefaultTemplate (pandocUserData cfg) "odt" template <- case template' of Right t -> return t Left e -> liftIO $ throwIO e@@ -110,19 +125,83 @@ conf <- getConfig contents <- liftIO $ withTempDir "gitit-temp-odt" $ \tempdir -> do let tempfile = tempdir </> page <.> "odt"- saveOpenDocumentAsODT tempfile (repositoryPath conf) Nothing openDoc- B.readFile tempfile+ saveOpenDocumentAsODT (pandocUserData cfg) + tempfile (repositoryPath conf) Nothing openDoc+ L.readFile tempfile ok $ setContentType "application/vnd.oasis.opendocument.text" $ setFilename (page ++ ".odt") $ (toResponse noHtml) {rsBody = contents} -exportFormats :: [(String, String -> Pandoc -> Handler)]-exportFormats = [ ("LaTeX", respondLaTeX) -- (description, writer)+-- | Run shell command and return error status. Assumes+-- UTF-8 locale. Note that this does not actually go through \/bin\/sh!+runShellCommand :: FilePath -- ^ Working directory+ -> Maybe [(String, String)] -- ^ Environment+ -> String -- ^ Command+ -> [String] -- ^ Arguments+ -> IO ExitCode+runShellCommand workingDir environment command optionList = do+ (errPath, err) <- openTempFile workingDir "err"+ hProcess <- runProcess (encodeString command) (map encodeString optionList)+ (Just workingDir) environment Nothing (Just err) (Just err)+ status <- waitForProcess hProcess+ removeFile errPath+ return status++respondPDF :: String -> Pandoc -> Handler+respondPDF page pndc = do+ cfg <- getConfig+ unless (pdfExport cfg) $ error "PDF export disabled"+ let cacheName = pathForPage page ++ ".export.pdf"+ cached <- if useCache cfg+ then lookupCache cacheName+ else return Nothing+ pdf' <- case cached of+ Just (_modtime, bs) -> return $ Right (False, L.fromChunks [bs])+ Nothing -> liftIO $ withTempDir "gitit-tmp-pdf" $ \tempdir -> do+ template' <- liftIO $ getDefaultTemplate (pandocUserData cfg) "latex"+ template <- either throwIO return template'+ let toc = tableOfContents cfg+ let latex = writeLaTeX defaultRespOptions{writerTemplate = template+ ,writerTableOfContents = toc} pndc+ let tempfile = page <.> "tex"+ curdir <- getCurrentDirectory+ setCurrentDirectory tempdir+ writeFile tempfile latex+ -- run pdflatex twice to get the references and toc right+ let cmd = "pdflatex"+ oldEnv <- getEnvironment+ let env = Just $ ("TEXINPUTS",".:" ++ + escapeStringUsing [(' ',"\\ "),('"',"\\\"")]+ (curdir </> repositoryPath cfg) ++ ":") : oldEnv+ let opts = ["-interaction=batchmode", "-no-shell-escape", tempfile]+ _ <- runShellCommand tempdir env cmd opts+ canary <- runShellCommand tempdir env cmd opts+ setCurrentDirectory curdir -- restore original location+ case canary of+ ExitSuccess -> do pdfBS <- L.readFile (tempdir </> page <.> "pdf")+ return $ Right (useCache cfg, pdfBS)+ ExitFailure n -> do l <- readFile (tempdir </> page <.> "log")+ return $ Left (n, l)+ case pdf' of+ Left (n,logOutput) -> simpleErrorHandler ("PDF creation failed with code: " +++ show n ++ "\n" ++ logOutput)+ Right (needsCaching, pdfBS) -> do+ when needsCaching $+ cacheContents cacheName $ B.concat . L.toChunks $ pdfBS+ ok $ setContentType "application/pdf" $ setFilename (page ++ ".pdf") $+ (toResponse noHtml) {rsBody = pdfBS}++exportFormats :: Config -> [(String, String -> Pandoc -> Handler)]+exportFormats cfg = if pdfExport cfg+ then ("PDF", respondPDF) : rest+ else rest+ where rest = [ ("LaTeX", respondLaTeX) -- (description, writer) , ("ConTeXt", respondConTeXt) , ("Texinfo", respondTexinfo) , ("reST", respondRST)+ , ("markdown", respondMarkdown) , ("MediaWiki", respondMediaWiki) , ("man", respondMan) , ("DocBook", respondDocbook)- , ("S5", respondS5)- , ("ODT", respondODT)+ , ("S5", respondS5 cfg)+ , ("ODT", respondODT cfg ) , ("RTF", respondRTF) ]
Network/Gitit/Feed.hs view
@@ -17,142 +17,105 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} -{- Functions for creating atom feeds for gitit wikis and pages.--}+-- | Functions for creating Atom feeds for Gitit wikis and pages. module Network.Gitit.Feed (FeedConfig(..), filestoreToXmlFeed) where -import Control.Monad-import Data.DateTime-import Data.List (intercalate, sortBy)+import Data.DateTime (addMinutes, formatDateTime, getCurrentTime)+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--import Data.FileStore.Types--import Text.Atom.Feed-import Text.Atom.Feed.Export-import Text.XML.Light+import System.FilePath (dropExtension, takeExtension, (<.>))+import Data.FileStore.Types (history, Author(authorName), Change(..),+ DateTime, FileStore, Revision(..), TimeRange(..))+import Text.Atom.Feed (nullEntry, nullFeed, nullLink, nullPerson,+ Date, Entry(..), Feed(..), Link(linkRel), Generator(..),+ Person(personName), TextContent(TextString))+import Text.Atom.Feed.Export (xmlFeed)+import Text.XML.Light (ppTopElement)+import Data.Version (showVersion)+import Paths_gitit (version) data FeedConfig = FeedConfig { fcTitle :: String , fcBaseUrl :: String , fcFeedDays :: Integer- } deriving (Show, Read)+ } deriving (Show, Read) -filestoreToXmlFeed :: FeedConfig -> FileStore -> (Maybe FilePath) -> IO String-filestoreToXmlFeed cfg f mbPath = filestoreToFeed cfg f mbPath >>= return . ppTopElement . xmlFeed+filestoreToXmlFeed :: FeedConfig -> FileStore -> Maybe FilePath -> IO String+filestoreToXmlFeed cfg f = fmap xmlFeedToString . generateFeed cfg f -filestoreToFeed :: FeedConfig -> FileStore -> (Maybe FilePath) -> IO Feed-filestoreToFeed cfg a mbPath = do- let path' = maybe "" id mbPath- when (null $ fcBaseUrl cfg) $ error "base-url in the config file is null."- rs <- changeLog cfg a mbPath-{- let rsShifted = if null rs- then []- else head rs : init rs -- so we can get revids for diffs--}- let rsShifted = case rs of- [] -> []- (x:_) -> x : init rs -- so we can get revids for diffs- now <- liftM formatFeedTime getCurrentTime- return $ Feed { feedId = fcBaseUrl cfg ++ "/" ++ escape path'- , feedTitle = TextString $ fcTitle cfg- , feedUpdated = now- , feedAuthors = []- , feedCategories = []- , feedContributors = []- , feedGenerator = Just Generator{ genURI = Just "http://github.com/jgm/gitit"- , genVersion = Nothing- , genText = "gitit" }- , feedIcon = Nothing- , feedLinks = [ (nullLink (fcBaseUrl cfg ++ "/_feed/" ++ escape path')) {linkRel = Just (Left "self")} ]- , feedLogo = Nothing- , feedRights = Nothing- , feedSubtitle = Nothing- , feedAttrs = []- , feedOther = [] - , feedEntries = reverse $ zipWith (revToEntry cfg path') rs rsShifted }+xmlFeedToString :: Feed -> String+xmlFeedToString = ppTopElement . xmlFeed --- | Get the last N days history.-changeLog :: FeedConfig -> FileStore -> (Maybe FilePath) -> IO [Revision]-changeLog cfg a mbPath = do- let files = maybe [] (\f -> [f, f <.> "page"]) mbPath+generateFeed :: FeedConfig -> FileStore -> Maybe FilePath -> IO Feed+generateFeed cfg fs mbPath = do now <- getCurrentTime- let startTime = addMinutes (-60 * 24 * fcFeedDays cfg) now- rs <- history a files TimeRange{timeFrom = Just startTime, timeTo = Just now}- return $ sortBy (comparing revDateTime) rs- -revToEntry :: FeedConfig -> String -> Revision -> Revision -> Entry-revToEntry cfg path' Revision{- revId = rid,- revDateTime = rdt,- revAuthor = ra,- revDescription = rd,- revChanges = rv } prevRevision =- baseEntry{ entrySummary = Just $ TextString rd- , entryAuthors = [Person { personName = authorName ra- , personURI = Nothing - , personEmail = Nothing- -- gitit is set up not to reveal registration emails. To change this:- -- let e = authorEmail ra in if e /= "" then Just e else Nothing- , personOther = [] }]- , entryLinks = [diffLink]+ 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)+ revisions = map (revisionToEntry home) revs+ return basefeed {feedEntries = revisions} - -- Comments omitted; needs to be done by Gitit- -- only Gitit knows the Url of the Talk: page. See- -- http://www.rssboard.org/rss-2-0-1-rv-6#ltcommentsgtSubelementOfLtitemgt+-- | Get the last N days history.+changeLog :: Integer -> FileStore -> Maybe FilePath ->DateTime -> IO [Revision]+changeLog days a mbPath now' = do+ let files = F.concatMap (\f -> [f, f <.> "page"]) mbPath+ let startTime = addMinutes (-60 * 24 * days) now'+ rs <- history a files TimeRange{timeFrom = Just startTime, timeTo = Just now'}+ return $ sortBy (comparing revDateTime) rs - -- FIXME: True field seems to tell Guid that it's a 'long-term'/'permanent'- -- GUID. This may not be correct. See- -- https://secure.wikimedia.org/wikipedia/en/wiki/Globally_Unique_Identifier- -- entryId = rid,+generateEmptyfeed :: String ->String ->Maybe String -> [Person] -> Date -> Feed+generateEmptyfeed title home mbPath authors now =+ baseNull {feedAuthors = authors,+ feedGenerator = Just gititGenerator,+ 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"} - -- Source is not entirely relevant, and is only handleable by web software,- -- not by a filestore-level function. See- -- http://www.rssboard.org/rss-2-0-1-rv-6#ltsourcegtSubelementOfLtitemgt+revisionToEntry :: String -> Revision -> Entry+revisionToEntry home Revision{ revId = rid, revDateTime = rdt,+ revAuthor = ra, revDescription = rd,+ revChanges = rv} =+ baseEntry{ entrySummary = Just $ TextString rd+ , entryAuthors = [authorToPerson ra], entryLinks = [ln] }+ where baseEntry = nullEntry url (TextString (intercalate ", " $ map show rv))+ (formatFeedTime rdt)+ url = home ++ escape (extract $ head rv) ++ "?revision=" ++ rid+ ln = (nullLink url) {linkRel = Just (Left "alternate")} - -- The following are omitted:- -- Category is omitted, see- -- http://www.rssboard.org/rss-2-0-1-rv-6#syndic8- -- Enclosure seems to be for conveying media, see- -- https://secure.wikimedia.org/wikipedia/en/wiki/RSS_enclosure- }- where diffLink = Link{ linkHref = fcBaseUrl cfg ++ "/_diff/" ++ escape firstpath ++ "?to=" ++ rid ++ fromrev- , linkRel = Just (Left "alternate")- , linkType = Nothing- , linkHrefLang = Nothing- , linkTitle = Nothing- , linkLength = Nothing- , linkAttrs = []- , linkOther = [] } - (firstpath, fromrev) =- if null path'- {- then case head rv of- Modified f -> (dePage f, "&from=" ++ revId prevRevision)- Added f -> (dePage f, "")- Deleted f -> (dePage f, "&from=" ++ revId prevRevision)- else (path',"") -}- then case rv of- [] -> error "revToEntry, null rv"- (rev:_) -> case rev of - Modified f -> (dePage f, "&from=" ++ revId prevRevision) - Added f -> (dePage f, "")- Deleted f -> (dePage f, "&from=" ++ revId prevRevision)- else (path',"")- baseEntry = nullEntry (fcBaseUrl cfg ++ "/" ++ escape path' ++ "?revision=" ++ rid)- (TextString (intercalate ", " $ map showRev rv)) (formatFeedTime rdt)- showRev (Modified f) = dePage f- showRev (Added f) = "added " ++ dePage f- showRev (Deleted f) = "deleted " ++ dePage f- dePage f = if takeExtension f == ".page"- then dropExtension f- else f+-- gitit is set up not to reveal registration emails+authorToPerson :: Author -> Person+authorToPerson ra = nullPerson {personName = authorName ra} +-- TODO: replace with Network.URI version of shortcut if it ever is added escape :: String -> String escape = escapeURIString isUnescapedInURI formatFeedTime :: DateTime -> String-formatFeedTime = formatDateTime "%Y-%m%--%dT%TZ" -- Why the double hyphen between %m and %d? It works.- -- A single hyphen seems to disappear - I don't know why!+formatFeedTime = formatDateTime "%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")}+-}
Network/Gitit/Framework.hs view
@@ -24,7 +24,6 @@ , requireUserThat , requireUser , getLoggedInUser- , sessionTime -- * Combinators to exclude certain actions , unlessNoEdit , unlessNoDelete@@ -99,10 +98,11 @@ withUserFromSession :: Handler -> Handler withUserFromSession handler = withData $ \(sk :: Maybe SessionKey) -> do mbSd <- maybe (return Nothing) getSession sk+ cfg <- getConfig mbUser <- case mbSd of Nothing -> return Nothing Just sd -> do- addCookie sessionTime (mkCookie "sid" (show $ fromJust sk)) -- refresh timeout+ addCookie (sessionTimeout cfg) (mkCookie "sid" (show $ fromJust sk)) -- refresh timeout getUser $! sessionUser sd let user = maybe "" uUsername mbUser localRq (setHeader "REMOTE_USER" user) handler@@ -147,9 +147,6 @@ result' <- many (noneOf " \t\n") return $ takeWhile (/=':') $ decode result' -sessionTime :: Int-sessionTime = 60 * 60 -- session will expire 1 hour after page request- -- | @unlessNoEdit responder fallback@ runs @responder@ unless the -- page has been designated not editable in configuration; in that -- case, runs @fallback@.@@ -275,9 +272,7 @@ -- the wiki base. urlForPage :: String -> String urlForPage page = "/" ++- encString True (\c -> isAscii c && (c `notElem` "?&")) (map spaceToPlus page)- where spaceToPlus ' ' = '+'- spaceToPlus c = c+ encString True (\c -> isAscii c && (c `notElem` "?&")) page -- / and @ are left unescaped so that browsers recognize relative URLs and talk pages correctly -- | Returns the filestore path of the file containing the page's source.
Network/Gitit/Handlers.hs view
@@ -680,7 +680,8 @@ concatHtml [ anchor ! [theclass "updir", href $ if length d <= 1 then base' ++ "/_index"- else base' ++ urlForPage (joinPath d)] <<+ else base' +++ urlForPage (joinPath $ drop 1 d)] << lastNote "fileListToHtml" d, accum]) noHtml updirs in uplink +++ ulist ! [theclass "index"] << map fileLink files @@ -770,16 +771,17 @@ path' <- getPath -- e.g. "foo/bar" if they hit /_feed/foo/bar let file = (path' `orIfNull` "_site") <.> "feed" let mbPath = if null path' then Nothing else Just path'- fs <- getFileStore -- first, check for a cached version that is recent enough now <- liftIO $ getClockTime- let isRecentEnough t = diffClockTimes now t > noTimeDiff{tdMin = fromIntegral $ feedRefreshTime cfg}+ let isRecentEnough t = normalizeTimeDiff (diffClockTimes now t) <+ normalizeTimeDiff (noTimeDiff{tdMin = fromIntegral $ feedRefreshTime cfg}) mbCached <- lookupCache file case mbCached of Just (modtime, contents) | isRecentEnough modtime -> do let emptyResponse = setContentType "application/atom+xml; charset=utf-8" . toResponse $ () 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
Network/Gitit/Initialize.hs view
@@ -18,8 +18,10 @@ module Network.Gitit.Initialize ( initializeGititState , recompilePageTemplate+ , compilePageTemplate , createStaticIfMissing , createRepoIfMissing+ , createDefaultPages , createTemplateIfMissing ) where import System.FilePath ((</>), (<.>))@@ -115,23 +117,28 @@ return False Left RepositoryExists -> return True Left e -> throwIO e >> return False- let pt = defaultPageType conf- let toPandoc = readMarkdown- defaultParserState{ stateSanitizeHTML = True- , stateSmart = True }- let defOpts = defaultWriterOptions{- writerStandalone = False- , writerHTMLMathMethod = JsMath- (Just "/js/jsMath/easy/load.js")- , writerLiterateHaskell = showLHSBirdTracks conf- }- -- note: we convert this (markdown) to the default page format- let converter = case defaultPageType conf of- Markdown -> id- LaTeX -> writeLaTeX defOpts . toPandoc- HTML -> writeHtmlString defOpts . toPandoc- RST -> writeRST defOpts . toPandoc- unless repoExists $ do+ unless repoExists $ createDefaultPages conf++createDefaultPages :: Config -> IO ()+createDefaultPages conf = do+ let fs = filestoreFromConfig conf+ pt = defaultPageType conf+ toPandoc = readMarkdown+ defaultParserState{ stateSanitizeHTML = True+ , stateSmart = True }+ defOpts = defaultWriterOptions{+ writerStandalone = False+ , writerHTMLMathMethod = JsMath+ (Just "/js/jsMath/easy/load.js")+ , writerLiterateHaskell = showLHSBirdTracks conf+ }+ -- note: we convert this (markdown) to the default page format+ converter = case defaultPageType conf of+ Markdown -> id+ LaTeX -> writeLaTeX defOpts . toPandoc+ HTML -> writeHtmlString defOpts . toPandoc+ RST -> writeRST defOpts . toPandoc+ welcomepath <- getDataFileName $ "data" </> "FrontPage" <.> "page" welcomecontents <- liftM converter $ readFile welcomepath helppath <- getDataFileName $ "data" </> "Help" <.> "page"@@ -142,12 +149,18 @@ usersguidepath <- getDataFileName "README.markdown" usersguidecontents <- liftM converter $ readFile usersguidepath -- add front page, help page, and user's guide- create fs (frontPage conf <.> "page") (Author "Gitit" "") "Default front page" welcomecontents- logM "gitit" WARNING $ "Added " ++ (frontPage conf <.> "page") ++ " to repository"- create fs "Help.page" (Author "Gitit" "") "Default help page" helpcontents- logM "gitit" WARNING $ "Added " ++ "Help.page" ++ " to repository"- create fs "Gitit User's Guide.page" (Author "Gitit" "") "User's guide (README)" usersguidecontents- logM "gitit" WARNING $ "Added " ++ "Gitit User's Guide.page" ++ " to repository"+ let auth = Author "Gitit" ""+ createIfMissing fs (frontPage conf <.> "page") auth "Default front page" welcomecontents+ createIfMissing fs "Help.page" auth "Default help page" helpcontents+ createIfMissing fs "Gitit User's Guide.page" auth "User's guide (README)" usersguidecontents++createIfMissing :: FileStore -> FilePath -> Author -> Description -> String -> IO ()+createIfMissing fs p a comm cont = do+ res <- try $ create fs p a comm cont+ case res of+ Right _ -> logM "gitit" WARNING ("Added " ++ p ++ " to repository")+ Left ResourceExists -> return ()+ Left e -> throwIO e >> return () -- | Create static directory unless it exists. createStaticIfMissing :: Config -> IO ()
Network/Gitit/Layout.hs view
@@ -23,6 +23,8 @@ module Network.Gitit.Layout ( defaultPageLayout , defaultRenderPage , formattedPage+ , filledPageTemplate+ , uploadsAllowed ) where import Network.Gitit.Server@@ -63,23 +65,29 @@ defaultRenderPage :: T.StringTemplate String -> PageLayout -> Html -> Handler defaultRenderPage templ layout htmlContents = do cfg <- getConfig- let rev = pgRevision layout- let page = pgPageName layout base' <- getWikiBase- let scripts = ["jquery.min.js", "jquery-ui.packed.js"] ++ pgScripts layout- let scriptLink x = script ! [src (base' ++ "/js/" ++ x),+ ok . setContentType "text/html; charset=utf-8" . toResponse . T.render .+ filledPageTemplate base' cfg layout htmlContents $ templ++-- | Returns a page template with gitit variables filled in.+filledPageTemplate :: String -> Config -> PageLayout -> Html ->+ T.StringTemplate String -> T.StringTemplate String +filledPageTemplate base' cfg layout htmlContents templ = + let rev = pgRevision layout+ page = pgPageName layout+ scripts = ["jquery.min.js", "jquery-ui.packed.js"] ++ pgScripts layout+ scriptLink x = script ! [src (base' ++ "/js/" ++ x), thetype "text/javascript"] << noHtml- let javascriptlinks = renderHtmlFragment $ concatHtml $ map scriptLink scripts- let tabli tab = if tab == pgSelectedTab layout+ javascriptlinks = renderHtmlFragment $ concatHtml $ map scriptLink scripts+ tabli tab = if tab == pgSelectedTab layout then li ! [theclass "selected"] else li- let tabs' = [x | x <- pgTabs layout,+ tabs' = [x | x <- pgTabs layout, not (x == EditTab && page `elem` noEdit cfg)]- let tabs = ulist ! [theclass "tabs"] << map (linkForTab tabli base' page rev) tabs'- let setStrAttr attr = T.setAttribute attr . stringToHtmlString- let setBoolAttr attr test = if test then T.setAttribute attr "true" else id- let filledTemp = T.render .- T.setAttribute "base" base' .+ tabs = ulist ! [theclass "tabs"] << map (linkForTab tabli base' page rev) tabs'+ setStrAttr attr = T.setAttribute attr . stringToHtmlString+ setBoolAttr attr test = if test then T.setAttribute attr "true" else id+ in T.setAttribute "base" base' . T.setAttribute "feed" (pgLinkToFeed layout) . setStrAttr "wikititle" (wikiTitle cfg) . setStrAttr "pagetitle" (pgTitle layout) .@@ -93,24 +101,26 @@ setBoolAttr "printable" (pgPrintable layout) . maybe id (T.setAttribute "revision") rev . T.setAttribute "exportbox"- (renderHtmlFragment $ exportBox base' page rev) .+ (renderHtmlFragment $ exportBox base' cfg page rev) . T.setAttribute "tabs" (renderHtmlFragment tabs) . T.setAttribute "messages" (pgMessages layout) . T.setAttribute "usecache" (useCache cfg) .- T.setAttribute "content" (renderHtmlFragment htmlContents) $+ T.setAttribute "content" (renderHtmlFragment htmlContents) . + setBoolAttr "wikiupload" ( uploadsAllowed cfg) $ templ- ok $ setContentType "text/html; charset=utf-8" $ toResponse filledTemp -exportBox :: String -> String -> Maybe String -> Html-exportBox base' page rev | not (isSourceCode page) =+++exportBox :: String -> Config -> String -> Maybe String -> Html+exportBox base' cfg page rev | not (isSourceCode page) = gui (base' ++ urlForPage page) ! [identifier "exportbox"] << ([ textfield "revision" ! [thestyle "display: none;", value (fromJust rev)] | isJust rev ] ++ [ select ! [name "format"] <<- map ((\f -> option ! [value f] << f) . fst) exportFormats+ map ((\f -> option ! [value f] << f) . fst) (exportFormats cfg) , primHtmlChar "nbsp" , submit "export" "Export" ])-exportBox _ _ _ = noHtml+exportBox _ _ _ _ = noHtml -- auxiliary functions: @@ -145,3 +155,5 @@ then "edit" else "revert" +uploadsAllowed :: Config -> Bool+uploadsAllowed = (0 <) . maxUploadSize
Network/Gitit/Plugins.hs view
@@ -30,16 +30,16 @@ import Data.List (isInfixOf, isPrefixOf) import GHC import GHC.Paths-import DynFlags import Unsafe.Coerce loadPlugin :: FilePath -> IO Plugin loadPlugin pluginName = do logM "gitit" WARNING ("Loading plugin '" ++ pluginName ++ "'...")- defaultCleanupHandler defaultDynFlags $- runGhc (Just libdir) $ do- dflags <- getSessionDynFlags- setSessionDynFlags dflags+ runGhc (Just libdir) $ do+ dflags <- getSessionDynFlags+ setSessionDynFlags dflags+ defaultCleanupHandler dflags $ do+ -- initDynFlags unless ("Network.Gitit.Plugin." `isPrefixOf` pluginName) $ do addTarget =<< guessTarget pluginName Nothing
Network/Gitit/Types.hs view
@@ -67,6 +67,8 @@ authHandler :: Handler, -- | Path of users database userFile :: FilePath,+ -- | Seconds of inactivity before session expires+ sessionTimeout :: Int, -- | Directory containing page templates templatesDir :: FilePath, -- | Path of server log file@@ -126,7 +128,11 @@ -- | Number of days history to be included in feed feedDays :: Integer, -- | Number of minutes to cache feeds before refreshing- feedRefreshTime :: Integer+ feedRefreshTime :: Integer,+ -- | Allow PDF export?+ pdfExport :: Bool,+ -- | Directory to search for pandoc customizations+ pandocUserData :: Maybe FilePath } -- | Data for rendering a wiki page.
README.markdown view
@@ -127,6 +127,10 @@ Check that it worked: open a web browser and go to <http://localhost:5001>. +You can control the port that gitit runs on using the `-p` option:+`gitit -p 4000` will start gitit on port 4000. Additional runtime+options are described by `gitit -h`.+ Using gitit =========== @@ -213,12 +217,16 @@ Configuration options --------------------- -You can set some configuration options when starting gitit, using the-option `-f [filename]`. To get a copy of the default configuration file,-which you can customize, just type:+Use the option `-f [filename]` to specify a configuration file: - gitit --print-default-config > default.conf+ gitit -f my.conf +If this option is not used, gitit will use a default configuration.+To get a copy of the default configuration file, which you+can customize, just type:++ gitit --print-default-config > my.conf+ The default configuration file is documented with comments throughout. The `static` directory@@ -365,15 +373,18 @@ be slightly different. See the documentation for your VCS for details. +Performance+===========+ Caching-=======+------- By default, gitit does not cache content. If your wiki receives a lot of traffic or contains pages that are slow to render, you may want to activate caching. To do this, set the configuration option `use-cache` to `yes`.-By default, rendered pages and highlighted source files will be cached-in the `cache` directory. (Another directory can be specified by setting-the `cache-dir` configuration option.)+By default, rendered pages, highlighted source files, and exported PDFs+will be cached in the `cache` directory. (Another directory can be+specified by setting the `cache-dir` configuration option.) Cached pages are updated when pages are modified using the web interface. They are not updated when pages are modified directly through@@ -402,6 +413,19 @@ The cache is persistent through restarts of gitit. To expire all cached pages, simply remove the `cache` directory.++Idle+----++By default, GHC's runtime will repeatedly attempt to collect garbage+when an executable like Gitit is idle. This means that gitit will, after+the first page request, never use 0% CPU time and sleep, but will use+~1%. This can be bad for battery life, among other things.++To fix this, one can disable the idle-time GC with the runtime flag+`-I0`:++ gitit -f my.conf +RTS -I0 -RTS Using gitit with apache =======================
data/default.conf view
@@ -31,6 +31,9 @@ # If it does not exist, gitit will create it (with an empty user list). # This file is not used if 'http' is selected for authentication-method. +session-timeout: 60+# number of minutes of inactivity before a session expires.+ static-dir: static # specifies the path of the static directory (containing javascript, # css, and images). If it does not exist, gitit will create it@@ -47,7 +50,7 @@ # rendered correctly if RST is selected. The same goes for LaTeX and # HTML. -math: MathML+math: RawTeX # specifies how LaTeX math is to be displayed. Possible values # are MathML, raw, and jsMath. If mathml is selected, gitit will # convert LaTeX math to MathML and link in a script, MathMLinHTML.js,@@ -125,6 +128,9 @@ max-upload-size: 100K # specifies an upper limit on the size (in bytes) of files uploaded # through the wiki's web interface.+# To disable uploads, set this to 0K.+# This will result in the uploads link disappearing +# and the _upload url becoming inactive. debug-mode: no # if "yes", causes debug information to be logged while gitit is running.@@ -209,3 +215,17 @@ feed-refresh-time: 60 # number of minutes to cache feeds before refreshing++pdf-export: no+# if yes, PDF will appear in export options. PDF will be created using+# pdflatex, which must be installed and in the path. Note that PDF+# exports create significant additional server load.++pandoc-user-data:+# if a directory is specified, this will be searched for pandoc+# customizations. These can include a templates/ directory for custom+# templates for various export formats, an S5 directory for custom+# S5 styles, and a reference.odt for ODT exports. If no directory is+# specified, $HOME/.pandoc will be searched. See pandoc's README for+# more information.+
@@ -7,7 +7,9 @@ <li><a href="$base$/_categories">Categories</a></li> <li><a href="$base$/_random">Random page</a></li> <li><a href="$base$/_activity">Recent activity</a></li>- <li><a href="$base$/_upload">Upload a file</a></li>+ $if(wikiupload)$+ <li><a href="$base$/_upload">Upload a file</a></li>+ $endif$ $if(feed)$ <li><a href="$base$/_feed/" type="application/atom+xml" rel="alternate" title="ATOM Feed">Atom feed</a> <img alt="feed icon" src="$base$/img/icons/feed.png"/></li> $endif$
gitit.cabal view
@@ -1,5 +1,5 @@ name: gitit-version: 0.7.2.1+version: 0.7.3 Cabal-version: >= 1.2 build-type: Simple synopsis: Wiki using happstack, git or darcs, and pandoc.@@ -77,6 +77,7 @@ plugins/WebArchiver.hs, plugins/ShowUser.hs, plugins/Signature.hs,+ plugins/Subst.hs, CHANGES, README.markdown, YUI-LICENSE, BLUETRIP-LICENSE, TANGOICONS Flag plugins@@ -89,8 +90,9 @@ hs-source-dirs: . exposed-modules: Network.Gitit, Network.Gitit.ContentTransformer, Network.Gitit.Types, Network.Gitit.Framework,- Network.Gitit.Initialize, Network.Gitit.Config- other-modules: Network.Gitit.Layout, Network.Gitit.Cache, Network.Gitit.State,+ Network.Gitit.Initialize, Network.Gitit.Config,+ Network.Gitit.Layout+ other-modules: Network.Gitit.Cache, Network.Gitit.State, Paths_gitit, Network.Gitit.Server, Network.Gitit.Export, Network.Gitit.Util, Network.Gitit.Handlers, Network.Gitit.Plugins, Network.Gitit.Authentication, Network.Gitit.Page, Network.Gitit.Feed@@ -98,7 +100,7 @@ exposed-modules: Network.Gitit.Interface build-depends: ghc, ghc-paths cpp-options: -D_PLUGINS- build-depends: base >= 3, pandoc >= 1.4 && < 1.5, filepath, safe+ build-depends: base >= 3, pandoc >= 1.5, filepath, safe extensions: CPP if impl(ghc >= 6.12) ghc-options: -Wall -fno-warn-unused-do-bind@@ -110,14 +112,20 @@ hs-source-dirs: . main-is: gitit.hs build-depends: base >=3 && < 5, parsec < 3, pretty, xhtml, containers,- pandoc >= 1.2, process, filepath, directory, mtl, cgi,- network, old-time, highlighting-kate, bytestring,- utf8-string, SHA > 1, HTTP, HStringTemplate, random,- network >= 2.1.0.0, recaptcha >= 0.1, filestore >= 0.3.4,- datetime, zlib, url, happstack-server >= 0.3.3 && < 0.5,+ pandoc >= 1.5, process, filepath, directory, mtl, cgi,+ network, old-time, highlighting-kate >= 0.2.6, bytestring,+ 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.2, zlib >= 0.5 && < 0.6,+ url >= 2.1 && < 2.2,+ happstack-server >= 0.3.3 && < 0.5, happstack-util >= 0.3.2 && < 0.5, xml >= 1.3.5,- hslogger >= 1 && < 1.1, ConfigFile >= 1, feed >= 0.3.6,- cautious-file >= 0.1.5 && < 0.2, texmath+ hslogger >= 1 && < 1.1, ConfigFile >= 1 && < 1.1,+ feed >= 0.3.6 && < 0.4,+ cautious-file >= 0.1.5 && < 0.2 if impl(ghc >= 6.10) build-depends: base >= 4, syb if flag(plugins)
plugins/CapitalizeEmphasis.hs view
@@ -11,7 +11,7 @@ plugin = mkPageTransform capsTransform capsTransform :: [Inline] -> [Inline]-capsTransform ((Emph x):xs) = processWith capStr x ++ capsTransform xs+capsTransform (Emph x : xs) = processWith capStr x ++ capsTransform xs capsTransform (x:xs) = x : capsTransform xs capsTransform [] = []
plugins/Deprofanizer.hs view
@@ -13,6 +13,6 @@ deprofanize x = x isBadWord :: String -> Bool-isBadWord x = (map toLower x) `elem` ["darn", "blasted", "stinker"]+isBadWord x = map toLower x `elem` ["darn", "blasted", "stinker"] -- there are more, but this is a family program
plugins/Dot.hs view
@@ -13,13 +13,13 @@ -- of the file contents. import Network.Gitit.Interface-import System.Process-import System.Exit+import System.Process (readProcessWithExitCode)+import System.Exit (ExitCode(ExitSuccess)) -- from the utf8-string package on HackageDB: import Data.ByteString.Lazy.UTF8 (fromString) -- from the SHA package on HackageDB:-import Data.Digest.Pure.SHA-import System.FilePath+import Data.Digest.Pure.SHA (sha1, showDigest)+import System.FilePath ((</>)) import Control.Monad.Trans (liftIO) plugin :: Plugin
plugins/ImgTex.hs view
@@ -26,11 +26,8 @@ -} import Network.Gitit.Interface-import Text.Pandoc.Shared import System.Process (system)-import System.Exit import System.Directory-import Data.Char (ord) import Data.ByteString.Lazy.UTF8 (fromString) import Data.Digest.Pure.SHA import System.FilePath@@ -39,22 +36,21 @@ plugin :: Plugin plugin = mkPageTransformM transformBlock -templateHeader =- ( "\\documentclass[12pt]{article}\n"- ++ "\\usepackage{amsmath,amssymb,bm}\n"- ++ "\\begin{document}\n"- ++ "\\thispagestyle{empty}\n"- ++ "\\[\n"- )+templateHeader, templateFooter :: String+templateHeader = concat+ [ "\\documentclass[12pt]{article}\n"+ , "\\usepackage{amsmath,amssymb,bm}\n"+ , "\\begin{document}\n"+ , "\\thispagestyle{empty}\n"+ , "\\[\n"] templateFooter =- ( "\n"+ "\n" ++ "\\]\n" ++ "\\end{document}\n"- ) transformBlock :: Block -> PluginM Block-transformBlock (CodeBlock (id, classes, namevals) contents)+transformBlock (CodeBlock (_, classes, namevals) contents) | "dvipng" `elem` classes = do cfg <- askConfig let (name, outfile) = case lookup "name" namevals of
plugins/Interwiki.hs view
@@ -39,7 +39,7 @@ ('!':interwiki') -> case M.lookup interwiki' interwikiMap of Just url -> case article of- "" -> Link ref (url ++ (inlinesToURL ref), (summary $ unEscapeString $ inlinesToURL ref))+ "" -> Link ref (url ++ inlinesToURL ref, summary $ unEscapeString $ inlinesToURL ref) _ -> Link ref (interwikiurl article url, summary article) Nothing -> Link ref (interwiki, article) where -- 'http://starwars.wikia.com/wiki/Emperor_Palpatine'@@ -61,7 +61,7 @@ ("Hoogle", "http://www.haskell.org/hoogle/?hoogle=")] -- This mapping is derived from <https://secure.wikimedia.org/wikipedia/meta/wiki/Interwiki_map>--- as of 11:19 PM, 11 February 2009.+-- as of 3:16 PM, 7 February 2010. wpInterwikiMap = [ ("AbbeNormal", "http://ourpla.net/cgi/pikie?"), ("Acronym", "http://www.acronymfinder.com/af-query.asp?String=exact&Acronym="), ("Advisory", "http://advisory.wikimedia.org/wiki/"),@@ -81,11 +81,13 @@ ("betawiki", "http://translatewiki.net/wiki/"), ("BibleWiki", "http://bible.tmtm.com/wiki/"), ("BluWiki", "http://www.bluwiki.org/go/"),+ ("BLW", "http://britainloveswikipedia.org/wiki/"), ("Botwiki", "http://botwiki.sno.cc/wiki/"), ("Boxrec", "http://www.boxrec.com/media/index.php?"), ("BrickWiki", "http://brickwiki.org/index.php?title="), ("BridgesWiki", "http://c2.com:8000/"), ("bugzilla", "https://bugzilla.wikimedia.org/show_bug.cgi?id="),+ ("bulba", "http://bulbapedia.bulbagarden.net/wiki/"), ("buzztard", "http://buzztard.org/index.php/"), ("Bytesmiths", "http://www.Bytesmiths.com/wiki/"), ("C2", "http://c2.com/cgi/wiki?"),@@ -112,6 +114,7 @@ ("Consciousness", "http://teadvus.inspiral.org/index.php/"), ("CorpKnowPedia", "http://corpknowpedia.org/wiki/index.php/"), ("CrazyHacks", "http://www.crazy-hacks.org/wiki/index.php?title="),+ ("Creative Commons", "http://www.creativecommons.org/licenses/"), ("CreaturesWiki", "http://creatures.wikia.com/wiki/"), ("CxEJ", "http://esperanto.blahus.cz/cxej/vikio/index.php/"), ("DAwiki", "http://www.dienstag-abend.de/wiki/index.php/"),@@ -149,6 +152,7 @@ ("ELibre", "http://enciclopedia.us.es/index.php/"), ("EmacsWiki", "http://www.emacswiki.org/cgi-bin/wiki.pl?"), ("EnergieWiki", "http://www.netzwerk-energieberater.de/wiki/index.php/"),+ ("Encyc", "http://encyc.org/wiki/"), ("EoKulturCentro", "http://esperanto.toulouse.free.fr/nova/wikini/wakka.php?wiki="), ("Ethnologue", "http://www.ethnologue.com/show_language.asp?code="), ("EvoWiki", "http://wiki.cotch.net/index.php/"),@@ -183,7 +187,8 @@ ("GoogleGroups", "http://groups.google.com/groups?q="), ("GotAMac", "http://www.got-a-mac.org/"), ("GreatLakesWiki", "http://greatlakeswiki.org/index.php/"),- ("Guildwiki", "http://gw.gamewikis.org/wiki/"),+ ("GuildWarsWiki", "http://www.wiki.guildwars.com/wiki/"),+ ("Guildwiki", "http://guildwars.wikia.com/wiki/"), ("gutenberg", "http://www.gutenberg.org/etext/"), ("gutenbergwiki", "http://www.gutenberg.org/wiki/"), ("H2Wiki", "http://halowiki.net/p/"),@@ -228,11 +233,11 @@ ("LiteratePrograms", "http://en.literateprograms.org/"), ("Livepedia", "http://www.livepedia.gr/index.php?title="), ("Lojban", "http://www.lojban.org/tiki/tiki-index.php?page="),- ("Lostpedia", "http://en.lostpedia.com/wiki/"),+ ("Lostpedia", "http://lostpedia.wikia.com/wiki/"), ("LQWiki", "http://wiki.linuxquestions.org/wiki/"), ("LugKR", "http://lug-kr.sourceforge.net/cgi-bin/lugwiki.pl?"), ("Luxo", "http://toolserver.org/~luxo/contributions/contributions.php?user="),- ("lyricwiki", "http://www.lyricwiki.org/"),+ ("lyricwiki", "http://lyrics.wikia.com/"), ("Mail", "https://lists.wikimedia.org/mailman/listinfo/"), ("mailarchive", "http://lists.wikimedia.org/pipermail/"), ("Mariowiki", "http://www.mariowiki.com/"),@@ -249,7 +254,7 @@ ("MozCom", "http://mozilla.wikia.com/wiki/"), ("MozillaWiki", "http://wiki.mozilla.org/"), ("MozillaZineKB", "http://kb.mozillazine.org/"),- ("MusicBrainz", "http://wiki.musicbrainz.org/"),+ ("MusicBrainz", "http://musicbrainz.org/doc/"), ("MW", "http://www.mediawiki.org/wiki/"), ("MWOD", "http://www.merriam-webster.com/cgi-bin/dictionary?book=Dictionary&va="), ("MWOT", "http://www.merriam-webster.com/cgi-bin/thesaurus?book=Thesaurus&va="),@@ -261,8 +266,8 @@ ("OldWikisource", "http://wikisource.org/wiki/"), ("OLPC", "http://wiki.laptop.org/go/"), ("OneLook", "http://www.onelook.com/?ls=b&w="),- ("OpenFacts", "http://openfacts.berlios.de/index.phtml?title="),- ("Openstreetmap", "http://wiki.openstreetmap.org/index.php/"),+ ("OpenFacts", "http://openfacts.berlios.de/index-en.phtml?title="),+ ("Openstreetmap", "http://wiki.openstreetmap.org/wiki/"), ("OpenWetWare", "http://openwetware.org/wiki/"), ("OpenWiki", "http://openwiki.com/?"), ("Opera7Wiki", "http://operawiki.info/"),@@ -270,9 +275,10 @@ ("OrgPatterns", "http://www.bell-labs.com/cgi-user/OrgPatterns/OrgPatterns?"), ("OrthodoxWiki", "http://orthodoxwiki.org/"), ("OSI", "http://wiki.tigma.ee/index.php/"),- ("OTRS", "https://secure.wikimedia.org/otrs/index.pl?Action=AgentTicketZoom&TicketID="),+ ("OTRS", "https://ticket.wikimedia.org/otrs/index.pl?Action=AgentTicketZoom&TicketID="), ("OTRSwiki", "http://otrs-wiki.wikimedia.org/wiki/"), ("OurMedia", "http://www.socialtext.net/ourmedia/index.cgi?"),+ ("OutreachWiki", "http://outreach.wikimedia.org/wiki/"), ("PaganWiki", "http://www.paganwiki.org/wiki/index.php?title="), ("Panawiki", "http://wiki.alairelibre.net/wiki/"), ("PangalacticOrg", "http://www.pangalactic.org/Wiki/"),@@ -286,6 +292,7 @@ ("PMEG", "http://www.bertilow.com/pmeg/.php"), ("PMWiki", "http://old.porplemontage.com/wiki/index.php/"), ("PurlNet", "http://purl.oclc.org/NET/"),+ ("pyrev", "http://svn.wikimedia.org/viewvc/pywikipedia?view=rev&revision="), ("PythonInfo", "http://www.python.org/cgi-bin/moinmoin/"), ("PythonWiki", "http://www.pythonwiki.de/"), ("PyWiki", "http://c2.com/cgi/wiki?"),@@ -306,7 +313,7 @@ ("rtfm", "http://s23.org/wiki/"), ("Scholar", "http://scholar.google.com/scholar?q="), ("SchoolsWP", "http://schools-wikipedia.org/wiki/"),- ("Scores", "http://www.imslp.org/wiki/"),+ ("Scores", "http://imslp.org/wiki/"), ("Scoutwiki", "http://en.scoutwiki.org/"), ("Scramble", "http://www.scramble.nl/wiki/index.php?title="), ("SeaPig", "http://www.seapig.org/"),@@ -315,7 +322,6 @@ ("SLWiki", "http://wiki.secondlife.com/wiki/"), ("SenseisLibrary", "http://senseis.xmp.net/?"), ("silcode", "http://www.sil.org/iso639-3/documentation.asp?id="),- ("Shakti", "http://cgi.algonet.se/htbin/cgiwrap/pgd/ShaktiWiki/"), ("Slashdot", "http://slashdot.org/article.pl?sid="), ("SMikipedia", "http://www.smiki.de/"), ("SourceForge", "http://sourceforge.net/"),@@ -323,6 +329,7 @@ ("Species", "http://species.wikimedia.org/wiki/"), ("Squeak", "http://wiki.squeak.org/squeak/"), ("stable", "http://stable.toolserver.org/"),+ ("Strategy", "http://strategy.wikimedia.org/wiki/"), ("StrategyWiki", "http://strategywiki.org/wiki/"), ("Sulutil", "http://toolserver.org/~vvv/sulutil.php?user="), ("Susning", "http://www.susning.nu/"),@@ -341,10 +348,9 @@ ("Testwiki", "http://test.wikipedia.org/wiki/"), ("Thelemapedia", "http://www.thelemapedia.org/index.php/"), ("Theopedia", "http://www.theopedia.com/"),- ("ThePPN", "http://wiki.theppn.org/"), ("ThinkWiki", "http://www.thinkwiki.org/wiki/"), ("TibiaWiki", "http://tibia.erig.net/"),- ("Ticket", "https://secure.wikimedia.org/otrs/index.pl?Action=AgentTicketZoom&TicketNumber="),+ ("Ticket", "https://ticket.wikimedia.org/otrs/index.pl?Action=AgentTicketZoom&TicketNumber="), ("TMBW", "http://tmbw.net/wiki/"), ("TmNet", "http://www.technomanifestos.net/?"), ("TMwiki", "http://www.EasyTopicMaps.com/?page="),@@ -364,6 +370,7 @@ ("Urbandict", "http://www.urbandictionary.com/define.php?term="), ("USEJ", "http://www.tejo.org/usej/"), ("UseMod", "http://www.usemod.com/cgi-bin/wiki.pl?"),+ ("usability", "http://usability.wikimedia.org/wiki/"), ("ValueWiki", "http://www.valuewiki.com/w/"), ("Veropedia", "http://en.veropedia.com/a/"), ("Vinismo", "http://vinismo.com/en/"),@@ -408,6 +415,7 @@ ("Wikisource", "http://en.wikisource.org/wiki/"), ("Wikispecies", "http://species.wikimedia.org/wiki/"), ("Wikispot", "http://wikispot.org/?action=gotowikipage&v="),+ ("Wikitech", "https://wikitech.wikimedia.org/view/"), ("WikiTI", "http://wikiti.denglend.net/index.php?title="), ("WikiTravel", "http://wikitravel.org/en/"), ("WikiTree", "http://wikitree.org/index.php?title="),@@ -417,16 +425,21 @@ ("Wiktionary", "http://en.wiktionary.org/wiki/"), ("Wipipedia", "http://www.londonfetishscene.com/wipi/index.php/"), ("WLUG", "http://www.wlug.org.nz/"),+ ("wmau", "http://wikimedia.org.au/wiki/"), ("wmcz", "http://meta.wikimedia.org/wiki/Wikimedia_Czech_Republic/"),+ ("wmno", "http://no.wikimedia.org/wiki/"),+ ("wmrs", "http://rs.wikimedia.org/wiki/"),+ ("wmse", "http://se.wikimedia.org/wiki/"),+ ("wmuk", "http://uk.wikimedia.org/wiki/"), ("Wm2005", "http://wikimania2005.wikimedia.org/wiki/"), ("Wm2006", "http://wikimania2006.wikimedia.org/wiki/"), ("Wm2007", "http://wikimania2007.wikimedia.org/wiki/"), ("Wm2008", "http://wikimania2008.wikimedia.org/wiki/"), ("Wm2009", "http://wikimania2009.wikimedia.org/wiki/"),+ ("Wm2010", "http://wikimania2010.wikimedia.org/wiki/"),+ ("Wm2011", "http://wikimania2011.wikimedia.org/wiki/"), ("Wmania", "http://wikimania.wikimedia.org/wiki/"), ("WMF", "http://wikimediafoundation.org/wiki/"),- ("wmse", "http://se.wikimedia.org/wiki/"),- ("wmrs", "http://rs.wikimedia.org/wiki/"), ("Wookieepedia", "http://starwars.wikia.com/wiki/"), ("World66", "http://www.world66.com/"), ("WoWWiki", "http://www.wowwiki.com/"),
plugins/PigLatin.hs view
@@ -21,9 +21,10 @@ Str (cs ++ (c : "ay")) pigLatinStr (Str (c:cs)) | isUpper c && isConsonant c = Str (capitalize cs ++ (toLower c : "ay"))-pigLatinStr (Str x@(c:cs)) | isLetter c = Str (x ++ "yay")+pigLatinStr (Str x@(c:_)) | isLetter c = Str (x ++ "yay") pigLatinStr x = x +isConsonant :: Char -> Bool isConsonant c = c `notElem` "aeiouAEIOU" capitalize :: String -> String
plugins/ShowUser.hs view
@@ -4,7 +4,6 @@ -- user, or the empty string if no one is logged in. import Network.Gitit.Interface-import Data.Maybe (fromMaybe) plugin :: Plugin plugin = mkPageTransformM showuser
plugins/Signature.hs view
@@ -4,9 +4,7 @@ -- of the last edit, prior to saving the page in the repository. import Network.Gitit.Interface-import Data.Maybe (fromMaybe)-import Data.DateTime-import Control.Monad+import Data.DateTime (getCurrentTime, formatDateTime) plugin :: Plugin plugin = PreCommitTransform replacedate@@ -14,12 +12,12 @@ replacedate :: String -> PluginM String replacedate [] = return "" replacedate ('$':'S':'I':'G':'$':xs) = do- datetime <- liftIO $ getCurrentTime+ datetime <- liftIO getCurrentTime mbuser <- askUser let username = case mbuser of Nothing -> "???" Just u -> uUsername u- let sig = "-- " ++ username ++ " (" ++ formatDateTime "%c" datetime ++ ")"- liftM (sig ++ ) $ replacedate xs-replacedate (x:xs) = liftM (x : ) $ replacedate xs+ let sig = concat ["-- ", username, " (", formatDateTime "%c" datetime, ")"]+ fmap (sig ++ ) $ replacedate xs+replacedate (x:xs) = fmap (x : ) $ replacedate xs
+ plugins/Subst.hs view
@@ -0,0 +1,27 @@+-- Usage: a paragraph containing just [My page](!subst)+-- will be replaced by the contents of My page.+--+-- Limitations: it is assumed that My page is+-- formatted with markdown, and contains no metadata.++module Subst (plugin) where++import Data.FileStore (retrieve)+import Text.Pandoc (defaultParserState, readMarkdown)+import Network.Gitit.ContentTransformer (inlinesToString)+import Network.Gitit.Interface+import Network.Gitit.Framework (filestoreFromConfig)++plugin :: Plugin+plugin = mkPageTransformM substituteIntoBlock++substituteIntoBlock :: [Block] -> PluginM [Block]+substituteIntoBlock (Para (Link ref ("!subst", _):_ ):xs) = + do let target = inlinesToString ref ++ ".page"+ cfg <- askConfig+ let fs = filestoreFromConfig cfg+ article <- liftIO (retrieve fs target Nothing)+ let (Pandoc _ content) = readMarkdown defaultParserState article+ (content ++) `fmap` substituteIntoBlock xs+substituteIntoBlock (x:xs) = (x:) `fmap` substituteIntoBlock xs+substituteIntoBlock [] = return []
plugins/WebArchiver.hs view
@@ -49,8 +49,9 @@ ignore = fmap $ const () alexaArchive :: String -> IO ()-alexaArchive url = do let archiveform = Form POST (fromJust $ parseURI "http://www.alexa.com/help/crawlrequest")- [("url", url), ("submit", "")]+alexaArchive url = do let archiveform = Form POST+ (fromJust $ parseURI "http://www.alexa.com/help/crawlrequest")+ [("url", url), ("submit", "")] (uri, resp) <- browse $ request $ formToRequest archiveform when (uriPath uri /= "/help/crawlthanks") $ error $ "Request failed! Did Alexa change webpages? Response:" ++ rspBody resp