    {-# LANGUAGE CPP #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TypeApplications #-}
    {-
    Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu>,
    Anton van Straaten <anton@appsolutions.com>

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

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

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

    {- Functions for content conversion.
    -}

    module Network.Gitit.ContentTransformer
      (
      -- * ContentTransformer runners
        runPageTransformer
      , runFileTransformer
      -- * Gitit responders
      , showRawPage
      , showFileAsText
      , showPage
      , showHighlightedSource
      , showFile
      , preview
      , applyPreCommitPlugins
      -- * Cache support for transformers
      , cacheHtml
      , cachedHtml
      -- * Content retrieval combinators
      , rawContents
      -- * Response-generating combinators
      , textResponse
      , mimeFileResponse
      , mimeResponse
      , applyWikiTemplate
      -- * Content-type transformation combinators
      , pageToWikiPandoc
      , pageToPandoc
      , pandocToHtml
      , highlightSource
      -- * Content or context augmentation combinators
      , applyPageTransforms
      , wikiDivify
      , addPageTitleToPandoc
      , addMathSupport
      , addScripts
      -- * ContentTransformer context API
      , getFileName
      , getPageName
      , getLayout
      , getParams
      , getCacheable
      -- * Pandoc and wiki content conversion support
      , inlinesToURL
      , inlinesToString
      )
    where

    import qualified Control.Exception as E
    import Control.Monad
    import Control.Monad.State
    import Control.Monad.Reader (ask)
    import Control.Monad.Except (throwError)
    import Data.Foldable (traverse_)
    import Data.List (stripPrefix)
    import Data.Maybe (isNothing, mapMaybe)
    import Network.Gitit.Cache (lookupCache, cacheContents)
    import Network.Gitit.Framework hiding (uriPath)
    import Network.Gitit.Layout
    import Network.Gitit.Page (stringToPage)
    import Network.Gitit.Server
    import Network.Gitit.State
    import Network.Gitit.Types
    import Network.Gitit.Util (getPageTypeDefaultExtensions)
    import Network.HTTP (urlDecode)
    import Network.URI (isUnescapedInURI)
    import Network.URL (encString)
    import System.FilePath
    import qualified Text.Pandoc.Builder as B
    import Text.HTML.SanitizeXSS (sanitizeBalance)
    import Skylighting hiding (Context)
    import Text.Pandoc hiding (MathML, WebTeX, MathJax)
    import URI.ByteString (Query(Query), URIRef(uriPath), laxURIParserOptions,
                           parseURI, uriQuery)
    import qualified Data.Text as T
    import qualified Data.ByteString as S (concat)
    import qualified Data.ByteString.Char8 as SC (pack, unpack)
    import qualified Data.ByteString.Lazy as L (toChunks, fromChunks)
    import qualified Data.FileStore as FS
    import qualified Text.Pandoc as Pandoc
    import Data.String (IsString(fromString))
    import Text.Blaze.Html.Renderer.String as Blaze ( renderHtml )
    import Text.Blaze.Html5 hiding (u, s, contents, source, html, title, map)
    import Text.Blaze.Html5.Attributes hiding (id)
    import qualified Text.Blaze.Html5 as Html5
    import qualified Text.Blaze.Html5.Attributes as Html5.Attr

    --
    -- ContentTransformer runners
    --

    runPageTransformer :: ToMessage a
                   => ContentTransformer a
                   -> GititServerPart a
    runPageTransformer :: forall a. ToMessage a => ContentTransformer a -> GititServerPart a
    runPageTransformer ContentTransformer a
    xform = (Params -> ServerPartT (ReaderT WikiState IO) a)
    -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a r.
    (HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
    (a -> m r) -> m r
    withData ((Params -> ServerPartT (ReaderT WikiState IO) a)
     -> ServerPartT (ReaderT WikiState IO) a)
    -> (Params -> ServerPartT (ReaderT WikiState IO) a)
    -> ServerPartT (ReaderT WikiState IO) a
    forall a b. (a -> b) -> a -> b
    $ \Params
    params -> do
      page <- GititServerPart String
    getPage
      cfg <- getConfig
      evalStateT xform  Context{ ctxFile = pathForPage page (defaultExtension cfg)
                               , ctxLayout = defaultPageLayout{
                                                 pgPageName = page
                                               , pgTitle = page
                                               , pgPrintable = pPrintable params
                                               , pgMessages = pMessages params
                                               , pgRevision = pRevision params
                                               , pgLinkToFeed = useFeed cfg }
                               , ctxCacheable = True
                               , ctxTOC = tableOfContents cfg
                               , ctxBirdTracks = showLHSBirdTracks cfg
                               , ctxCategories = []
                               , ctxMeta = [] }

    runFileTransformer :: ToMessage a
                   => ContentTransformer a
                   -> GititServerPart a
    runFileTransformer :: forall a. ToMessage a => ContentTransformer a -> GititServerPart a
    runFileTransformer ContentTransformer a
    xform = (Params -> ServerPartT (ReaderT WikiState IO) a)
    -> ServerPartT (ReaderT WikiState IO) a
    forall (m :: * -> *) a r.
    (HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
    (a -> m r) -> m r
    withData ((Params -> ServerPartT (ReaderT WikiState IO) a)
     -> ServerPartT (ReaderT WikiState IO) a)
    -> (Params -> ServerPartT (ReaderT WikiState IO) a)
    -> ServerPartT (ReaderT WikiState IO) a
    forall a b. (a -> b) -> a -> b
    $ \Params
    params -> do
      page <- GititServerPart String
    getPage
      cfg <- getConfig
      evalStateT xform  Context{ ctxFile = id page
                               , ctxLayout = defaultPageLayout{
                                                 pgPageName = page
                                               , pgTitle = page
                                               , pgPrintable = pPrintable params
                                               , pgMessages = pMessages params
                                               , pgRevision = pRevision params
                                               , pgLinkToFeed = useFeed cfg }
                               , ctxCacheable = True
                               , ctxTOC = tableOfContents cfg
                               , ctxBirdTracks = showLHSBirdTracks cfg
                               , ctxCategories = []
                               , ctxMeta = [] }

    -- | Converts a @ContentTransformer@ into a @GititServerPart@;
    -- specialized to wiki pages.
    -- runPageTransformer :: ToMessage a
    --                    => ContentTransformer a
    --                    -> GititServerPart a
    -- runPageTransformer = runTransformer pathForPage

    -- | Converts a @ContentTransformer@ into a @GititServerPart@;
    -- specialized to non-pages.
    -- runFileTransformer :: ToMessage a
    --                    => ContentTransformer a
    --                    -> GititServerPart a
    -- runFileTransformer = runTransformer id

    --
    -- Gitit responders
    --

    -- | Responds with raw page source.
    showRawPage :: Handler
    showRawPage :: Handler
    showRawPage = ContentTransformer Response -> Handler
    forall a. ToMessage a => ContentTransformer a -> GititServerPart a
    runPageTransformer ContentTransformer Response
    rawTextResponse

    -- | Responds with raw source (for non-pages such as source
    -- code files).
    showFileAsText :: Handler
    showFileAsText :: Handler
    showFileAsText = ContentTransformer Response -> Handler
    forall a. ToMessage a => ContentTransformer a -> GititServerPart a
    runFileTransformer ContentTransformer Response
    rawTextResponse

    -- | Responds with rendered wiki page.
    showPage :: Handler
    showPage :: Handler
    showPage = ContentTransformer Response -> Handler
    forall a. ToMessage a => ContentTransformer a -> GititServerPart a
    runPageTransformer ContentTransformer Response
    htmlViaPandoc

    -- | Responds with highlighted source code.
    showHighlightedSource :: Handler
    showHighlightedSource :: Handler
    showHighlightedSource = ContentTransformer Response -> Handler
    forall a. ToMessage a => ContentTransformer a -> GititServerPart a
    runFileTransformer ContentTransformer Response
    highlightRawSource

    -- | Responds with non-highlighted source code.
    showFile :: Handler
    showFile :: Handler
    showFile = ContentTransformer Response -> Handler
    forall a. ToMessage a => ContentTransformer a -> GititServerPart a
    runFileTransformer (ContentTransformer (Maybe String)
    rawContents ContentTransformer (Maybe String)
    -> (Maybe String -> ContentTransformer Response)
    -> ContentTransformer Response
    forall a b.
    StateT Context GititServerPart a
    -> (a -> StateT Context GititServerPart b)
    -> StateT Context GititServerPart b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Maybe String -> ContentTransformer Response
    mimeFileResponse)

    -- | Responds with rendered page derived from form data.
    preview :: Handler
    preview :: Handler
    preview = ContentTransformer Response -> Handler
    forall a. ToMessage a => ContentTransformer a -> GititServerPart a
    runPageTransformer (ContentTransformer Response -> Handler)
    -> ContentTransformer Response -> Handler
    forall a b. (a -> b) -> a -> b
    $
              (Params -> String)
    -> StateT Context GititServerPart Params
    -> StateT Context GititServerPart String
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM ((Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\r') (String -> String) -> (Params -> String) -> Params -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Params -> String
    pRaw) StateT Context GititServerPart Params
    getParams StateT Context GititServerPart String
    -> (String -> StateT Context GititServerPart Page)
    -> StateT Context GititServerPart Page
    forall a b.
    StateT Context GititServerPart a
    -> (a -> StateT Context GititServerPart b)
    -> StateT Context GititServerPart b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
              String -> StateT Context GititServerPart Page
    contentsToPage StateT Context GititServerPart Page
    -> (Page -> StateT Context GititServerPart Pandoc)
    -> StateT Context GititServerPart Pandoc
    forall a b.
    StateT Context GititServerPart a
    -> (a -> StateT Context GititServerPart b)
    -> StateT Context GititServerPart b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
              Page -> StateT Context GititServerPart Pandoc
    pageToWikiPandoc StateT Context GititServerPart Pandoc
    -> (Pandoc -> StateT Context GititServerPart Html)
    -> StateT Context GititServerPart Html
    forall a b.
    StateT Context GititServerPart a
    -> (a -> StateT Context GititServerPart b)
    -> StateT Context GititServerPart b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
              Pandoc -> StateT Context GititServerPart Html
    pandocToHtml StateT Context GititServerPart Html
    -> (Html -> ContentTransformer Response)
    -> ContentTransformer Response
    forall a b.
    StateT Context GititServerPart a
    -> (a -> StateT Context GititServerPart b)
    -> StateT Context GititServerPart b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
              Response -> ContentTransformer Response
    forall a. a -> StateT Context GititServerPart a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Response -> ContentTransformer Response)
    -> (Html -> Response) -> Html -> ContentTransformer Response
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Response
    forall a. ToMessage a => a -> Response
    toResponse (String -> Response) -> (Html -> String) -> Html -> Response
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Html -> String
    renderHtml

    -- | Applies pre-commit plugins to raw page source, possibly
    -- modifying it.
    applyPreCommitPlugins :: String -> GititServerPart String
    applyPreCommitPlugins :: String -> GititServerPart String
    applyPreCommitPlugins = StateT Context GititServerPart String -> GititServerPart String
    forall a. ToMessage a => ContentTransformer a -> GititServerPart a
    runPageTransformer (StateT Context GititServerPart String -> GititServerPart String)
    -> (String -> StateT Context GititServerPart String)
    -> String
    -> GititServerPart String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> StateT Context GititServerPart String
    applyPreCommitTransforms

    --
    -- Top level, composed transformers
    --

    -- | Responds with raw source.
    rawTextResponse :: ContentTransformer Response
    rawTextResponse :: ContentTransformer Response
    rawTextResponse = ContentTransformer (Maybe String)
    rawContents ContentTransformer (Maybe String)
    -> (Maybe String -> ContentTransformer Response)
    -> ContentTransformer Response
    forall a b.
    StateT Context GititServerPart a
    -> (a -> StateT Context GititServerPart b)
    -> StateT Context GititServerPart b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Maybe String -> ContentTransformer Response
    textResponse

    -- | Responds with a wiki page. Uses the cache when
    -- possible and caches the rendered page when appropriate.
    htmlViaPandoc :: ContentTransformer Response
    htmlViaPandoc :: ContentTransformer Response
    htmlViaPandoc = ContentTransformer Response
    cachedHtml ContentTransformer Response
    -> ContentTransformer Response -> ContentTransformer Response
    forall a.
    StateT Context GititServerPart a
    -> StateT Context GititServerPart a
    -> StateT Context GititServerPart a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus`
                      (ContentTransformer (Maybe String)
    rawContents ContentTransformer (Maybe String)
    -> (Maybe String -> StateT Context GititServerPart String)
    -> StateT Context GititServerPart String
    forall a b.
    StateT Context GititServerPart a
    -> (a -> StateT Context GititServerPart b)
    -> StateT Context GititServerPart b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                       StateT Context GititServerPart String
    -> (String -> StateT Context GititServerPart String)
    -> Maybe String
    -> StateT Context GititServerPart String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe StateT Context GititServerPart String
    forall a. StateT Context GititServerPart a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero String -> StateT Context GititServerPart String
    forall a. a -> StateT Context GititServerPart a
    forall (m :: * -> *) a. Monad m => a -> m a
    return StateT Context GititServerPart String
    -> (String -> StateT Context GititServerPart Page)
    -> StateT Context GititServerPart Page
    forall a b.
    StateT Context GititServerPart a
    -> (a -> StateT Context GititServerPart b)
    -> StateT Context GititServerPart b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                       String -> StateT Context GititServerPart Page
    contentsToPage StateT Context GititServerPart Page
    -> (Page -> StateT Context GititServerPart (Either Response Page))
    -> StateT Context GititServerPart (Either Response Page)
    forall a b.
    StateT Context GititServerPart a
    -> (a -> StateT Context GititServerPart b)
    -> StateT Context GititServerPart b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                       Page -> StateT Context GititServerPart (Either Response Page)
    handleRedirects StateT Context GititServerPart (Either Response Page)
    -> (Either Response Page -> ContentTransformer Response)
    -> ContentTransformer Response
    forall a b.
    StateT Context GititServerPart a
    -> (a -> StateT Context GititServerPart b)
    -> StateT Context GititServerPart b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                       (Response -> ContentTransformer Response)
    -> (Page -> ContentTransformer Response)
    -> Either Response Page
    -> ContentTransformer Response
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Response -> ContentTransformer Response
    forall a. a -> StateT Context GititServerPart a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
                         (Page -> StateT Context GititServerPart Pandoc
    pageToWikiPandoc (Page -> StateT Context GititServerPart Pandoc)
    -> (Pandoc -> ContentTransformer Response)
    -> Page
    -> ContentTransformer Response
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=>
                          Pandoc -> StateT Context GititServerPart Pandoc
    forall a. a -> StateT Context GititServerPart a
    addMathSupport (Pandoc -> StateT Context GititServerPart Pandoc)
    -> (Pandoc -> ContentTransformer Response)
    -> Pandoc
    -> ContentTransformer Response
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=>
                          Pandoc -> StateT Context GititServerPart Html
    pandocToHtml (Pandoc -> StateT Context GititServerPart Html)
    -> (Html -> ContentTransformer Response)
    -> Pandoc
    -> ContentTransformer Response
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=>
                          Html -> StateT Context GititServerPart Html
    wikiDivify (Html -> StateT Context GititServerPart Html)
    -> (Html -> ContentTransformer Response)
    -> Html
    -> ContentTransformer Response
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=>
                          Html -> ContentTransformer Response
    applyWikiTemplate (Html -> ContentTransformer Response)
    -> (Response -> ContentTransformer Response)
    -> Html
    -> ContentTransformer Response
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=>
                          Response -> ContentTransformer Response
    cacheHtml))

    -- | Responds with highlighted source code in a wiki
    -- page template.  Uses the cache when possible and
    -- caches the rendered page when appropriate.
    highlightRawSource :: ContentTransformer Response
    highlightRawSource :: ContentTransformer Response
    highlightRawSource =
      ContentTransformer Response
    cachedHtml ContentTransformer Response
    -> ContentTransformer Response -> ContentTransformer Response
    forall a.
    StateT Context GititServerPart a
    -> StateT Context GititServerPart a
    -> StateT Context GititServerPart a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus`
        ((PageLayout -> PageLayout) -> ContentTransformer ()
    updateLayout (\PageLayout
    l -> PageLayout
    l { pgTabs = [ViewTab,HistoryTab] }) ContentTransformer ()
    -> ContentTransformer (Maybe String)
    -> ContentTransformer (Maybe String)
    forall a b.
    StateT Context GititServerPart a
    -> StateT Context GititServerPart b
    -> StateT Context GititServerPart b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >>
         ContentTransformer (Maybe String)
    rawContents ContentTransformer (Maybe String)
    -> (Maybe String -> StateT Context GititServerPart Html)
    -> StateT Context GititServerPart Html
    forall a b.
    StateT Context GititServerPart a
    -> (a -> StateT Context GititServerPart b)
    -> StateT Context GititServerPart b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
         Maybe String -> StateT Context GititServerPart Html
    highlightSource StateT Context GititServerPart Html
    -> (Html -> ContentTransformer Response)
    -> ContentTransformer Response
    forall a b.
    StateT Context GititServerPart a
    -> (a -> StateT Context GititServerPart b)
    -> StateT Context GititServerPart b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
         Html -> ContentTransformer Response
    applyWikiTemplate ContentTransformer Response
    -> (Response -> ContentTransformer Response)
    -> ContentTransformer Response
    forall a b.
    StateT Context GititServerPart a
    -> (a -> StateT Context GititServerPart b)
    -> StateT Context GititServerPart b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
         Response -> ContentTransformer Response
    cacheHtml)

    --
    -- Cache support for transformers
    --

    -- | 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 :: Response -> ContentTransformer Response
    cacheHtml Response
    resp' = do
      params <- StateT Context GititServerPart 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'

    -- | Returns cached page if available, otherwise mzero.
    cachedHtml :: ContentTransformer Response
    cachedHtml :: ContentTransformer Response
    cachedHtml = do
      file <- StateT Context GititServerPart String
    getFileName
      params <- getParams
      cfg <- lift getConfig
      if useCache cfg && not (pPrintable params) && isNothing (pRevision params)
         then do mbCached <- lift $ lookupCache file
                 let emptyResponse = String -> Response -> Response
    setContentType String
    "text/html; charset=utf-8" (Response -> Response) -> (() -> Response) -> () -> Response
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . () -> Response
    forall a. ToMessage a => a -> Response
    toResponse (() -> Response) -> () -> Response
    forall a b. (a -> b) -> a -> b
    $ ()
                 maybe mzero (\(UTCTime
    _modtime, ByteString
    contents) -> Handler -> ContentTransformer Response
    forall (m :: * -> *) a. Monad m => m a -> StateT Context m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Handler -> ContentTransformer Response)
    -> (Response -> Handler) -> Response -> ContentTransformer Response
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Response -> Handler
    forall (m :: * -> *) a. FilterMonad Response m => a -> m a
    ok (Response -> ContentTransformer Response)
    -> Response -> ContentTransformer Response
    forall a b. (a -> b) -> a -> b
    $ Response
    emptyResponse{rsBody = L.fromChunks [contents]}) mbCached
         else mzero

    --
    -- Content retrieval combinators
    --

    -- | Returns raw file contents.
    rawContents :: ContentTransformer (Maybe String)
    rawContents :: ContentTransformer (Maybe String)
    rawContents = do
      params <- StateT Context GititServerPart Params
    getParams
      file <- getFileName
      fs <- lift getFileStore
      let rev = Params -> Maybe String
    pRevision Params
    params
      liftIO $ E.catch (liftM Just $ FS.retrieve fs file rev)
                   (\FileStoreError
    e -> if FileStoreError
    e FileStoreError -> FileStoreError -> Bool
    forall a. Eq a => a -> a -> Bool
    == FileStoreError
    FS.NotFound then Maybe String -> IO (Maybe String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe String
    forall a. Maybe a
    Nothing else FileStoreError -> IO (Maybe String)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO FileStoreError
    e)

    --
    -- Response-generating combinators
    --

    -- | Converts raw contents to a text/plain response.
    textResponse :: Maybe String -> ContentTransformer Response
    textResponse :: Maybe String -> ContentTransformer Response
    textResponse Maybe String
    Nothing  = ContentTransformer Response
    forall a. StateT Context GititServerPart a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero  -- fail quietly if file not found
    textResponse (Just String
    c) = String -> String -> ContentTransformer Response
    forall (m :: * -> *). Monad m => String -> String -> m Response
    mimeResponse String
    c String
    "text/plain; charset=utf-8"

    -- | Converts raw contents to a response that is appropriate with
    -- a mime type derived from the page's extension.
    mimeFileResponse :: Maybe String -> ContentTransformer Response
    mimeFileResponse :: Maybe String -> ContentTransformer Response
    mimeFileResponse Maybe String
    Nothing = String -> ContentTransformer Response
    forall a. HasCallStack => String -> a
    error String
    "Unable to retrieve file contents."
    mimeFileResponse (Just String
    c) =
      String -> String -> ContentTransformer Response
    forall (m :: * -> *). Monad m => String -> String -> m Response
    mimeResponse String
    c (String -> ContentTransformer Response)
    -> StateT Context GititServerPart String
    -> ContentTransformer Response
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< GititServerPart String -> StateT Context GititServerPart String
    forall (m :: * -> *) a. Monad m => m a -> StateT Context m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (GititServerPart String -> StateT Context GititServerPart String)
    -> (String -> GititServerPart String)
    -> String
    -> StateT Context GititServerPart String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> GititServerPart String
    getMimeTypeForExtension (String -> GititServerPart String)
    -> (String -> String) -> String -> GititServerPart String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    takeExtension (String -> StateT Context GititServerPart String)
    -> StateT Context GititServerPart String
    -> StateT Context GititServerPart String
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< StateT Context GititServerPart String
    getFileName

    mimeResponse :: Monad m
                 => String        -- ^ Raw contents for response body
                 -> String        -- ^ Mime type
                 -> m Response
    mimeResponse :: forall (m :: * -> *). Monad m => String -> String -> m Response
    mimeResponse String
    c String
    mimeType =
      Response -> m Response
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Response -> m Response)
    -> (String -> Response) -> String -> m Response
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Response -> Response
    setContentType String
    mimeType (Response -> Response)
    -> (String -> Response) -> String -> Response
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Response
    forall a. ToMessage a => a -> Response
    toResponse (String -> m Response) -> String -> m Response
    forall a b. (a -> b) -> a -> b
    $ String
    c

    -- | Adds the sidebar, page tabs, and other elements of the wiki page
    -- layout to the raw content.
    applyWikiTemplate :: Html -> ContentTransformer Response
    applyWikiTemplate :: Html -> ContentTransformer Response
    applyWikiTemplate Html
    c = do
      Context { ctxLayout = layout } <- StateT Context GititServerPart Context
    forall s (m :: * -> *). MonadState s m => m s
    get
      lift $ formattedPage layout c

    --
    -- Content-type transformation combinators
    --

    -- | Converts Page to Pandoc, applies page transforms, and adds page
    -- title.
    pageToWikiPandoc :: Page -> ContentTransformer Pandoc
    pageToWikiPandoc :: Page -> StateT Context GititServerPart Pandoc
    pageToWikiPandoc Page
    page' =
      Page -> StateT Context GititServerPart Pandoc
    pageToWikiPandoc' Page
    page' StateT Context GititServerPart Pandoc
    -> (Pandoc -> StateT Context GititServerPart Pandoc)
    -> StateT Context GititServerPart Pandoc
    forall a b.
    StateT Context GititServerPart a
    -> (a -> StateT Context GititServerPart b)
    -> StateT Context GititServerPart b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= String -> Pandoc -> StateT Context GititServerPart Pandoc
    addPageTitleToPandoc (Page -> String
    pageTitle Page
    page')

    pageToWikiPandoc' :: Page -> ContentTransformer Pandoc
    pageToWikiPandoc' :: Page -> StateT Context GititServerPart Pandoc
    pageToWikiPandoc' = Page -> StateT Context GititServerPart Page
    applyPreParseTransforms (Page -> StateT Context GititServerPart Page)
    -> (Page -> StateT Context GititServerPart Pandoc)
    -> Page
    -> StateT Context GititServerPart Pandoc
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=>
                         Page -> StateT Context GititServerPart Pandoc
    pageToPandoc (Page -> StateT Context GititServerPart Pandoc)
    -> (Pandoc -> StateT Context GititServerPart Pandoc)
    -> Page
    -> StateT Context GititServerPart Pandoc
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Pandoc -> StateT Context GititServerPart Pandoc
    applyPageTransforms

    -- | Converts source text to Pandoc using default page type.
    pageToPandoc :: Page -> ContentTransformer Pandoc
    pageToPandoc :: Page -> StateT Context GititServerPart Pandoc
    pageToPandoc Page
    page' = do
      (Context -> Context) -> ContentTransformer ()
    forall (m :: * -> *). HasContext m => (Context -> Context) -> m ()
    modifyContext ((Context -> Context) -> ContentTransformer ())
    -> (Context -> Context) -> ContentTransformer ()
    forall a b. (a -> b) -> a -> b
    $ \Context
    ctx -> Context
    ctx{ ctxTOC = pageTOC page'
                                 , ctxCategories = pageCategories page'
                                 , ctxMeta = pageMeta page' }
      (PandocError -> StateT Context GititServerPart Pandoc)
    -> (Pandoc -> StateT Context GititServerPart Pandoc)
    -> Either PandocError Pandoc
    -> StateT Context GititServerPart Pandoc
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (IO Pandoc -> StateT Context GititServerPart Pandoc
    forall a. IO a -> StateT Context GititServerPart a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Pandoc -> StateT Context GititServerPart Pandoc)
    -> (PandocError -> IO Pandoc)
    -> PandocError
    -> StateT Context GititServerPart Pandoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PandocError -> IO Pandoc
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO) Pandoc -> StateT Context GititServerPart Pandoc
    forall a. a -> StateT Context GititServerPart a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either PandocError Pandoc
     -> StateT Context GititServerPart Pandoc)
    -> Either PandocError Pandoc
    -> StateT Context GititServerPart Pandoc
    forall a b. (a -> b) -> a -> b
    $ PageType -> Bool -> String -> Either PandocError Pandoc
    readerFor (Page -> PageType
    pageFormat Page
    page') (Page -> Bool
    pageLHS Page
    page') (Page -> String
    pageText Page
    page')

    data WasRedirect = WasRedirect | WasNoRedirect

    -- | Detects if the page is a redirect page and handles accordingly. The exact
    -- behaviour is as follows:
    --
    -- If the page is /not/ a redirect page (the most common case), then check the
    -- referer to see if the client came to this page as a result of a redirect
    -- from another page. If so, then add a notice to the messages to notify the
    -- user that they were redirected from another page, and provide a link back
    -- to the original page, with an extra parameter to disable redirection
    -- (e.g., to allow the original page to be edited).
    --
    -- If the page /is/ a redirect page, then check the query string for the
    -- @redirect@ parameter. This can modify the behaviour of the redirect as
    -- follows:
    --
    -- 1. If the @redirect@ parameter is unset, then check the referer to see if
    --    client came to this page as a result of a redirect from another page. If
    --    so, then do not redirect, and add a notice to the messages explaining
    --    that this page is a redirect page, that would have redirected to the
    --    destination given in the metadata (and provide a link thereto), but this
    --    was stopped because a double-redirect was detected. This is a simple way
    --    to prevent cyclical redirects and other abuses enabled by redirects.
    --    redirect to the same page. If the client did /not/ come to this page as
    --    a result of a redirect, then redirect back to the same page, except with
    --    the redirect parameter set to @\"yes\"@.
    --
    -- 2. If the @redirect@ parameter is set to \"yes\", then redirect to the
    --    destination specified in the metadata. This uses a client-side (meta
    --    refresh + javascript backup) redirect to make sure the referer is set to
    --    this URL.
    --
    -- 3. If the @redirect@ parameter is set to \"no\", then do not redirect, but
    --    add a notice to the messages that this page /would/ have redirected to
    --    the destination given in the metadata had it not been disabled, and
    --    provide a link to the destination given in the metadata. This behaviour
    --    is the @revision@ parameter is present in the query string.
    handleRedirects :: Page -> ContentTransformer (Either Response Page)
    handleRedirects :: Page -> StateT Context GititServerPart (Either Response Page)
    handleRedirects Page
    page = case String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    "redirect" (Page -> [(String, String)]
    pageMeta Page
    page) of
        Maybe String
    Nothing -> StateT Context GititServerPart (Either Response Page)
    forall {a}. StateT Context GititServerPart (Either a Page)
    isn'tRedirect
        Just String
    destination -> String -> StateT Context GititServerPart (Either Response Page)
    isRedirect String
    destination
      where
        addMessage :: Html -> m ()
    addMessage Html
    message = (Context -> Context) -> m ()
    forall (m :: * -> *). HasContext m => (Context -> Context) -> m ()
    modifyContext ((Context -> Context) -> m ()) -> (Context -> Context) -> m ()
    forall a b. (a -> b) -> a -> b
    $ \Context
    context -> Context
    context
            { ctxLayout = (ctxLayout context)
                { pgMessages = pgMessages (ctxLayout context) ++ [renderHtml message]
                }
            }
        redirectedFrom :: String -> m Html
    redirectedFrom String
    source = do
            (url, html) <- String -> m (WasRedirect -> AttributeValue, Html)
    forall {m :: * -> *}.
    ServerMonad m =>
    String -> m (WasRedirect -> AttributeValue, Html)
    processSource String
    source
            return $ mconcat
                [ "Redirected from ",
                   a ! href (url WasNoRedirect) ! title "Go to original page" $ html
                ]
        doubleRedirect :: String -> String -> m Html
    doubleRedirect String
    source String
    destination = do
            (url, html) <- String -> m (WasRedirect -> AttributeValue, Html)
    forall {m :: * -> *}.
    ServerMonad m =>
    String -> m (WasRedirect -> AttributeValue, Html)
    processSource String
    source
            (url', html') <- processDestination destination
            return $ mconcat
                [ "This page normally redirects to "
                , a ! href (fromString $ url' WasRedirect) ! title "Continue to destination" $ html'
                , ", but as you were already redirected from "
                , a ! href (url WasNoRedirect) ! title "Go to original page" $ html
                , ", this was stopped to prevent a double-redirect."
                ]
        cancelledRedirect :: String -> m Html
    cancelledRedirect String
    destination = do
            (url', html') <- String -> m (WasRedirect -> String, Html)
    forall {m :: * -> *}.
    ServerMonad m =>
    String -> m (WasRedirect -> String, Html)
    processDestination String
    destination
            return $ mconcat
                [ "This page redirects to "
                , a ! href (fromString $ url' WasRedirect) ! title "Continue to destination" $ html'
                ]
        processSource :: String -> m (WasRedirect -> AttributeValue, Html)
    processSource String
    source = do
            base' <- m String
    forall (m :: * -> *). ServerMonad m => m String
    getWikiBase
            let url WasRedirect
    redir = forall a. IsString a => String -> a
    fromString @AttributeValue (String -> AttributeValue) -> String -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $
                  String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    urlForPage String
    source String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ case WasRedirect
    redir of
                    WasRedirect
    WasNoRedirect -> String
    "?redirect=no"
                    WasRedirect
    WasRedirect -> String
    ""
            let html = forall a. IsString a => String -> a
    fromString @Html String
    source
            return (url, html)
        processDestination :: String -> m (WasRedirect -> String, Html)
    processDestination String
    destination = do
            base' <- m String
    forall (m :: * -> *). ServerMonad m => m String
    getWikiBase
            let (page', fragment) = break (== '#') destination
            let url WasRedirect
    redir = [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
                 [ String
    base'
                 , String -> String
    urlForPage String
    page'
                 , String
    fragment

                 ] String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ case WasRedirect
    redir of
                    WasRedirect
    WasNoRedirect -> String
    "?redirect=no"
                    WasRedirect
    WasRedirect -> String
    ""
            let html = forall a. IsString a => String -> a
    fromString @Html String
    page'
            return (url, html)
        getSource :: ContentTransformer (Maybe String)
    getSource = do
            cfg <- GititServerPart Config -> StateT Context GititServerPart Config
    forall (m :: * -> *) a. Monad m => m a -> StateT Context m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift GititServerPart Config
    getConfig
            base' <- getWikiBase
            request <- askRq
            return $ do
                referer <- getHeader "referer" request
                uri <- case parseURI laxURIParserOptions referer of
                    Left URIParseError
    _ -> Maybe (URIRef Absolute)
    forall a. Maybe a
    Nothing
                    Right URIRef Absolute
    uri -> URIRef Absolute -> Maybe (URIRef Absolute)
    forall a. a -> Maybe a
    Just URIRef Absolute
    uri
                let Query params = uriQuery uri
                redirect' <- lookup (SC.pack "redirect") params
                guard $ redirect' == SC.pack "yes"
                path' <- stripPrefix (base' ++ "/") (SC.unpack (uriPath uri))
                let path'' = if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    path' then Config -> String
    frontPage Config
    cfg else String -> String
    urlDecode String
    path'
                guard $ isPage path''
                return path''
        withBody :: String -> Response
    withBody = String -> Response -> Response
    setContentType String
    "text/html; charset=utf-8" (Response -> Response)
    -> (String -> Response) -> String -> Response
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Response
    forall a. ToMessage a => a -> Response
    toResponse
        isn'tRedirect :: StateT Context GititServerPart (Either a Page)
    isn'tRedirect = do
            ContentTransformer (Maybe String)
    getSource ContentTransformer (Maybe String)
    -> (Maybe String -> ContentTransformer ()) -> ContentTransformer ()
    forall a b.
    StateT Context GititServerPart a
    -> (a -> StateT Context GititServerPart b)
    -> StateT Context GititServerPart b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (String -> ContentTransformer ())
    -> Maybe String -> ContentTransformer ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ (String -> StateT Context GititServerPart Html
    forall {m :: * -> *}. ServerMonad m => String -> m Html
    redirectedFrom (String -> StateT Context GititServerPart Html)
    -> (Html -> ContentTransformer ())
    -> String
    -> ContentTransformer ()
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Html -> ContentTransformer ()
    forall {m :: * -> *}. HasContext m => Html -> m ()
    addMessage)
            Either a Page -> StateT Context GititServerPart (Either a Page)
    forall a. a -> StateT Context GititServerPart a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Page -> Either a Page
    forall a b. b -> Either a b
    Right Page
    page)
        isRedirect :: String -> StateT Context GititServerPart (Either Response Page)
    isRedirect String
    destination = do
            params <- StateT Context GititServerPart Params
    getParams
            case maybe (pRedirect params) (\String
    _ -> Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    False) (pRevision params) of
                 Maybe Bool
    Nothing -> do
                    source <- ContentTransformer (Maybe String)
    getSource
                    case source of
                         Just String
    source' -> do
                            String -> String -> StateT Context GititServerPart Html
    forall {m :: * -> *}. ServerMonad m => String -> String -> m Html
    doubleRedirect String
    source' String
    destination StateT Context GititServerPart Html
    -> (Html -> ContentTransformer ()) -> ContentTransformer ()
    forall a b.
    StateT Context GititServerPart a
    -> (a -> StateT Context GititServerPart b)
    -> StateT Context GititServerPart b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Html -> ContentTransformer ()
    forall {m :: * -> *}. HasContext m => Html -> m ()
    addMessage
                            Either Response Page
    -> StateT Context GititServerPart (Either Response Page)
    forall a. a -> StateT Context GititServerPart a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Page -> Either Response Page
    forall a b. b -> Either a b
    Right Page
    page)
                         Maybe String
    Nothing -> (Response -> Either Response Page)
    -> ContentTransformer Response
    -> StateT Context GititServerPart (Either Response Page)
    forall a b.
    (a -> b)
    -> StateT Context GititServerPart a
    -> StateT Context GititServerPart b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Response -> Either Response Page
    forall a b. a -> Either a b
    Left (ContentTransformer Response
     -> StateT Context GititServerPart (Either Response Page))
    -> ContentTransformer Response
    -> StateT Context GititServerPart (Either Response Page)
    forall a b. (a -> b) -> a -> b
    $ do
                            base' <- StateT Context GititServerPart String
    forall (m :: * -> *). ServerMonad m => m String
    getWikiBase
                            let url' = [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
                                 [ String
    base'
                                 , String -> String
    urlForPage (Page -> String
    pageName Page
    page)
                                 , String
    "?redirect=yes"
                                 ]
                            lift $ seeOther url' $ withBody $ renderHtml $ docTypeHtml $ mconcat
                                [ Html5.head $ Html5.title "307 Redirect"
                                , Html5.body $ p $ mconcat [
                                    "You are being",
                                    a ! href (fromString url') $ "redirected."
                                  ]
                                ]
                 Just Bool
    True -> (Response -> Either Response Page)
    -> ContentTransformer Response
    -> StateT Context GititServerPart (Either Response Page)
    forall a b.
    (a -> b)
    -> StateT Context GititServerPart a
    -> StateT Context GititServerPart b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Response -> Either Response Page
    forall a b. a -> Either a b
    Left (ContentTransformer Response
     -> StateT Context GititServerPart (Either Response Page))
    -> ContentTransformer Response
    -> StateT Context GititServerPart (Either Response Page)
    forall a b. (a -> b) -> a -> b
    $ do
                    (url', html') <- String
    -> StateT Context GititServerPart (WasRedirect -> String, Html)
    forall {m :: * -> *}.
    ServerMonad m =>
    String -> m (WasRedirect -> String, Html)
    processDestination String
    destination
                    lift $ ok $ withBody $ renderHtml $ docTypeHtml $ mconcat
                        [ Html5.head $ mconcat
                            [ Html5.title $ "Redirecting to" <> html'
                            , meta ! httpEquiv "refresh" ! content (fromString $ "0; url=" <> url' WasRedirect)
                            , script ! type_ "text/javascript" $ fromString $ "window.location=\"" <> url' WasRedirect <> "\""
                            ],
                          Html5.body $ p $ mconcat
                            [ "Redirecting to "
                            , a ! href (fromString $ url' WasRedirect) $ html'
                            ]
                        ]
                 Just Bool
    False -> do
                    String -> StateT Context GititServerPart Html
    forall {m :: * -> *}. ServerMonad m => String -> m Html
    cancelledRedirect String
    destination StateT Context GititServerPart Html
    -> (Html -> ContentTransformer ()) -> ContentTransformer ()
    forall a b.
    StateT Context GititServerPart a
    -> (a -> StateT Context GititServerPart b)
    -> StateT Context GititServerPart b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Html -> ContentTransformer ()
    forall {m :: * -> *}. HasContext m => Html -> m ()
    addMessage
                    Either Response Page
    -> StateT Context GititServerPart (Either Response Page)
    forall a. a -> StateT Context GititServerPart a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Page -> Either Response Page
    forall a b. b -> Either a b
    Right Page
    page)

    -- | Converts contents of page file to Page object.
    contentsToPage :: String -> ContentTransformer Page
    contentsToPage :: String -> StateT Context GititServerPart Page
    contentsToPage String
    s = do
      cfg <- GititServerPart Config -> StateT Context GititServerPart Config
    forall (m :: * -> *) a. Monad m => m a -> StateT Context m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift GititServerPart Config
    getConfig
      pn <- getPageName
      return $ stringToPage cfg pn s

    -- | Converts pandoc document to HTML.
    pandocToHtml :: Pandoc -> ContentTransformer Html
    pandocToHtml :: Pandoc -> StateT Context GititServerPart Html
    pandocToHtml Pandoc
    pandocContents = do
      toc <- (Context -> Bool)
    -> StateT Context GititServerPart Context
    -> ContentTransformer Bool
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Context -> Bool
    ctxTOC StateT Context GititServerPart Context
    forall s (m :: * -> *). MonadState s m => m s
    get
      bird <- liftM ctxBirdTracks get
      cfg <- lift getConfig
      let tpl = Text
    "$if(toc)$<div id=\"TOC\">\n$toc$\n</div>\n$endif$\n$body$"
      compiledTemplate <- liftIO $ runIOorExplode $ do
        res <- runWithDefaultPartials $ compileTemplate "toc" tpl
        case res of
          Right Template Text
    t -> Template Text -> PandocIO (Template Text)
    forall a. a -> PandocIO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Template Text
    t
          Left String
    e  -> PandocError -> PandocIO (Template Text)
    forall a. PandocError -> PandocIO a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError -> PandocIO (Template Text))
    -> PandocError -> PandocIO (Template Text)
    forall a b. (a -> b) -> a -> b
    $ Text -> PandocError
    PandocTemplateError (Text -> PandocError) -> Text -> PandocError
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack String
    e
      return $ preEscapedToHtml @T.Text .
               (if xssSanitize cfg then sanitizeBalance else id) $
               either E.throw id . runPure $ writeHtml5String def{
                            writerTemplate = Just compiledTemplate
                          , writerHTMLMathMethod =
                                case mathMethod cfg of
                                     MathMethod
    MathML -> HTMLMathMethod
    Pandoc.MathML
                                     WebTeX String
    u -> Text -> HTMLMathMethod
    Pandoc.WebTeX (Text -> HTMLMathMethod) -> Text -> HTMLMathMethod
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack String
    u
                                     MathJax String
    u -> Text -> HTMLMathMethod
    Pandoc.MathJax (Text -> HTMLMathMethod) -> Text -> HTMLMathMethod
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack String
    u
                                     MathMethod
    RawTeX -> HTMLMathMethod
    Pandoc.PlainMath
                          , writerTableOfContents = toc
    #if MIN_VERSION_pandoc(3,8,0)
                          , writerHighlightMethod = Skylighting pygments
    #else
                          , writerHighlightStyle = Just pygments
    #endif
                          , writerExtensions = if bird
                                                  then enableExtension Ext_literate_haskell
                                                       $ writerExtensions def
                                                  else writerExtensions def
                          -- note: javascript obfuscation gives problems on preview
                          , writerEmailObfuscation = ReferenceObfuscation
                          } pandocContents

    -- | Returns highlighted source code.
    highlightSource :: Maybe String -> ContentTransformer Html
    highlightSource :: Maybe String -> StateT Context GititServerPart Html
    highlightSource Maybe String
    Nothing = StateT Context GititServerPart Html
    forall a. StateT Context GititServerPart a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
    highlightSource (Just String
    source) = do
      file <- StateT Context GititServerPart String
    getFileName
      let formatOpts = FormatOptions
    defaultFormatOpts { numberLines = True, lineAnchors = True }
      case syntaxesByFilename defaultSyntaxMap file of
            []    -> StateT Context GititServerPart Html
    forall a. StateT Context GititServerPart a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero
            (Syntax
    l:[Syntax]
    _) -> case TokenizerConfig -> Syntax -> Text -> Either String [SourceLine]
    tokenize TokenizerConfig{
                                  syntaxMap :: SyntaxMap
    syntaxMap = SyntaxMap
    defaultSyntaxMap
                                , traceOutput :: Bool
    traceOutput = Bool
    False} Syntax
    l
                            (Text -> Either String [SourceLine])
    -> Text -> Either String [SourceLine]
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /=Char
    '\r') String
    source of
                        Left String
    e ->  String -> StateT Context GititServerPart Html
    forall a. String -> StateT Context GititServerPart a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> String
    forall a. Show a => a -> String
    show String
    e)
                        Right [SourceLine]
    r -> Html -> StateT Context GititServerPart Html
    forall a. a -> StateT Context GititServerPart a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Html -> StateT Context GititServerPart Html)
    -> Html -> StateT Context GititServerPart Html
    forall a b. (a -> b) -> a -> b
    $ FormatOptions -> [SourceLine] -> Html
    formatHtmlBlock FormatOptions
    formatOpts [SourceLine]
    r

    --
    -- Plugin combinators
    --

    getPageTransforms :: ContentTransformer [Pandoc -> PluginM Pandoc]
    getPageTransforms :: ContentTransformer [Pandoc -> PluginM Pandoc]
    getPageTransforms = ([Plugin] -> [Pandoc -> PluginM Pandoc])
    -> StateT Context GititServerPart [Plugin]
    -> ContentTransformer [Pandoc -> PluginM Pandoc]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM ((Plugin -> Maybe (Pandoc -> PluginM Pandoc))
    -> [Plugin] -> [Pandoc -> PluginM Pandoc]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Plugin -> Maybe (Pandoc -> PluginM Pandoc)
    pageTransform) (StateT Context GititServerPart [Plugin]
     -> ContentTransformer [Pandoc -> PluginM Pandoc])
    -> StateT Context GititServerPart [Plugin]
    -> ContentTransformer [Pandoc -> PluginM Pandoc]
    forall a b. (a -> b) -> a -> b
    $ (GititState -> [Plugin]) -> StateT Context GititServerPart [Plugin]
    forall (m :: * -> *) a. MonadIO m => (GititState -> a) -> m a
    queryGititState GititState -> [Plugin]
    plugins
      where pageTransform :: Plugin -> Maybe (Pandoc -> PluginM Pandoc)
    pageTransform (PageTransform Pandoc -> PluginM Pandoc
    x) = (Pandoc -> PluginM Pandoc) -> Maybe (Pandoc -> PluginM Pandoc)
    forall a. a -> Maybe a
    Just Pandoc -> PluginM Pandoc
    x
            pageTransform Plugin
    _                 = Maybe (Pandoc -> PluginM Pandoc)
    forall a. Maybe a
    Nothing

    getPreParseTransforms :: ContentTransformer [String -> PluginM String]
    getPreParseTransforms :: ContentTransformer [String -> PluginM String]
    getPreParseTransforms = ([Plugin] -> [String -> PluginM String])
    -> StateT Context GititServerPart [Plugin]
    -> ContentTransformer [String -> PluginM String]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM ((Plugin -> Maybe (String -> PluginM String))
    -> [Plugin] -> [String -> PluginM String]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Plugin -> Maybe (String -> PluginM String)
    preParseTransform) (StateT Context GititServerPart [Plugin]
     -> ContentTransformer [String -> PluginM String])
    -> StateT Context GititServerPart [Plugin]
    -> ContentTransformer [String -> PluginM String]
    forall a b. (a -> b) -> a -> b
    $
                              (GititState -> [Plugin]) -> StateT Context GititServerPart [Plugin]
    forall (m :: * -> *) a. MonadIO m => (GititState -> a) -> m a
    queryGititState GititState -> [Plugin]
    plugins
      where preParseTransform :: Plugin -> Maybe (String -> PluginM String)
    preParseTransform (PreParseTransform String -> PluginM String
    x) = (String -> PluginM String) -> Maybe (String -> PluginM String)
    forall a. a -> Maybe a
    Just String -> PluginM String
    x
            preParseTransform Plugin
    _                     = Maybe (String -> PluginM String)
    forall a. Maybe a
    Nothing

    getPreCommitTransforms :: ContentTransformer [String -> PluginM String]
    getPreCommitTransforms :: ContentTransformer [String -> PluginM String]
    getPreCommitTransforms = ([Plugin] -> [String -> PluginM String])
    -> StateT Context GititServerPart [Plugin]
    -> ContentTransformer [String -> PluginM String]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM ((Plugin -> Maybe (String -> PluginM String))
    -> [Plugin] -> [String -> PluginM String]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Plugin -> Maybe (String -> PluginM String)
    preCommitTransform) (StateT Context GititServerPart [Plugin]
     -> ContentTransformer [String -> PluginM String])
    -> StateT Context GititServerPart [Plugin]
    -> ContentTransformer [String -> PluginM String]
    forall a b. (a -> b) -> a -> b
    $
                              (GititState -> [Plugin]) -> StateT Context GititServerPart [Plugin]
    forall (m :: * -> *) a. MonadIO m => (GititState -> a) -> m a
    queryGititState GititState -> [Plugin]
    plugins
      where preCommitTransform :: Plugin -> Maybe (String -> PluginM String)
    preCommitTransform (PreCommitTransform String -> PluginM String
    x) = (String -> PluginM String) -> Maybe (String -> PluginM String)
    forall a. a -> Maybe a
    Just String -> PluginM String
    x
            preCommitTransform Plugin
    _                      = Maybe (String -> PluginM String)
    forall a. Maybe a
    Nothing

    -- | @applyTransform a t@ applies the transform @t@ to input @a@.
    applyTransform :: a -> (a -> PluginM a) -> ContentTransformer a
    applyTransform :: forall a. a -> (a -> PluginM a) -> ContentTransformer a
    applyTransform a
    inp a -> PluginM a
    transform = do
      context <- StateT Context GititServerPart Context
    forall s (m :: * -> *). MonadState s m => m s
    get
      conf <- lift getConfig
      user <- lift getLoggedInUser
      fs <- lift getFileStore
      req <- lift askRq
      let pluginData = PluginData{ pluginConfig :: Config
    pluginConfig = Config
    conf
                                 , pluginUser :: Maybe User
    pluginUser = Maybe User
    user
                                 , pluginRequest :: Request
    pluginRequest = Request
    req
                                 , pluginFileStore :: FileStore
    pluginFileStore = FileStore
    fs }
      (result', context') <- liftIO $ runPluginM (transform inp) pluginData context
      put context'
      return result'

    -- | Applies all the page transform plugins to a Pandoc document.
    applyPageTransforms :: Pandoc -> ContentTransformer Pandoc
    applyPageTransforms :: Pandoc -> StateT Context GititServerPart Pandoc
    applyPageTransforms Pandoc
    c = do
      xforms <- ContentTransformer [Pandoc -> PluginM Pandoc]
    getPageTransforms
      foldM applyTransform c (wikiLinksTransform : xforms)

    -- | Applies all the pre-parse transform plugins to a Page object.
    applyPreParseTransforms :: Page -> ContentTransformer Page
    applyPreParseTransforms :: Page -> StateT Context GititServerPart Page
    applyPreParseTransforms Page
    page' = ContentTransformer [String -> PluginM String]
    getPreParseTransforms ContentTransformer [String -> PluginM String]
    -> ([String -> PluginM String]
        -> StateT Context GititServerPart String)
    -> StateT Context GititServerPart String
    forall a b.
    StateT Context GititServerPart a
    -> (a -> StateT Context GititServerPart b)
    -> StateT Context GititServerPart b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (String
     -> (String -> PluginM String)
     -> StateT Context GititServerPart String)
    -> String
    -> [String -> PluginM String]
    -> StateT Context GititServerPart String
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM String
    -> (String -> PluginM String)
    -> StateT Context GititServerPart String
    forall a. a -> (a -> PluginM a) -> ContentTransformer a
    applyTransform (Page -> String
    pageText Page
    page') StateT Context GititServerPart String
    -> (String -> StateT Context GititServerPart Page)
    -> StateT Context GititServerPart Page
    forall a b.
    StateT Context GititServerPart a
    -> (a -> StateT Context GititServerPart b)
    -> StateT Context GititServerPart b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                                    (\String
    t -> Page -> StateT Context GititServerPart Page
    forall a. a -> StateT Context GititServerPart a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Page
    page'{ pageText = t })

    -- | Applies all the pre-commit transform plugins to a raw string.
    applyPreCommitTransforms :: String -> ContentTransformer String
    applyPreCommitTransforms :: String -> StateT Context GititServerPart String
    applyPreCommitTransforms String
    c = ContentTransformer [String -> PluginM String]
    getPreCommitTransforms ContentTransformer [String -> PluginM String]
    -> ([String -> PluginM String]
        -> StateT Context GititServerPart String)
    -> StateT Context GititServerPart String
    forall a b.
    StateT Context GititServerPart a
    -> (a -> StateT Context GititServerPart b)
    -> StateT Context GititServerPart b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (String
     -> (String -> PluginM String)
     -> StateT Context GititServerPart String)
    -> String
    -> [String -> PluginM String]
    -> StateT Context GititServerPart String
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM String
    -> (String -> PluginM String)
    -> StateT Context GititServerPart String
    forall a. a -> (a -> PluginM a) -> ContentTransformer a
    applyTransform String
    c

    --
    -- Content or context augmentation combinators
    --

    -- | Puts rendered page content into a wikipage div, adding
    -- categories.
    wikiDivify :: Html -> ContentTransformer Html
    wikiDivify :: Html -> StateT Context GititServerPart Html
    wikiDivify Html
    c = do
      categories <- (Context -> [String])
    -> StateT Context GititServerPart Context
    -> StateT Context GititServerPart [String]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Context -> [String]
    ctxCategories StateT Context GititServerPart Context
    forall s (m :: * -> *). MonadState s m => m s
    get
      base' <- lift getWikiBase
      let categoryLink String
    ctg = Html -> Html
    li (Html -> Html
    a (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    href (String -> AttributeValue
    forall a. IsString a => String -> a
    fromString (String -> AttributeValue) -> String -> AttributeValue
    forall a b. (a -> b) -> a -> b
    $ String
    base' String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/_category/" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ctg) (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ String -> Html
    forall a. IsString a => String -> a
    fromString String
    ctg)
      let htmlCategories = if [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    categories
                              then Html
    forall a. Monoid a => a
    mempty
                              else Html -> Html
    Html5.div (Html -> Html) -> Attribute -> Html -> Html
    forall h. Attributable h => h -> Attribute -> h
    ! AttributeValue -> Attribute
    Html5.Attr.id AttributeValue
    "categoryList" (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ Html -> Html
    ul (Html -> Html) -> Html -> Html
    forall a b. (a -> b) -> a -> b
    $ (String -> Html) -> [String] -> Html
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap String -> Html
    categoryLink [String]
    categories
      return $ Html5.div ! Html5.Attr.id "wikipage" $ c <> htmlCategories

    -- | Adds page title to a Pandoc document.
    addPageTitleToPandoc :: String -> Pandoc -> ContentTransformer Pandoc
    addPageTitleToPandoc :: String -> Pandoc -> StateT Context GititServerPart Pandoc
    addPageTitleToPandoc String
    title' (Pandoc Meta
    _ [Block]
    blocks) = do
      (PageLayout -> PageLayout) -> ContentTransformer ()
    updateLayout ((PageLayout -> PageLayout) -> ContentTransformer ())
    -> (PageLayout -> PageLayout) -> ContentTransformer ()
    forall a b. (a -> b) -> a -> b
    $ \PageLayout
    layout -> PageLayout
    layout{ pgTitle = title' }
      Pandoc -> StateT Context GititServerPart Pandoc
    forall a. a -> StateT Context GititServerPart a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pandoc -> StateT Context GititServerPart Pandoc)
    -> Pandoc -> StateT Context GititServerPart Pandoc
    forall a b. (a -> b) -> a -> b
    $ if String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    title'
                  then Meta -> [Block] -> Pandoc
    Pandoc Meta
    nullMeta [Block]
    blocks
                  else Meta -> [Block] -> Pandoc
    Pandoc
                        (Text -> Inlines -> Meta -> Meta
    forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
    forall b. ToMetaValue b => Text -> b -> Meta -> Meta
    B.setMeta Text
    "title" (Text -> Inlines
    B.str (String -> Text
    T.pack String
    title')) Meta
    nullMeta)
                        [Block]
    blocks

    -- | Adds javascript links for math support.
    addMathSupport :: a -> ContentTransformer a
    addMathSupport :: forall a. a -> StateT Context GititServerPart a
    addMathSupport a
    c = do
      conf <- GititServerPart Config -> StateT Context GititServerPart Config
    forall (m :: * -> *) a. Monad m => m a -> StateT Context m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift GititServerPart Config
    getConfig
      updateLayout $ \PageLayout
    l ->
        case Config -> MathMethod
    mathMethod Config
    conf of
             MathMethod
    MathML       -> PageLayout
    l
             WebTeX String
    _     -> PageLayout
    l
             MathJax String
    u    -> PageLayout -> [String] -> PageLayout
    addScripts PageLayout
    l [String
    u]
             MathMethod
    RawTeX       -> PageLayout
    l
      return c

    -- | Adds javascripts to page layout.
    addScripts :: PageLayout -> [String] -> PageLayout
    addScripts :: PageLayout -> [String] -> PageLayout
    addScripts PageLayout
    layout [String]
    scriptPaths =
      PageLayout
    layout{ pgScripts = scriptPaths ++ pgScripts layout }

    --
    -- ContentTransformer context API
    --

    getParams :: ContentTransformer Params
    getParams :: StateT Context GititServerPart Params
    getParams = GititServerPart Params -> StateT Context GititServerPart Params
    forall (m :: * -> *) a. Monad m => m a -> StateT Context m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift ((Params -> GititServerPart Params) -> GititServerPart Params
    forall (m :: * -> *) a r.
    (HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
    (a -> m r) -> m r
    withData Params -> GititServerPart Params
    forall a. a -> GititServerPart a
    forall (m :: * -> *) a. Monad m => a -> m a
    return)

    getFileName :: ContentTransformer FilePath
    getFileName :: StateT Context GititServerPart String
    getFileName = (Context -> String)
    -> StateT Context GititServerPart Context
    -> StateT Context GititServerPart String
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Context -> String
    ctxFile StateT Context GititServerPart Context
    forall s (m :: * -> *). MonadState s m => m s
    get

    getPageName :: ContentTransformer String
    getPageName :: StateT Context GititServerPart String
    getPageName = (Context -> String)
    -> StateT Context GititServerPart Context
    -> StateT Context GititServerPart String
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (PageLayout -> String
    pgPageName (PageLayout -> String)
    -> (Context -> PageLayout) -> Context -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Context -> PageLayout
    ctxLayout) StateT Context GititServerPart Context
    forall s (m :: * -> *). MonadState s m => m s
    get

    getLayout :: ContentTransformer PageLayout
    getLayout :: ContentTransformer PageLayout
    getLayout = (Context -> PageLayout)
    -> StateT Context GititServerPart Context
    -> ContentTransformer PageLayout
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Context -> PageLayout
    ctxLayout StateT Context GititServerPart Context
    forall s (m :: * -> *). MonadState s m => m s
    get

    getCacheable :: ContentTransformer Bool
    getCacheable :: ContentTransformer Bool
    getCacheable = (Context -> Bool)
    -> StateT Context GititServerPart Context
    -> ContentTransformer Bool
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Context -> Bool
    ctxCacheable StateT Context GititServerPart Context
    forall s (m :: * -> *). MonadState s m => m s
    get

    -- | Updates the layout with the result of applying f to the current layout
    updateLayout :: (PageLayout -> PageLayout) -> ContentTransformer ()
    updateLayout :: (PageLayout -> PageLayout) -> ContentTransformer ()
    updateLayout PageLayout -> PageLayout
    f = do
      ctx <- StateT Context GititServerPart Context
    forall s (m :: * -> *). MonadState s m => m s
    get
      let l = Context -> PageLayout
    ctxLayout Context
    ctx
      put ctx { ctxLayout = f l }

    --
    -- Pandoc and wiki content conversion support
    --

    readerFor :: PageType -> Bool -> String -> Either PandocError Pandoc
    readerFor :: PageType -> Bool -> String -> Either PandocError Pandoc
    readerFor PageType
    pt Bool
    lhs =
      let defExts :: Extensions
    defExts = Text -> Extensions
    getDefaultExtensions (Text -> Extensions) -> Text -> Extensions
    forall a b. (a -> b) -> a -> b
    $ Text -> Text
    T.toLower (Text -> Text) -> Text -> Text
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ PageType -> String
    forall a. Show a => a -> String
    show PageType
    pt
          defPS :: ReaderOptions
    defPS = ReaderOptions
    forall a. Default a => a
    def{ readerExtensions = defExts
                                          <> extensionsFromList [Ext_emoji]
                                          <> getPageTypeDefaultExtensions pt lhs
                                          <> readerExtensions def }
      in PandocPure Pandoc -> Either PandocError Pandoc
    forall a. PandocPure a -> Either PandocError a
    runPure (PandocPure Pandoc -> Either PandocError Pandoc)
    -> (String -> PandocPure Pandoc)
    -> String
    -> Either PandocError Pandoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (case PageType
    pt of
           PageType
    RST        -> ReaderOptions -> Text -> PandocPure Pandoc
    forall (m :: * -> *) a.
    (PandocMonad m, ToSources a) =>
    ReaderOptions -> a -> m Pandoc
    readRST ReaderOptions
    defPS
           PageType
    Markdown   -> ReaderOptions -> Text -> PandocPure Pandoc
    forall (m :: * -> *) a.
    (PandocMonad m, ToSources a) =>
    ReaderOptions -> a -> m Pandoc
    readMarkdown ReaderOptions
    defPS
           PageType
    CommonMark -> ReaderOptions -> Text -> PandocPure Pandoc
    forall (m :: * -> *) a.
    (PandocMonad m, ToSources a) =>
    ReaderOptions -> a -> m Pandoc
    readCommonMark ReaderOptions
    defPS
           PageType
    LaTeX      -> ReaderOptions -> Text -> PandocPure Pandoc
    forall (m :: * -> *) a.
    (PandocMonad m, ToSources a) =>
    ReaderOptions -> a -> m Pandoc
    readLaTeX ReaderOptions
    defPS
           PageType
    HTML       -> ReaderOptions -> Text -> PandocPure Pandoc
    forall (m :: * -> *) a.
    (PandocMonad m, ToSources a) =>
    ReaderOptions -> a -> m Pandoc
    readHtml ReaderOptions
    defPS
           PageType
    Textile    -> ReaderOptions -> Text -> PandocPure Pandoc
    forall (m :: * -> *) a.
    (PandocMonad m, ToSources a) =>
    ReaderOptions -> a -> m Pandoc
    readTextile ReaderOptions
    defPS
           PageType
    Org        -> ReaderOptions -> Text -> PandocPure Pandoc
    forall (m :: * -> *) a.
    (PandocMonad m, ToSources a) =>
    ReaderOptions -> a -> m Pandoc
    readOrg ReaderOptions
    defPS
           PageType
    DocBook    -> ReaderOptions -> Text -> PandocPure Pandoc
    forall (m :: * -> *) a.
    (PandocMonad m, ToSources a) =>
    ReaderOptions -> a -> m Pandoc
    readDocBook ReaderOptions
    defPS
           PageType
    MediaWiki  -> ReaderOptions -> Text -> PandocPure Pandoc
    forall (m :: * -> *) a.
    (PandocMonad m, ToSources a) =>
    ReaderOptions -> a -> m Pandoc
    readMediaWiki ReaderOptions
    defPS) (Text -> PandocPure Pandoc)
    -> (String -> Text) -> String -> PandocPure Pandoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack

    wikiLinksTransform :: Pandoc -> PluginM Pandoc
    wikiLinksTransform :: Pandoc -> PluginM Pandoc
    wikiLinksTransform Pandoc
    pandoc
      = do cfg <- (PluginData -> Config)
    -> ReaderT PluginData (StateT Context IO) PluginData
    -> ReaderT PluginData (StateT Context IO) Config
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM PluginData -> Config
    pluginConfig ReaderT PluginData (StateT Context IO) PluginData
    forall r (m :: * -> *). MonadReader r m => m r
    ask -- Can't use askConfig from Interface due to circular dependencies.
           return (bottomUp (convertWikiLinks cfg) pandoc)

    -- | Convert links with no URL to wikilinks.
    convertWikiLinks :: Config -> Inline -> Inline
    convertWikiLinks :: Config -> Inline -> Inline
    convertWikiLinks Config
    cfg (Link Attr
    attr [Inline]
    ref (Text
    "", Text
    "")) | Config -> Bool
    useAbsoluteUrls Config
    cfg =
      Attr -> [Inline] -> (Text, Text) -> Inline
    Link Attr
    attr [Inline]
    ref (String -> Text
    T.pack (String
    "/" String -> String -> String
    </> Config -> String
    baseUrl Config
    cfg String -> String -> String
    </> [Inline] -> String
    inlinesToURL [Inline]
    ref),
                     Text
    "Go to wiki page")
    convertWikiLinks Config
    _cfg (Link Attr
    attr [Inline]
    ref (Text
    "", Text
    "")) =
      Attr -> [Inline] -> (Text, Text) -> Inline
    Link Attr
    attr [Inline]
    ref (String -> Text
    T.pack ([Inline] -> String
    inlinesToURL [Inline]
    ref), Text
    "Go to wiki page")
    convertWikiLinks Config
    _cfg Inline
    x = Inline
    x

    -- | Derives a URL from a list of Pandoc Inline elements.
    inlinesToURL :: [Inline] -> String
    inlinesToURL :: [Inline] -> String
    inlinesToURL = Bool -> (Char -> Bool) -> String -> String
    encString Bool
    False Char -> Bool
    isUnescapedInURI (String -> String) -> ([Inline] -> String) -> [Inline] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Inline] -> String
    inlinesToString

    -- | Convert a list of inlines into a string.
    inlinesToString :: [Inline] -> String
    inlinesToString :: [Inline] -> String
    inlinesToString = Text -> String
    T.unpack (Text -> String) -> ([Inline] -> Text) -> [Inline] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> ([Inline] -> [Text]) -> [Inline] -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    go
      where go :: Inline -> T.Text
            go :: Inline -> Text
    go Inline
    x = case Inline
    x of
                   Str Text
    s                   -> Text
    s
                   Emph [Inline]
    xs                 -> [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    go [Inline]
    xs
                   Strong [Inline]
    xs               -> [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    go [Inline]
    xs
                   Strikeout [Inline]
    xs            -> [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    go [Inline]
    xs
                   Superscript [Inline]
    xs          -> [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    go [Inline]
    xs
                   Subscript [Inline]
    xs            -> [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    go [Inline]
    xs
                   SmallCaps [Inline]
    xs            -> [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    go [Inline]
    xs
    #if MIN_VERSION_pandoc(2,10,0)
                   Underline [Inline]
    xs            -> [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    go [Inline]
    xs
    #endif
                   Quoted QuoteType
    DoubleQuote [Inline]
    xs   -> Text
    "\"" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ((Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    go [Inline]
    xs) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "\""
                   Quoted QuoteType
    SingleQuote [Inline]
    xs   -> Text
    "'" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ((Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    go [Inline]
    xs) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "'"
                   Cite [Citation]
    _ [Inline]
    xs               -> [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    go [Inline]
    xs
                   Code Attr
    _ Text
    s                -> Text
    s
                   Inline
    Space                   -> Text
    " "
                   Inline
    SoftBreak               -> Text
    " "
                   Inline
    LineBreak               -> Text
    " "
                   Math MathType
    DisplayMath Text
    s      -> Text
    "$$" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    s Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "$$"
                   Math MathType
    InlineMath Text
    s       -> Text
    "$" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    s Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    "$"
                   RawInline (Format Text
    "tex") Text
    s -> Text
    s
                   RawInline Format
    _ Text
    _           -> Text
    ""
                   Link Attr
    _ [Inline]
    xs (Text, Text)
    _             -> [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    go [Inline]
    xs
                   Image Attr
    _ [Inline]
    xs (Text, Text)
    _            -> [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    go [Inline]
    xs
                   Note [Block]
    _                  -> Text
    ""
                   Span Attr
    _ [Inline]
    xs               -> [Text] -> Text
    forall a. Monoid a => [a] -> a
    mconcat ([Text] -> Text) -> [Text] -> Text
    forall a b. (a -> b) -> a -> b
    $ (Inline -> Text) -> [Inline] -> [Text]
    forall a b. (a -> b) -> [a] -> [b]
    map Inline -> Text
    go [Inline]
    xs