{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.Gitit.ContentTransformer
(
runPageTransformer
, runFileTransformer
, showRawPage
, showFileAsText
, showPage
, showHighlightedSource
, showFile
, preview
, applyPreCommitPlugins
, cacheHtml
, cachedHtml
, rawContents
, textResponse
, mimeFileResponse
, mimeResponse
, applyWikiTemplate
, pageToWikiPandoc
, pageToPandoc
, pandocToHtml
, highlightSource
, applyPageTransforms
, wikiDivify
, addPageTitleToPandoc
, addMathSupport
, addScripts
, getFileName
, getPageName
, getLayout
, getParams
, getCacheable
, inlinesToURL
, inlinesToString
)
where
import qualified Control.Exception as E
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 Data.Semigroup ((<>))
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 Text.XHtml hiding ( (</>), dir, method, password, rev )
import Text.XHtml.Strict (stringToHtmlString)
#if MIN_VERSION_blaze_html(0,5,0)
import Text.Blaze.Html.Renderer.String as Blaze ( renderHtml )
#else
import Text.Blaze.Renderer.String as Blaze ( renderHtml )
#endif
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
runPageTransformer :: ToMessage a
=> ContentTransformer a
-> GititServerPart a
runPageTransformer :: forall a. ToMessage a => ContentTransformer a -> GititServerPart a
runPageTransformer ContentTransformer a
xform = forall (m :: * -> *) a r.
(HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
(a -> m r) -> m r
withData forall a b. (a -> b) -> a -> b
$ \Params
params -> do
String
page <- GititServerPart String
getPage
Config
cfg <- GititServerPart Config
getConfig
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ContentTransformer a
xform Context{ ctxFile :: String
ctxFile = String -> String -> String
pathForPage String
page (Config -> String
defaultExtension Config
cfg)
, ctxLayout :: PageLayout
ctxLayout = PageLayout
defaultPageLayout{
pgPageName :: String
pgPageName = String
page
, pgTitle :: String
pgTitle = String
page
, pgPrintable :: Bool
pgPrintable = Params -> Bool
pPrintable Params
params
, pgMessages :: [String]
pgMessages = Params -> [String]
pMessages Params
params
, pgRevision :: Maybe String
pgRevision = Params -> Maybe String
pRevision Params
params
, pgLinkToFeed :: Bool
pgLinkToFeed = Config -> Bool
useFeed Config
cfg }
, ctxCacheable :: Bool
ctxCacheable = Bool
True
, ctxTOC :: Bool
ctxTOC = Config -> Bool
tableOfContents Config
cfg
, ctxBirdTracks :: Bool
ctxBirdTracks = Config -> Bool
showLHSBirdTracks Config
cfg
, ctxCategories :: [String]
ctxCategories = []
, ctxMeta :: [(String, String)]
ctxMeta = [] }
runFileTransformer :: ToMessage a
=> ContentTransformer a
-> GititServerPart a
runFileTransformer :: forall a. ToMessage a => ContentTransformer a -> GititServerPart a
runFileTransformer ContentTransformer a
xform = forall (m :: * -> *) a r.
(HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
(a -> m r) -> m r
withData forall a b. (a -> b) -> a -> b
$ \Params
params -> do
String
page <- GititServerPart String
getPage
Config
cfg <- GititServerPart Config
getConfig
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ContentTransformer a
xform Context{ ctxFile :: String
ctxFile = forall a. a -> a
id String
page
, ctxLayout :: PageLayout
ctxLayout = PageLayout
defaultPageLayout{
pgPageName :: String
pgPageName = String
page
, pgTitle :: String
pgTitle = String
page
, pgPrintable :: Bool
pgPrintable = Params -> Bool
pPrintable Params
params
, pgMessages :: [String]
pgMessages = Params -> [String]
pMessages Params
params
, pgRevision :: Maybe String
pgRevision = Params -> Maybe String
pRevision Params
params
, pgLinkToFeed :: Bool
pgLinkToFeed = Config -> Bool
useFeed Config
cfg }
, ctxCacheable :: Bool
ctxCacheable = Bool
True
, ctxTOC :: Bool
ctxTOC = Config -> Bool
tableOfContents Config
cfg
, ctxBirdTracks :: Bool
ctxBirdTracks = Config -> Bool
showLHSBirdTracks Config
cfg
, ctxCategories :: [String]
ctxCategories = []
, ctxMeta :: [(String, String)]
ctxMeta = [] }
showRawPage :: Handler
showRawPage :: Handler
showRawPage = forall a. ToMessage a => ContentTransformer a -> GititServerPart a
runPageTransformer ContentTransformer Response
rawTextResponse
showFileAsText :: Handler
showFileAsText :: Handler
showFileAsText = forall a. ToMessage a => ContentTransformer a -> GititServerPart a
runFileTransformer ContentTransformer Response
rawTextResponse
showPage :: Handler
showPage :: Handler
showPage = forall a. ToMessage a => ContentTransformer a -> GititServerPart a
runPageTransformer ContentTransformer Response
htmlViaPandoc
showHighlightedSource :: Handler
showHighlightedSource :: Handler
showHighlightedSource = forall a. ToMessage a => ContentTransformer a -> GititServerPart a
runFileTransformer ContentTransformer Response
highlightRawSource
showFile :: Handler
showFile :: Handler
showFile = forall a. ToMessage a => ContentTransformer a -> GititServerPart a
runFileTransformer (ContentTransformer (Maybe String)
rawContents forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe String -> ContentTransformer Response
mimeFileResponse)
preview :: Handler
preview :: Handler
preview = forall a. ToMessage a => ContentTransformer a -> GititServerPart a
runPageTransformer forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
'\r') forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> String
pRaw) ContentTransformer Params
getParams forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
String -> StateT Context GititServerPart Page
contentsToPage forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Page -> StateT Context GititServerPart Pandoc
pageToWikiPandoc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Pandoc -> StateT Context GititServerPart Html
pandocToHtml forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMessage a => a -> Response
toResponse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall html. HTML html => html -> String
renderHtmlFragment
applyPreCommitPlugins :: String -> GititServerPart String
applyPreCommitPlugins :: String -> GititServerPart String
applyPreCommitPlugins = forall a. ToMessage a => ContentTransformer a -> GititServerPart a
runPageTransformer forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ContentTransformer String
applyPreCommitTransforms
rawTextResponse :: ContentTransformer Response
rawTextResponse :: ContentTransformer Response
rawTextResponse = ContentTransformer (Maybe String)
rawContents forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe String -> ContentTransformer Response
textResponse
htmlViaPandoc :: ContentTransformer Response
htmlViaPandoc :: ContentTransformer Response
htmlViaPandoc = ContentTransformer Response
cachedHtml forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
(ContentTransformer (Maybe String)
rawContents forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. MonadPlus m => m a
mzero forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
String -> StateT Context GititServerPart Page
contentsToPage forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Page -> StateT Context GititServerPart (Either Response Page)
handleRedirects forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. Monad m => a -> m a
return
(Page -> StateT Context GititServerPart Pandoc
pageToWikiPandoc forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
forall a. a -> ContentTransformer a
addMathSupport forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
Pandoc -> StateT Context GititServerPart Html
pandocToHtml forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
Html -> StateT Context GititServerPart Html
wikiDivify forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
Html -> ContentTransformer Response
applyWikiTemplate forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
Response -> ContentTransformer Response
cacheHtml))
highlightRawSource :: ContentTransformer Response
highlightRawSource :: ContentTransformer Response
highlightRawSource =
ContentTransformer Response
cachedHtml forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
((PageLayout -> PageLayout) -> ContentTransformer ()
updateLayout (\PageLayout
l -> PageLayout
l { pgTabs :: [Tab]
pgTabs = [Tab
ViewTab,Tab
HistoryTab] }) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
ContentTransformer (Maybe String)
rawContents forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Maybe String -> StateT Context GititServerPart Html
highlightSource forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Html -> ContentTransformer Response
applyWikiTemplate forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Response -> ContentTransformer Response
cacheHtml)
cacheHtml :: Response -> ContentTransformer Response
cacheHtml :: Response -> ContentTransformer Response
cacheHtml Response
resp' = do
Params
params <- ContentTransformer Params
getParams
String
file <- ContentTransformer String
getFileName
Bool
cacheable <- ContentTransformer Bool
getCacheable
Config
cfg <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GititServerPart Config
getConfig
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
useCache Config
cfg Bool -> Bool -> Bool
&& Bool
cacheable Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing (Params -> Maybe String
pRevision Params
params) Bool -> Bool -> Bool
&& Bool -> Bool
not (Params -> Bool
pPrintable Params
params)) forall a b. (a -> b) -> a -> b
$
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ String -> ByteString -> GititServerPart ()
cacheContents String
file forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
S.concat forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
L.toChunks forall a b. (a -> b) -> a -> b
$ Response -> ByteString
rsBody Response
resp'
forall (m :: * -> *) a. Monad m => a -> m a
return Response
resp'
cachedHtml :: ContentTransformer Response
cachedHtml :: ContentTransformer Response
cachedHtml = do
String
file <- ContentTransformer String
getFileName
Params
params <- ContentTransformer Params
getParams
Config
cfg <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GititServerPart Config
getConfig
if Config -> Bool
useCache Config
cfg Bool -> Bool -> Bool
&& Bool -> Bool
not (Params -> Bool
pPrintable Params
params) Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing (Params -> Maybe String
pRevision Params
params)
then do Maybe (UTCTime, ByteString)
mbCached <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ String -> GititServerPart (Maybe (UTCTime, ByteString))
lookupCache String
file
let emptyResponse :: Response
emptyResponse = String -> Response -> Response
setContentType String
"text/html; charset=utf-8" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMessage a => a -> Response
toResponse forall a b. (a -> b) -> a -> b
$ ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. MonadPlus m => m a
mzero (\(UTCTime
_modtime, ByteString
contents) -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok forall a b. (a -> b) -> a -> b
$ Response
emptyResponse{rsBody :: ByteString
rsBody = [ByteString] -> ByteString
L.fromChunks [ByteString
contents]}) Maybe (UTCTime, ByteString)
mbCached
else forall (m :: * -> *) a. MonadPlus m => m a
mzero
rawContents :: ContentTransformer (Maybe String)
rawContents :: ContentTransformer (Maybe String)
rawContents = do
Params
params <- ContentTransformer Params
getParams
String
file <- ContentTransformer String
getFileName
FileStore
fs <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GititServerPart FileStore
getFileStore
let rev :: Maybe String
rev = Params -> Maybe String
pRevision Params
params
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ FileStore -> forall a. Contents a => String -> Maybe String -> IO a
FS.retrieve FileStore
fs String
file Maybe String
rev)
(\FileStoreError
e -> if FileStoreError
e forall a. Eq a => a -> a -> Bool
== FileStoreError
FS.NotFound then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing else forall e a. Exception e => e -> IO a
E.throwIO FileStoreError
e)
textResponse :: Maybe String -> ContentTransformer Response
textResponse :: Maybe String -> ContentTransformer Response
textResponse Maybe String
Nothing = forall (m :: * -> *) a. MonadPlus m => m a
mzero
textResponse (Just String
c) = forall (m :: * -> *). Monad m => String -> String -> m Response
mimeResponse String
c String
"text/plain; charset=utf-8"
mimeFileResponse :: Maybe String -> ContentTransformer Response
mimeFileResponse :: Maybe String -> ContentTransformer Response
mimeFileResponse Maybe String
Nothing = forall a. HasCallStack => String -> a
error String
"Unable to retrieve file contents."
mimeFileResponse (Just String
c) =
forall (m :: * -> *). Monad m => String -> String -> m Response
mimeResponse String
c forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> GititServerPart String
getMimeTypeForExtension forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeExtension forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ContentTransformer String
getFileName
mimeResponse :: Monad m
=> String
-> String
-> m Response
mimeResponse :: forall (m :: * -> *). Monad m => String -> String -> m Response
mimeResponse String
c String
mimeType =
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Response -> Response
setContentType String
mimeType forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMessage a => a -> Response
toResponse forall a b. (a -> b) -> a -> b
$ String
c
applyWikiTemplate :: Html -> ContentTransformer Response
applyWikiTemplate :: Html -> ContentTransformer Response
applyWikiTemplate Html
c = do
Context { ctxLayout :: Context -> PageLayout
ctxLayout = PageLayout
layout } <- forall s (m :: * -> *). MonadState s m => m s
get
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ PageLayout -> Html -> Handler
formattedPage PageLayout
layout Html
c
pageToWikiPandoc :: Page -> ContentTransformer Pandoc
pageToWikiPandoc :: Page -> StateT Context GititServerPart Pandoc
pageToWikiPandoc Page
page' =
Page -> StateT Context GititServerPart Pandoc
pageToWikiPandoc' Page
page' 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 forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>
Page -> StateT Context GititServerPart Pandoc
pageToPandoc forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Pandoc -> StateT Context GititServerPart Pandoc
applyPageTransforms
pageToPandoc :: Page -> ContentTransformer Pandoc
pageToPandoc :: Page -> StateT Context GititServerPart Pandoc
pageToPandoc Page
page' = do
forall (m :: * -> *). HasContext m => (Context -> Context) -> m ()
modifyContext forall a b. (a -> b) -> a -> b
$ \Context
ctx -> Context
ctx{ ctxTOC :: Bool
ctxTOC = Page -> Bool
pageTOC Page
page'
, ctxCategories :: [String]
ctxCategories = Page -> [String]
pageCategories Page
page'
, ctxMeta :: [(String, String)]
ctxMeta = Page -> [(String, String)]
pageMeta Page
page' }
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => e -> IO a
E.throwIO) forall (m :: * -> *) a. Monad m => a -> m a
return 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')
handleRedirects :: Page -> ContentTransformer (Either Response Page)
handleRedirects :: Page -> StateT Context GititServerPart (Either Response Page)
handleRedirects Page
page = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"redirect" (Page -> [(String, String)]
pageMeta Page
page) of
Maybe String
Nothing -> 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 :: String -> m ()
addMessage String
message = forall (m :: * -> *). HasContext m => (Context -> Context) -> m ()
modifyContext forall a b. (a -> b) -> a -> b
$ \Context
context -> Context
context
{ ctxLayout :: PageLayout
ctxLayout = (Context -> PageLayout
ctxLayout Context
context)
{ pgMessages :: [String]
pgMessages = PageLayout -> [String]
pgMessages (Context -> PageLayout
ctxLayout Context
context) forall a. [a] -> [a] -> [a]
++ [String
message]
}
}
redirectedFrom :: String -> m String
redirectedFrom String
source = do
(String
url, String
html) <- forall {m :: * -> *}. ServerMonad m => String -> m (String, String)
processSource String
source
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Redirected from <a href=\""
, String
url
, String
"?redirect=no\" title=\"Go to original page\">"
, String
html
, String
"</a>"
]
doubleRedirect :: String -> String -> m String
doubleRedirect String
source String
destination = do
(String
url, String
html) <- forall {m :: * -> *}. ServerMonad m => String -> m (String, String)
processSource String
source
(String
url', String
html') <- forall {m :: * -> *}. ServerMonad m => String -> m (String, String)
processDestination String
destination
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"This page normally redirects to <a href=\""
, String
url'
, String
"\" title=\"Continue to destination\">"
, String
html'
, String
"</a>, but as you were already redirected from <a href=\""
, String
url
, String
"?redirect=no\" title=\"Go to original page\">"
, String
html
, String
"</a>"
, String
", this was stopped to prevent a double-redirect."
]
cancelledRedirect :: String -> m String
cancelledRedirect String
destination = do
(String
url', String
html') <- forall {m :: * -> *}. ServerMonad m => String -> m (String, String)
processDestination String
destination
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"This page redirects to <a href=\""
, String
url'
, String
"\" title=\"Continue to destination\">"
, String
html'
, String
"</a>."
]
processSource :: String -> m (String, String)
processSource String
source = do
String
base' <- forall (m :: * -> *). ServerMonad m => m String
getWikiBase
let url :: String
url = String -> String
stringToHtmlString forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage String
source
let html :: String
html = String -> String
stringToHtmlString String
source
forall (m :: * -> *) a. Monad m => a -> m a
return (String
url, String
html)
processDestination :: String -> m (String, String)
processDestination String
destination = do
String
base' <- forall (m :: * -> *). ServerMonad m => m String
getWikiBase
let (String
page', String
fragment) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'#') String
destination
let url :: String
url = String -> String
stringToHtmlString forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
base'
, String -> String
urlForPage String
page'
, String
fragment
]
let html :: String
html = String -> String
stringToHtmlString String
page'
forall (m :: * -> *) a. Monad m => a -> m a
return (String
url, String
html)
getSource :: ContentTransformer (Maybe String)
getSource = do
Config
cfg <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GititServerPart Config
getConfig
String
base' <- forall (m :: * -> *). ServerMonad m => m String
getWikiBase
Request
request <- forall (m :: * -> *). ServerMonad m => m Request
askRq
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
ByteString
referer <- forall r. HasHeaders r => String -> r -> Maybe ByteString
getHeader String
"referer" Request
request
URIRef Absolute
uri <- case URIParserOptions
-> ByteString -> Either URIParseError (URIRef Absolute)
parseURI URIParserOptions
laxURIParserOptions ByteString
referer of
Left URIParseError
_ -> forall a. Maybe a
Nothing
Right URIRef Absolute
uri -> forall a. a -> Maybe a
Just URIRef Absolute
uri
let Query [(ByteString, ByteString)]
params = URIRef Absolute -> Query
uriQuery URIRef Absolute
uri
ByteString
redirect' <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> ByteString
SC.pack String
"redirect") [(ByteString, ByteString)]
params
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ ByteString
redirect' forall a. Eq a => a -> a -> Bool
== String -> ByteString
SC.pack String
"yes"
String
path' <- forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (String
base' forall a. [a] -> [a] -> [a]
++ String
"/") (ByteString -> String
SC.unpack (URIRef Absolute -> ByteString
uriPath URIRef Absolute
uri))
let path'' :: String
path'' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
path' then Config -> String
frontPage Config
cfg else String -> String
urlDecode String
path'
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ String -> Bool
isPage String
path''
forall (m :: * -> *) a. Monad m => a -> m a
return String
path''
withBody :: String -> Response
withBody = String -> Response -> Response
setContentType String
"text/html; charset=utf-8" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMessage a => a -> Response
toResponse
isn'tRedirect :: StateT Context GititServerPart (Either a Page)
isn'tRedirect = do
ContentTransformer (Maybe String)
getSource forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall {m :: * -> *}. ServerMonad m => String -> m String
redirectedFrom forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall {m :: * -> *}. HasContext m => String -> m ()
addMessage)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Page
page)
isRedirect :: String -> StateT Context GititServerPart (Either Response Page)
isRedirect String
destination = do
Params
params <- ContentTransformer Params
getParams
case forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Params -> Maybe Bool
pRedirect Params
params) (\String
_ -> forall a. a -> Maybe a
Just Bool
False) (Params -> Maybe String
pRevision Params
params) of
Maybe Bool
Nothing -> do
Maybe String
source <- ContentTransformer (Maybe String)
getSource
case Maybe String
source of
Just String
source' -> do
forall {m :: * -> *}. ServerMonad m => String -> String -> m String
doubleRedirect String
source' String
destination forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *}. HasContext m => String -> m ()
addMessage
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Page
page)
Maybe String
Nothing -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ do
String
base' <- forall (m :: * -> *). ServerMonad m => m String
getWikiBase
let url' :: String
url' = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
base'
, String -> String
urlForPage (Page -> String
pageName Page
page)
, String
"?redirect=yes"
]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) uri res.
(FilterMonad Response m, ToSURI uri) =>
uri -> res -> m res
seeOther String
url' forall a b. (a -> b) -> a -> b
$ String -> Response
withBody forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"<!doctype html><html><head><title>307 Redirect"
, String
"</title></head><body><p>You are being <a href=\""
, String -> String
stringToHtmlString String
url'
, String
"\">redirected</a>.</body></p></html>"
]
Just Bool
True -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ do
(String
url', String
html') <- forall {m :: * -> *}. ServerMonad m => String -> m (String, String)
processDestination String
destination
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok forall a b. (a -> b) -> a -> b
$ String -> Response
withBody forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"<!doctype html><html><head><title>Redirecting to "
, String
html'
, String
"</title><meta http-equiv=\"refresh\" contents=\"0; url="
, String
url'
, String
"\" /><script type=\"text/javascript\">window.location=\""
, String
url'
, String
"\"</script></head><body><p>Redirecting to <a href=\""
, String
url'
, String
"\">"
, String
html'
, String
"</a>...</p></body></html>"
]
Just Bool
False -> do
forall {m :: * -> *}. ServerMonad m => String -> m String
cancelledRedirect String
destination forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *}. HasContext m => String -> m ()
addMessage
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Page
page)
contentsToPage :: String -> ContentTransformer Page
contentsToPage :: String -> StateT Context GititServerPart Page
contentsToPage String
s = do
Config
cfg <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GititServerPart Config
getConfig
String
pn <- ContentTransformer String
getPageName
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Config -> String -> String -> Page
stringToPage Config
cfg String
pn String
s
pandocToHtml :: Pandoc -> ContentTransformer Html
pandocToHtml :: Pandoc -> StateT Context GititServerPart Html
pandocToHtml Pandoc
pandocContents = do
Bool
toc <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Context -> Bool
ctxTOC forall s (m :: * -> *). MonadState s m => m s
get
Bool
bird <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Context -> Bool
ctxBirdTracks forall s (m :: * -> *). MonadState s m => m s
get
Config
cfg <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GititServerPart Config
getConfig
let tpl :: Text
tpl = Text
"$if(toc)$<div id=\"TOC\">\n$toc$\n</div>\n$endif$\n$body$"
Template Text
compiledTemplate <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PandocIO a -> IO a
runIOorExplode forall a b. (a -> b) -> a -> b
$ do
Either String (Template Text)
res <- forall (m :: * -> *) a. WithDefaultPartials m a -> m a
runWithDefaultPartials forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(TemplateMonad m, TemplateTarget a) =>
String -> Text -> m (Either String (Template a))
compileTemplate String
"toc" Text
tpl
case Either String (Template Text)
res of
Right Template Text
t -> forall (m :: * -> *) a. Monad m => a -> m a
return Template Text
t
Left String
e -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocTemplateError forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
e
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Html
primHtml forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if Config -> Bool
xssSanitize Config
cfg then Text -> Text
sanitizeBalance else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a e. Exception e => e -> a
E.throw forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PandocPure a -> Either PandocError a
runPure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String forall a. Default a => a
def{
writerTemplate :: Maybe (Template Text)
writerTemplate = forall a. a -> Maybe a
Just Template Text
compiledTemplate
, writerHTMLMathMethod :: HTMLMathMethod
writerHTMLMathMethod =
case Config -> MathMethod
mathMethod Config
cfg of
MathMethod
MathML -> HTMLMathMethod
Pandoc.MathML
WebTeX String
u -> Text -> HTMLMathMethod
Pandoc.WebTeX forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
u
MathJax String
u -> Text -> HTMLMathMethod
Pandoc.MathJax forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
u
MathMethod
RawTeX -> HTMLMathMethod
Pandoc.PlainMath
, writerTableOfContents :: Bool
writerTableOfContents = Bool
toc
, writerHighlightStyle :: Maybe Style
writerHighlightStyle = forall a. a -> Maybe a
Just Style
pygments
, writerExtensions :: Extensions
writerExtensions = if Bool
bird
then Extension -> Extensions -> Extensions
enableExtension Extension
Ext_literate_haskell
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Extensions
writerExtensions forall a. Default a => a
def
else WriterOptions -> Extensions
writerExtensions forall a. Default a => a
def
, writerEmailObfuscation :: ObfuscationMethod
writerEmailObfuscation = ObfuscationMethod
ReferenceObfuscation
} Pandoc
pandocContents
highlightSource :: Maybe String -> ContentTransformer Html
highlightSource :: Maybe String -> StateT Context GititServerPart Html
highlightSource Maybe String
Nothing = forall (m :: * -> *) a. MonadPlus m => m a
mzero
highlightSource (Just String
source) = do
String
file <- ContentTransformer String
getFileName
let formatOpts :: FormatOptions
formatOpts = FormatOptions
defaultFormatOpts { numberLines :: Bool
numberLines = Bool
True, lineAnchors :: Bool
lineAnchors = Bool
True }
case SyntaxMap -> String -> [Syntax]
syntaxesByFilename SyntaxMap
defaultSyntaxMap String
file of
[] -> 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
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=Char
'\r') String
source of
Left String
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (forall a. Show a => a -> String
show String
e)
Right [SourceLine]
r -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> Html
primHtml forall a b. (a -> b) -> a -> b
$ Html -> String
Blaze.renderHtml
forall a b. (a -> b) -> a -> b
$ FormatOptions -> [SourceLine] -> Html
formatHtmlBlock FormatOptions
formatOpts [SourceLine]
r
getPageTransforms :: ContentTransformer [Pandoc -> PluginM Pandoc]
getPageTransforms :: ContentTransformer [Pandoc -> PluginM Pandoc]
getPageTransforms = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Plugin -> Maybe (Pandoc -> PluginM Pandoc)
pageTransform) forall a b. (a -> b) -> a -> b
$ 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) = forall a. a -> Maybe a
Just Pandoc -> PluginM Pandoc
x
pageTransform Plugin
_ = forall a. Maybe a
Nothing
getPreParseTransforms :: ContentTransformer [String -> PluginM String]
getPreParseTransforms :: ContentTransformer [String -> PluginM String]
getPreParseTransforms = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Plugin -> Maybe (String -> PluginM String)
preParseTransform) forall a b. (a -> b) -> a -> b
$
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) = forall a. a -> Maybe a
Just String -> PluginM String
x
preParseTransform Plugin
_ = forall a. Maybe a
Nothing
getPreCommitTransforms :: ContentTransformer [String -> PluginM String]
getPreCommitTransforms :: ContentTransformer [String -> PluginM String]
getPreCommitTransforms = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Plugin -> Maybe (String -> PluginM String)
preCommitTransform) forall a b. (a -> b) -> a -> b
$
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) = forall a. a -> Maybe a
Just String -> PluginM String
x
preCommitTransform Plugin
_ = forall a. Maybe a
Nothing
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
context <- forall s (m :: * -> *). MonadState s m => m s
get
Config
conf <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GititServerPart Config
getConfig
Maybe User
user <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GititServerPart (Maybe User)
getLoggedInUser
FileStore
fs <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GititServerPart FileStore
getFileStore
Request
req <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). ServerMonad m => m Request
askRq
let pluginData :: PluginData
pluginData = PluginData{ pluginConfig :: Config
pluginConfig = Config
conf
, pluginUser :: Maybe User
pluginUser = Maybe User
user
, pluginRequest :: Request
pluginRequest = Request
req
, pluginFileStore :: FileStore
pluginFileStore = FileStore
fs }
(a
result', Context
context') <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. PluginM a -> PluginData -> Context -> IO (a, Context)
runPluginM (a -> PluginM a
transform a
inp) PluginData
pluginData Context
context
forall s (m :: * -> *). MonadState s m => s -> m ()
put Context
context'
forall (m :: * -> *) a. Monad m => a -> m a
return a
result'
applyPageTransforms :: Pandoc -> ContentTransformer Pandoc
applyPageTransforms :: Pandoc -> StateT Context GititServerPart Pandoc
applyPageTransforms Pandoc
c = do
[Pandoc -> PluginM Pandoc]
xforms <- ContentTransformer [Pandoc -> PluginM Pandoc]
getPageTransforms
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall a. a -> (a -> PluginM a) -> ContentTransformer a
applyTransform Pandoc
c (Pandoc -> PluginM Pandoc
wikiLinksTransform forall a. a -> [a] -> [a]
: [Pandoc -> PluginM Pandoc]
xforms)
applyPreParseTransforms :: Page -> ContentTransformer Page
applyPreParseTransforms :: Page -> StateT Context GititServerPart Page
applyPreParseTransforms Page
page' = ContentTransformer [String -> PluginM String]
getPreParseTransforms forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall a. a -> (a -> PluginM a) -> ContentTransformer a
applyTransform (Page -> String
pageText Page
page') forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(\String
t -> forall (m :: * -> *) a. Monad m => a -> m a
return Page
page'{ pageText :: String
pageText = String
t })
applyPreCommitTransforms :: String -> ContentTransformer String
applyPreCommitTransforms :: String -> ContentTransformer String
applyPreCommitTransforms String
c = ContentTransformer [String -> PluginM String]
getPreCommitTransforms forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall a. a -> (a -> PluginM a) -> ContentTransformer a
applyTransform String
c
wikiDivify :: Html -> ContentTransformer Html
wikiDivify :: Html -> StateT Context GititServerPart Html
wikiDivify Html
c = do
[String]
categories <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Context -> [String]
ctxCategories forall s (m :: * -> *). MonadState s m => m s
get
String
base' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). ServerMonad m => m String
getWikiBase
let categoryLink :: String -> Html
categoryLink String
ctg = Html -> Html
li (Html -> Html
anchor forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href forall a b. (a -> b) -> a -> b
$ String
base' forall a. [a] -> [a] -> [a]
++ String
"/_category/" forall a. [a] -> [a] -> [a]
++ String
ctg] forall a b. HTML a => (Html -> b) -> a -> b
<< String
ctg)
let htmlCategories :: Html
htmlCategories = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
categories
then Html
noHtml
else Html -> Html
thediv forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
identifier String
"categoryList"] forall a b. HTML a => (Html -> b) -> a -> b
<< Html -> Html
ulist forall a b. HTML a => (Html -> b) -> a -> b
<< forall a b. (a -> b) -> [a] -> [b]
map String -> Html
categoryLink [String]
categories
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Html -> Html
thediv forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
identifier String
"wikipage"] forall a b. HTML a => (Html -> b) -> a -> b
<< [Html
c, Html
htmlCategories]
addPageTitleToPandoc :: String -> Pandoc -> ContentTransformer Pandoc
addPageTitleToPandoc :: String -> Pandoc -> StateT Context GititServerPart Pandoc
addPageTitleToPandoc String
title' (Pandoc Meta
_ [Block]
blocks) = do
(PageLayout -> PageLayout) -> ContentTransformer ()
updateLayout forall a b. (a -> b) -> a -> b
$ \PageLayout
layout -> PageLayout
layout{ pgTitle :: String
pgTitle = String
title' }
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if 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
(forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
B.setMeta Text
"title" (Text -> Inlines
B.str (String -> Text
T.pack String
title')) Meta
nullMeta)
[Block]
blocks
addMathSupport :: a -> ContentTransformer a
addMathSupport :: forall a. a -> ContentTransformer a
addMathSupport a
c = do
Config
conf <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GititServerPart Config
getConfig
(PageLayout -> PageLayout) -> ContentTransformer ()
updateLayout forall a b. (a -> b) -> a -> b
$ \PageLayout
l ->
case Config -> MathMethod
mathMethod Config
conf of
MathMethod
MathML -> PageLayout -> [String] -> PageLayout
addScripts PageLayout
l [String
"MathMLinHTML.js"]
WebTeX String
_ -> PageLayout
l
MathJax String
u -> PageLayout -> [String] -> PageLayout
addScripts PageLayout
l [String
u]
MathMethod
RawTeX -> PageLayout
l
forall (m :: * -> *) a. Monad m => a -> m a
return a
c
addScripts :: PageLayout -> [String] -> PageLayout
addScripts :: PageLayout -> [String] -> PageLayout
addScripts PageLayout
layout [String]
scriptPaths =
PageLayout
layout{ pgScripts :: [String]
pgScripts = [String]
scriptPaths forall a. [a] -> [a] -> [a]
++ PageLayout -> [String]
pgScripts PageLayout
layout }
getParams :: ContentTransformer Params
getParams :: ContentTransformer Params
getParams = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a r.
(HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
(a -> m r) -> m r
withData forall (m :: * -> *) a. Monad m => a -> m a
return)
getFileName :: ContentTransformer FilePath
getFileName :: ContentTransformer String
getFileName = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Context -> String
ctxFile forall s (m :: * -> *). MonadState s m => m s
get
getPageName :: ContentTransformer String
getPageName :: ContentTransformer String
getPageName = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (PageLayout -> String
pgPageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context -> PageLayout
ctxLayout) forall s (m :: * -> *). MonadState s m => m s
get
getLayout :: ContentTransformer PageLayout
getLayout :: ContentTransformer PageLayout
getLayout = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Context -> PageLayout
ctxLayout forall s (m :: * -> *). MonadState s m => m s
get
getCacheable :: ContentTransformer Bool
getCacheable :: ContentTransformer Bool
getCacheable = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Context -> Bool
ctxCacheable forall s (m :: * -> *). MonadState s m => m s
get
updateLayout :: (PageLayout -> PageLayout) -> ContentTransformer ()
updateLayout :: (PageLayout -> PageLayout) -> ContentTransformer ()
updateLayout PageLayout -> PageLayout
f = do
Context
ctx <- forall s (m :: * -> *). MonadState s m => m s
get
let l :: PageLayout
l = Context -> PageLayout
ctxLayout Context
ctx
forall s (m :: * -> *). MonadState s m => s -> m ()
put Context
ctx { ctxLayout :: PageLayout
ctxLayout = PageLayout -> PageLayout
f PageLayout
l }
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 forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toLower forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show PageType
pt
defPS :: ReaderOptions
defPS = forall a. Default a => a
def{ readerExtensions :: Extensions
readerExtensions = Extensions
defExts
forall a. Semigroup a => a -> a -> a
<> [Extension] -> Extensions
extensionsFromList [Extension
Ext_emoji]
forall a. Semigroup a => a -> a -> a
<> PageType -> Bool -> Extensions
getPageTypeDefaultExtensions PageType
pt Bool
lhs
forall a. Semigroup a => a -> a -> a
<> ReaderOptions -> Extensions
readerExtensions forall a. Default a => a
def }
in forall a. PandocPure a -> Either PandocError a
runPure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (case PageType
pt of
PageType
RST -> forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readRST ReaderOptions
defPS
PageType
Markdown -> forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readMarkdown ReaderOptions
defPS
PageType
CommonMark -> forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readCommonMark ReaderOptions
defPS
PageType
LaTeX -> forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readLaTeX ReaderOptions
defPS
PageType
HTML -> forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readHtml ReaderOptions
defPS
PageType
Textile -> forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readTextile ReaderOptions
defPS
PageType
Org -> forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readOrg ReaderOptions
defPS
PageType
DocBook -> forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readDocBook ReaderOptions
defPS
PageType
MediaWiki -> forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readMediaWiki ReaderOptions
defPS) 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 Config
cfg <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM PluginData -> Config
pluginConfig forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Data a, Data b) => (a -> a) -> b -> b
bottomUp (Config -> Inline -> Inline
convertWikiLinks Config
cfg) Pandoc
pandoc)
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
inlinesToURL :: [Inline] -> String
inlinesToURL :: [Inline] -> String
inlinesToURL = Bool -> (Char -> Bool) -> String -> String
encString Bool
False Char -> Bool
isUnescapedInURI forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> String
inlinesToString
inlinesToString :: [Inline] -> String
inlinesToString :: [Inline] -> String
inlinesToString = Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
go [Inline]
xs
Strong [Inline]
xs -> forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
go [Inline]
xs
Strikeout [Inline]
xs -> forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
go [Inline]
xs
Superscript [Inline]
xs -> forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
go [Inline]
xs
Subscript [Inline]
xs -> forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
go [Inline]
xs
SmallCaps [Inline]
xs -> forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
go [Inline]
xs
#if MIN_VERSION_pandoc(2,10,0)
Underline [Inline]
xs -> forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
go [Inline]
xs
#endif
Quoted QuoteType
DoubleQuote [Inline]
xs -> Text
"\"" forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
go [Inline]
xs) forall a. Semigroup a => a -> a -> a
<> Text
"\""
Quoted QuoteType
SingleQuote [Inline]
xs -> Text
"'" forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
go [Inline]
xs) forall a. Semigroup a => a -> a -> a
<> Text
"'"
Cite [Citation]
_ [Inline]
xs -> forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ 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
"$$" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
"$$"
Math MathType
InlineMath Text
s -> Text
"$" forall a. Semigroup a => a -> a -> a
<> Text
s 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)
_ -> forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
go [Inline]
xs
Image Attr
_ [Inline]
xs (Text, Text)
_ -> forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
go [Inline]
xs
Note [Block]
_ -> Text
""
Span Attr
_ [Inline]
xs -> forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Inline -> Text
go [Inline]
xs