gitit-0.7.3.4: Wiki using happstack, git or darcs, and pandoc.Source codeContentsIndex
Network.Gitit.Interface
Description

Interface for plugins.

A plugin is a Haskell module that is dynamically loaded by gitit.

There are three kinds of plugins: PageTransforms, PreParseTransforms, and PreCommitTransforms. These plugins differ chiefly in where they are applied. PreCommitTransform plugins are applied just before changes to a page are saved and may transform the raw source that is saved. PreParseTransform plugins are applied when a page is viewed and may alter the raw page source before it is parsed as a Pandoc document. Finally, PageTransform plugins modify the Pandoc document that results after a page's source is parsed, but before it is converted to HTML:

                 +--------------------------+
                 | edited text from browser |
                 +--------------------------+
                              ||         <----  PreCommitTransform plugins
                              \/
                              ||         <----  saved to repository
                              \/
              +---------------------------------+
              | raw page source from repository |
              +---------------------------------+
                              ||         <----  PreParseTransform plugins
                              \/
                              ||         <----  markdown or RST reader
                              \/
                     +-----------------+
                     | Pandoc document |
                     +-----------------+
                              ||         <---- PageTransform plugins
                              \/
                   +---------------------+
                   | new Pandoc document |
                   +---------------------+
                              ||         <---- HTML writer
                              \/
                   +----------------------+
                   | HTML version of page |
                   +----------------------+

Note that PreParseTransform and PageTransform plugins do not alter the page source stored in the repository. They only affect what is visible on the website. Only PreCommitTransform plugins can alter what is stored in the repository.

Note also that PreParseTransform and PageTransform plugins will not be run when the cached version of a page is used. Plugins can use the doNotCache command to prevent a page from being cached, if their behavior is sensitive to things that might change from one time to another (such as the time or currently logged-in user).

You can use the helper functions mkPageTransform and mkPageTransformM to create PageTransform plugins from a transformation of any of the basic types used by Pandoc (for example, Inline, Block, [Inline], even String). Here is a simple (if silly) example:

 -- Deprofanizer.hs
 module Deprofanizer (plugin) where

 -- This plugin replaces profane words with "XXXXX".

 import Network.Gitit.Interface
 import Data.Char (toLower)

 plugin :: Plugin
 plugin = mkPageTransform deprofanize

 deprofanize :: Inline -> Inline
 deprofanize (Str x) | isBadWord x = Str "XXXXX"
 deprofanize x                     = x

 isBadWord :: String -> Bool
 isBadWord x = (map toLower x) `elem` ["darn", "blasted", "stinker"]
 -- there are more, but this is a family program

Further examples can be found in the plugins directory in the source distribution. If you have installed gitit using Cabal, you can also find them in the directory CABALDIR/share/gitit-X.Y.Z/plugins, where CABALDIR is the cabal install directory and X.Y.Z is the version number of gitit.

Synopsis
data Plugin
= PageTransform (Pandoc -> PluginM Pandoc)
| PreParseTransform (String -> PluginM String)
| PreCommitTransform (String -> PluginM String)
type PluginM = ReaderT PluginData (StateT Context IO)
mkPageTransform :: Data a => (a -> a) -> Plugin
mkPageTransformM :: Data a => (a -> PluginM a) -> Plugin
data Config = Config {
repositoryPath :: FilePath
repositoryType :: FileStoreType
defaultPageType :: PageType
mathMethod :: MathMethod
defaultLHS :: Bool
showLHSBirdTracks :: Bool
withUser :: Handler -> Handler
authHandler :: Handler
userFile :: FilePath
sessionTimeout :: Int
templatesDir :: FilePath
logFile :: FilePath
logLevel :: Priority
staticDir :: FilePath
pluginModules :: [String]
tableOfContents :: Bool
maxUploadSize :: Integer
maxPageSize :: Integer
portNumber :: Int
debugMode :: Bool
frontPage :: String
noEdit :: [String]
noDelete :: [String]
defaultSummary :: String
accessQuestion :: Maybe (String, [String])
useRecaptcha :: Bool
recaptchaPublicKey :: String
recaptchaPrivateKey :: String
compressResponses :: Bool
useCache :: Bool
cacheDir :: FilePath
mimeMap :: Map String String
mailCommand :: String
resetPasswordMessage :: String
markupHelp :: String
useFeed :: Bool
baseUrl :: String
wikiTitle :: String
feedDays :: Integer
feedRefreshTime :: Integer
pdfExport :: Bool
pandocUserData :: Maybe FilePath
}
data Request = Request {
rqMethod :: Method
rqPaths :: [String]
rqUri :: String
rqQuery :: String
rqInputs :: [(String, Input)]
rqCookies :: [(String, Cookie)]
rqVersion :: Version
rqHeaders :: Headers
rqBody :: RqBody
rqPeer :: Host
}
data User = User {
uUsername :: String
uPassword :: Password
uEmail :: String
}
data Context = Context {
ctxFile :: String
ctxLayout :: PageLayout
ctxCacheable :: Bool
ctxTOC :: Bool
ctxBirdTracks :: Bool
ctxCategories :: [String]
ctxMeta :: [(String, String)]
}
data PageType
= Markdown
| RST
| LaTeX
| HTML
data PageLayout = PageLayout {
pgPageName :: String
pgRevision :: Maybe String
pgPrintable :: Bool
pgMessages :: [String]
pgTitle :: String
pgScripts :: [String]
pgShowPageTools :: Bool
pgShowSiteNav :: Bool
pgMarkupHelp :: Maybe String
pgTabs :: [Tab]
pgSelectedTab :: Tab
pgLinkToFeed :: Bool
}
askConfig :: PluginM Config
askUser :: PluginM (Maybe User)
askRequest :: PluginM Request
askFileStore :: PluginM FileStore
askMeta :: PluginM [(String, String)]
doNotCache :: PluginM ()
getContext :: HasContext m => m Context
modifyContext :: HasContext m => (Context -> Context) -> m ()
inlinesToURL :: [Inline] -> String
inlinesToString :: [Inline] -> String
liftIO :: MonadIO m => forall a. IO a -> m a
withTempDir :: FilePath -> (FilePath -> IO a) -> IO a
module Text.Pandoc.Definition
Documentation
data Plugin Source
Constructors
PageTransform (Pandoc -> PluginM Pandoc)
PreParseTransform (String -> PluginM String)
PreCommitTransform (String -> PluginM String)
type PluginM = ReaderT PluginData (StateT Context IO)Source
mkPageTransform :: Data a => (a -> a) -> PluginSource
Lifts a function from a -> a (for example, Inline -> Inline, Block -> Block, [Inline] -> [Inline], or String -> String) to a PageTransform plugin.
mkPageTransformM :: Data a => (a -> PluginM a) -> PluginSource
Monadic version of mkPageTransform. Lifts a function from a -> m a to a PageTransform plugin.
data Config Source
Data structure for information read from config file.
Constructors
Config
repositoryPath :: FilePathPath of repository containing filestore
repositoryType :: FileStoreTypeType of repository
defaultPageType :: PageTypeDefault page markup type for this wiki
mathMethod :: MathMethodHow to handle LaTeX math in pages?
defaultLHS :: BoolTreat as literate haskell by default?
showLHSBirdTracks :: BoolShow Haskell code with bird tracks
withUser :: Handler -> HandlerCombinator to set REMOTE_USER request header
authHandler :: HandlerHandler for login, logout, register, etc.
userFile :: FilePathPath of users database
sessionTimeout :: IntSeconds of inactivity before session expires
templatesDir :: FilePathDirectory containing page templates
logFile :: FilePathPath of server log file
logLevel :: PrioritySeverity filter for log messages (DEBUG, INFO, NOTICE, WARNING, ERROR, CRITICAL, ALERT, EMERGENCY)
staticDir :: FilePathPath of static directory
pluginModules :: [String]Names of plugin modules to load
tableOfContents :: BoolShow table of contents on each page?
maxUploadSize :: IntegerMax size of file uploads
maxPageSize :: IntegerMax size of page uploads
portNumber :: IntPort number to serve content on
debugMode :: BoolPrint debug info to the console?
frontPage :: StringThe front page of the wiki
noEdit :: [String]Pages that cannot be edited via web
noDelete :: [String]Pages that cannot be deleted via web
defaultSummary :: StringDefault summary if description left blank
accessQuestion :: Maybe (String, [String])Nothing = anyone can register. Just (prompt, answers) = a user will be given the prompt and must give one of the answers to register.
useRecaptcha :: BoolUse ReCAPTCHA for user registration.
recaptchaPublicKey :: String
recaptchaPrivateKey :: String
compressResponses :: BoolShould responses be compressed?
useCache :: BoolShould responses be cached?
cacheDir :: FilePathDirectory to hold cached pages
mimeMap :: Map String StringMap associating mime types with file extensions
mailCommand :: StringCommand to send notification emails
resetPasswordMessage :: StringText of password reset email
markupHelp :: StringMarkup syntax help for edit sidebar
useFeed :: BoolProvide an atom feed?
baseUrl :: StringBase URL of wiki, for use in feed
wikiTitle :: StringTitle of wiki, used in feed
feedDays :: IntegerNumber of days history to be included in feed
feedRefreshTime :: IntegerNumber of minutes to cache feeds before refreshing
pdfExport :: BoolAllow PDF export?
pandocUserData :: Maybe FilePathDirectory to search for pandoc customizations
data Request Source
Constructors
Request
rqMethod :: Method
rqPaths :: [String]
rqUri :: String
rqQuery :: String
rqInputs :: [(String, Input)]
rqCookies :: [(String, Cookie)]
rqVersion :: Version
rqHeaders :: Headers
rqBody :: RqBody
rqPeer :: Host
show/hide Instances
data User Source
Constructors
User
uUsername :: String
uPassword :: Password
uEmail :: String
show/hide Instances
data Context Source
Constructors
Context
ctxFile :: String
ctxLayout :: PageLayout
ctxCacheable :: Bool
ctxTOC :: Bool
ctxBirdTracks :: Bool
ctxCategories :: [String]
ctxMeta :: [(String, String)]
data PageType Source
Constructors
Markdown
RST
LaTeX
HTML
show/hide Instances
data PageLayout Source
Abstract representation of page layout (tabs, scripts, etc.)
Constructors
PageLayout
pgPageName :: String
pgRevision :: Maybe String
pgPrintable :: Bool
pgMessages :: [String]
pgTitle :: String
pgScripts :: [String]
pgShowPageTools :: Bool
pgShowSiteNav :: Bool
pgMarkupHelp :: Maybe String
pgTabs :: [Tab]
pgSelectedTab :: Tab
pgLinkToFeed :: Bool
askConfig :: PluginM ConfigSource
Returns the current wiki configuration.
askUser :: PluginM (Maybe User)Source
Returns Just the logged in user, or Nothing if nobody is logged in.
askRequest :: PluginM RequestSource
Returns the complete HTTP request.
askFileStore :: PluginM FileStoreSource
Returns the wiki filestore.
askMeta :: PluginM [(String, String)]Source
Returns the page meta data
doNotCache :: PluginM ()Source
Indicates that the current page or file is not to be cached.
getContext :: HasContext m => m ContextSource
modifyContext :: HasContext m => (Context -> Context) -> m ()Source
inlinesToURL :: [Inline] -> StringSource
Derives a URL from a list of Pandoc Inline elements.
inlinesToString :: [Inline] -> StringSource
Convert a list of inlines into a string.
liftIO :: MonadIO m => forall a. IO a -> m aSource
withTempDir :: FilePath -> (FilePath -> IO a) -> IO aSource
Perform a function in a temporary directory and clean up.
module Text.Pandoc.Definition
Produced by Haddock version 2.7.2