{-# 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 :: ContentTransformer a -> GititServerPart a
runPageTransformer ContentTransformer a
xform = (Params -> GititServerPart a) -> GititServerPart a
forall (m :: * -> *) a r.
(HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
(a -> m r) -> m r
withData ((Params -> GititServerPart a) -> GititServerPart a)
-> (Params -> GititServerPart a) -> GititServerPart a
forall a b. (a -> b) -> a -> b
$ \Params
params -> do
String
page <- GititServerPart String
getPage
Config
cfg <- GititServerPart Config
getConfig
ContentTransformer a -> Context -> GititServerPart a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ContentTransformer a
xform Context :: String
-> PageLayout
-> Bool
-> Bool
-> Bool
-> [String]
-> [(String, String)]
-> Context
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 :: ContentTransformer a -> GititServerPart a
runFileTransformer ContentTransformer a
xform = (Params -> GititServerPart a) -> GititServerPart a
forall (m :: * -> *) a r.
(HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
(a -> m r) -> m r
withData ((Params -> GititServerPart a) -> GititServerPart a)
-> (Params -> GititServerPart a) -> GititServerPart a
forall a b. (a -> b) -> a -> b
$ \Params
params -> do
String
page <- GititServerPart String
getPage
Config
cfg <- GititServerPart Config
getConfig
ContentTransformer a -> Context -> GititServerPart a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ContentTransformer a
xform Context :: String
-> PageLayout
-> Bool
-> Bool
-> Bool
-> [String]
-> [(String, String)]
-> Context
Context{ ctxFile :: String
ctxFile = String -> String
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 = ContentTransformer Response -> Handler
forall a. ToMessage a => ContentTransformer a -> GititServerPart a
runPageTransformer ContentTransformer Response
rawTextResponse
showFileAsText :: Handler
showFileAsText :: Handler
showFileAsText = ContentTransformer Response -> Handler
forall a. ToMessage a => ContentTransformer a -> GititServerPart a
runFileTransformer ContentTransformer Response
rawTextResponse
showPage :: Handler
showPage :: Handler
showPage = ContentTransformer Response -> Handler
forall a. ToMessage a => ContentTransformer a -> GititServerPart a
runPageTransformer ContentTransformer Response
htmlViaPandoc
showHighlightedSource :: Handler
showHighlightedSource :: Handler
showHighlightedSource = ContentTransformer Response -> Handler
forall a. ToMessage a => ContentTransformer a -> GititServerPart a
runFileTransformer ContentTransformer Response
highlightRawSource
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe String -> ContentTransformer Response
mimeFileResponse)
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 (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 (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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Response -> ContentTransformer Response
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
forall html. HTML html => html -> String
renderHtmlFragment
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
rawTextResponse :: ContentTransformer Response
rawTextResponse :: ContentTransformer Response
rawTextResponse = ContentTransformer (Maybe String)
rawContents ContentTransformer (Maybe String)
-> (Maybe String -> ContentTransformer Response)
-> ContentTransformer Response
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 ContentTransformer Response
-> ContentTransformer Response -> ContentTransformer Response
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 (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 (m :: * -> *) a. MonadPlus m => m a
mzero String -> StateT Context GititServerPart String
forall (m :: * -> *) a. Monad m => a -> m a
return StateT Context GititServerPart String
-> (String -> StateT Context GititServerPart Page)
-> StateT Context GititServerPart Page
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 (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 (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 (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 -> ContentTransformer 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))
highlightRawSource :: ContentTransformer Response
highlightRawSource :: ContentTransformer Response
highlightRawSource =
ContentTransformer Response
cachedHtml ContentTransformer Response
-> ContentTransformer Response -> ContentTransformer Response
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] }) ContentTransformer ()
-> ContentTransformer (Maybe String)
-> ContentTransformer (Maybe String)
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 (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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
Html -> ContentTransformer Response
applyWikiTemplate ContentTransformer Response
-> (Response -> ContentTransformer Response)
-> ContentTransformer Response
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 <- StateT Context GititServerPart Params
getParams
String
file <- StateT Context GititServerPart String
getFileName
Bool
cacheable <- ContentTransformer Bool
getCacheable
Config
cfg <- GititServerPart Config -> StateT Context GititServerPart Config
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GititServerPart Config
getConfig
Bool -> ContentTransformer () -> ContentTransformer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
useCache Config
cfg Bool -> Bool -> Bool
&& Bool
cacheable Bool -> Bool -> Bool
&& Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (Params -> Maybe String
pRevision Params
params) Bool -> Bool -> Bool
&& Bool -> Bool
not (Params -> Bool
pPrintable Params
params)) (ContentTransformer () -> ContentTransformer ())
-> ContentTransformer () -> ContentTransformer ()
forall a b. (a -> b) -> a -> b
$
ServerPartT (ReaderT WikiState IO) () -> ContentTransformer ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ServerPartT (ReaderT WikiState IO) () -> ContentTransformer ())
-> ServerPartT (ReaderT WikiState IO) () -> ContentTransformer ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> ServerPartT (ReaderT WikiState IO) ()
cacheContents String
file (ByteString -> ServerPartT (ReaderT WikiState IO) ())
-> ByteString -> ServerPartT (ReaderT WikiState IO) ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
S.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
L.toChunks (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Response -> ByteString
rsBody Response
resp'
Response -> ContentTransformer Response
forall (m :: * -> *) a. Monad m => a -> m a
return Response
resp'
cachedHtml :: ContentTransformer Response
cachedHtml :: ContentTransformer Response
cachedHtml = do
String
file <- StateT Context GititServerPart String
getFileName
Params
params <- StateT Context GititServerPart Params
getParams
Config
cfg <- GititServerPart Config -> StateT Context GititServerPart Config
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
&& Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (Params -> Maybe String
pRevision Params
params)
then do Maybe (UTCTime, ByteString)
mbCached <- ServerPartT (ReaderT WikiState IO) (Maybe (UTCTime, ByteString))
-> StateT Context GititServerPart (Maybe (UTCTime, ByteString))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ServerPartT (ReaderT WikiState IO) (Maybe (UTCTime, ByteString))
-> StateT Context GititServerPart (Maybe (UTCTime, ByteString)))
-> ServerPartT (ReaderT WikiState IO) (Maybe (UTCTime, ByteString))
-> StateT Context GititServerPart (Maybe (UTCTime, ByteString))
forall a b. (a -> b) -> a -> b
$ String
-> ServerPartT (ReaderT WikiState IO) (Maybe (UTCTime, ByteString))
lookupCache String
file
let emptyResponse :: Response
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
$ ()
ContentTransformer Response
-> ((UTCTime, ByteString) -> ContentTransformer Response)
-> Maybe (UTCTime, ByteString)
-> ContentTransformer Response
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ContentTransformer Response
forall (m :: * -> *) a. MonadPlus m => m a
mzero (\(UTCTime
_modtime, ByteString
contents) -> Handler -> ContentTransformer Response
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 :: ByteString
rsBody = [ByteString] -> ByteString
L.fromChunks [ByteString
contents]}) Maybe (UTCTime, ByteString)
mbCached
else ContentTransformer Response
forall (m :: * -> *) a. MonadPlus m => m a
mzero
rawContents :: ContentTransformer (Maybe String)
rawContents :: ContentTransformer (Maybe String)
rawContents = do
Params
params <- StateT Context GititServerPart Params
getParams
String
file <- StateT Context GititServerPart String
getFileName
FileStore
fs <- ServerPartT (ReaderT WikiState IO) FileStore
-> StateT Context GititServerPart FileStore
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ServerPartT (ReaderT WikiState IO) FileStore
getFileStore
let rev :: Maybe String
rev = Params -> Maybe String
pRevision Params
params
IO (Maybe String) -> ContentTransformer (Maybe String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> ContentTransformer (Maybe String))
-> IO (Maybe String) -> ContentTransformer (Maybe String)
forall a b. (a -> b) -> a -> b
$ IO (Maybe String)
-> (FileStoreError -> IO (Maybe String)) -> IO (Maybe String)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch ((String -> Maybe String) -> IO String -> IO (Maybe String)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> Maybe String
forall a. a -> Maybe a
Just (IO String -> IO (Maybe String)) -> IO String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ FileStore -> String -> Maybe String -> IO String
FileStore -> forall a. Contents a => String -> Maybe String -> IO a
FS.retrieve FileStore
fs String
file Maybe String
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 (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing else FileStoreError -> IO (Maybe String)
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 = ContentTransformer Response
forall (m :: * -> *) a. MonadPlus m => m a
mzero
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"
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 (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
-> String
-> m Response
mimeResponse :: String -> String -> m Response
mimeResponse String
c String
mimeType =
Response -> m Response
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
applyWikiTemplate :: Html -> ContentTransformer Response
applyWikiTemplate :: Html -> ContentTransformer Response
applyWikiTemplate Html
c = do
Context { ctxLayout :: Context -> PageLayout
ctxLayout = PageLayout
layout } <- StateT Context GititServerPart Context
forall s (m :: * -> *). MonadState s m => m s
get
Handler -> ContentTransformer Response
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handler -> ContentTransformer Response)
-> Handler -> ContentTransformer Response
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' StateT Context GititServerPart Pandoc
-> (Pandoc -> StateT Context GititServerPart Pandoc)
-> StateT Context GititServerPart Pandoc
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
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 :: 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' }
(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 (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. Exception e => e -> IO a
E.throwIO) Pandoc -> StateT Context GititServerPart Pandoc
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')
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 :: String -> m ()
addMessage String
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 :: PageLayout
ctxLayout = (Context -> PageLayout
ctxLayout Context
context)
{ pgMessages :: [String]
pgMessages = PageLayout -> [String]
pgMessages (Context -> PageLayout
ctxLayout Context
context) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
message]
}
}
redirectedFrom :: String -> m String
redirectedFrom String
source = do
(String
url, String
html) <- String -> m (String, String)
forall (m :: * -> *). ServerMonad m => String -> m (String, String)
processSource String
source
String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ [String] -> String
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) <- String -> m (String, String)
forall (m :: * -> *). ServerMonad m => String -> m (String, String)
processSource String
source
(String
url', String
html') <- String -> m (String, String)
forall (m :: * -> *). ServerMonad m => String -> m (String, String)
processDestination String
destination
String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ [String] -> String
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') <- String -> m (String, String)
forall (m :: * -> *). ServerMonad m => String -> m (String, String)
processDestination String
destination
String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ [String] -> String
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' <- m String
forall (m :: * -> *). ServerMonad m => m String
getWikiBase
let url :: String
url = String -> String
stringToHtmlString (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
base' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
urlForPage String
source
let html :: String
html = String -> String
stringToHtmlString String
source
(String, String) -> m (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
url, String
html)
processDestination :: String -> m (String, String)
processDestination String
destination = do
String
base' <- m String
forall (m :: * -> *). ServerMonad m => m String
getWikiBase
let (String
page', String
fragment) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#') String
destination
let url :: String
url = String -> String
stringToHtmlString (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
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'
(String, String) -> m (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
url, String
html)
getSource :: ContentTransformer (Maybe String)
getSource = do
Config
cfg <- GititServerPart Config -> StateT Context GititServerPart Config
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GititServerPart Config
getConfig
String
base' <- StateT Context GititServerPart String
forall (m :: * -> *). ServerMonad m => m String
getWikiBase
Request
request <- StateT Context GititServerPart Request
forall (m :: * -> *). ServerMonad m => m Request
askRq
Maybe String -> ContentTransformer (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> ContentTransformer (Maybe String))
-> Maybe String -> ContentTransformer (Maybe String)
forall a b. (a -> b) -> a -> b
$ do
ByteString
referer <- String -> Request -> Maybe ByteString
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
_ -> 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 [(ByteString, ByteString)]
params = URIRef Absolute -> Query
uriQuery URIRef Absolute
uri
ByteString
redirect' <- ByteString -> [(ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> ByteString
SC.pack String
"redirect") [(ByteString, ByteString)]
params
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ByteString
redirect' ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
SC.pack String
"yes"
String
path' <- String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (String
base' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/") (ByteString -> String
SC.unpack (URIRef Absolute -> ByteString
uriPath URIRef Absolute
uri))
let path'' :: String
path'' = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
path' then Config -> String
frontPage Config
cfg else String -> String
urlDecode String
path'
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ String -> Bool
isPage String
path''
String -> Maybe String
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" (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 (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 String
forall (m :: * -> *). ServerMonad m => String -> m String
redirectedFrom (String -> StateT Context GititServerPart String)
-> (String -> ContentTransformer ())
-> String
-> ContentTransformer ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> String -> ContentTransformer ()
forall (m :: * -> *). HasContext m => String -> m ()
addMessage)
Either a Page -> StateT Context GititServerPart (Either a Page)
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
params <- StateT Context GititServerPart Params
getParams
case Maybe Bool -> (String -> Maybe Bool) -> Maybe String -> Maybe Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Params -> Maybe Bool
pRedirect Params
params) (\String
_ -> Bool -> Maybe Bool
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
String -> String -> StateT Context GititServerPart String
forall (m :: * -> *). ServerMonad m => String -> String -> m String
doubleRedirect String
source' String
destination StateT Context GititServerPart String
-> (String -> ContentTransformer ()) -> ContentTransformer ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ContentTransformer ()
forall (m :: * -> *). HasContext m => String -> m ()
addMessage
Either Response Page
-> StateT Context GititServerPart (Either Response Page)
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 (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
String
base' <- StateT Context GititServerPart String
forall (m :: * -> *). ServerMonad m => m String
getWikiBase
let url' :: String
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"
]
Handler -> ContentTransformer Response
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handler -> ContentTransformer Response)
-> Handler -> ContentTransformer Response
forall a b. (a -> b) -> a -> b
$ String -> Response -> Handler
forall (m :: * -> *) uri res.
(FilterMonad Response m, ToSURI uri) =>
uri -> res -> m res
seeOther String
url' (Response -> Handler) -> Response -> Handler
forall a b. (a -> b) -> a -> b
$ String -> Response
withBody (String -> Response) -> String -> Response
forall a b. (a -> b) -> a -> b
$ [String] -> String
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 -> (Response -> Either Response Page)
-> ContentTransformer Response
-> StateT Context GititServerPart (Either Response Page)
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
(String
url', String
html') <- String -> StateT Context GititServerPart (String, String)
forall (m :: * -> *). ServerMonad m => String -> m (String, String)
processDestination String
destination
Handler -> ContentTransformer Response
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Handler -> ContentTransformer Response)
-> Handler -> ContentTransformer Response
forall a b. (a -> b) -> a -> b
$ Response -> Handler
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok (Response -> Handler) -> Response -> Handler
forall a b. (a -> b) -> a -> b
$ String -> Response
withBody (String -> Response) -> String -> Response
forall a b. (a -> b) -> a -> b
$ [String] -> String
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
String -> StateT Context GititServerPart String
forall (m :: * -> *). ServerMonad m => String -> m String
cancelledRedirect String
destination StateT Context GititServerPart String
-> (String -> ContentTransformer ()) -> ContentTransformer ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ContentTransformer ()
forall (m :: * -> *). HasContext m => String -> m ()
addMessage
Either Response Page
-> StateT Context GititServerPart (Either Response Page)
forall (m :: * -> *) a. Monad m => a -> m a
return (Page -> Either Response Page
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 <- GititServerPart Config -> StateT Context GititServerPart Config
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GititServerPart Config
getConfig
String
pn <- StateT Context GititServerPart String
getPageName
Page -> StateT Context GititServerPart Page
forall (m :: * -> *) a. Monad m => a -> m a
return (Page -> StateT Context GititServerPart Page)
-> Page -> StateT Context GititServerPart Page
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 <- (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
Bool
bird <- (Context -> Bool)
-> StateT Context GititServerPart Context
-> ContentTransformer Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Context -> Bool
ctxBirdTracks StateT Context GititServerPart Context
forall s (m :: * -> *). MonadState s m => m s
get
Config
cfg <- GititServerPart Config -> StateT Context GititServerPart Config
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 <- IO (Template Text)
-> StateT Context GititServerPart (Template Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Template Text)
-> StateT Context GititServerPart (Template Text))
-> IO (Template Text)
-> StateT Context GititServerPart (Template Text)
forall a b. (a -> b) -> a -> b
$ PandocIO (Template Text) -> IO (Template Text)
forall a. PandocIO a -> IO a
runIOorExplode (PandocIO (Template Text) -> IO (Template Text))
-> PandocIO (Template Text) -> IO (Template Text)
forall a b. (a -> b) -> a -> b
$ do
Either String (Template Text)
res <- WithDefaultPartials PandocIO (Either String (Template Text))
-> PandocIO (Either String (Template Text))
forall (m :: * -> *) a. WithDefaultPartials m a -> m a
runWithDefaultPartials (WithDefaultPartials PandocIO (Either String (Template Text))
-> PandocIO (Either String (Template Text)))
-> WithDefaultPartials PandocIO (Either String (Template Text))
-> PandocIO (Either String (Template Text))
forall a b. (a -> b) -> a -> b
$ String
-> Text
-> WithDefaultPartials PandocIO (Either String (Template Text))
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 -> Template Text -> PandocIO (Template Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Template Text
t
Left String
e -> PandocError -> PandocIO (Template Text)
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
Html -> StateT Context GititServerPart Html
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
$ String -> Html
primHtml (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if Config -> Bool
xssSanitize Config
cfg then Text -> Text
sanitizeBalance else Text -> Text
forall a. a -> a
id) (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
(PandocError -> Text)
-> (Text -> Text) -> Either PandocError Text -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either PandocError -> Text
forall a e. Exception e => e -> a
E.throw Text -> Text
forall a. a -> a
id (Either PandocError Text -> Text)
-> (PandocPure Text -> Either PandocError Text)
-> PandocPure Text
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocPure Text -> Either PandocError Text
forall a. PandocPure a -> Either PandocError a
runPure (PandocPure Text -> Text) -> PandocPure Text -> Text
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Pandoc -> PandocPure Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String WriterOptions
forall a. Default a => a
def{
writerTemplate :: Maybe (Template Text)
writerTemplate = Template Text -> Maybe (Template Text)
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 (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 :: Bool
writerTableOfContents = Bool
toc
, writerHighlightStyle :: Maybe Style
writerHighlightStyle = Style -> Maybe Style
forall a. a -> Maybe a
Just Style
pygments
, writerExtensions :: Extensions
writerExtensions = if Bool
bird
then Extension -> Extensions -> Extensions
enableExtension Extension
Ext_literate_haskell
(Extensions -> Extensions) -> Extensions -> Extensions
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Extensions
writerExtensions WriterOptions
forall a. Default a => a
def
else WriterOptions -> Extensions
writerExtensions WriterOptions
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 = StateT Context GititServerPart Html
forall (m :: * -> *) a. MonadPlus m => m a
mzero
highlightSource (Just String
source) = do
String
file <- StateT Context GititServerPart 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
[] -> StateT Context GititServerPart Html
forall (m :: * -> *) a. MonadPlus m => m a
mzero
(Syntax
l:[Syntax]
_) -> case TokenizerConfig -> Syntax -> Text -> Either String [SourceLine]
tokenize TokenizerConfig :: SyntaxMap -> Bool -> TokenizerConfig
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 (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 (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
$ String -> Html
primHtml (String -> Html) -> String -> Html
forall a b. (a -> b) -> a -> b
$ Html -> String
Blaze.renderHtml
(Html -> String) -> Html -> String
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 = ([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 -> (a -> PluginM a) -> ContentTransformer a
applyTransform :: a -> (a -> PluginM a) -> ContentTransformer a
applyTransform a
inp a -> PluginM a
transform = do
Context
context <- StateT Context GititServerPart Context
forall s (m :: * -> *). MonadState s m => m s
get
Config
conf <- GititServerPart Config -> StateT Context GititServerPart Config
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GititServerPart Config
getConfig
Maybe User
user <- ServerPartT (ReaderT WikiState IO) (Maybe User)
-> StateT Context GititServerPart (Maybe User)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ServerPartT (ReaderT WikiState IO) (Maybe User)
getLoggedInUser
FileStore
fs <- ServerPartT (ReaderT WikiState IO) FileStore
-> StateT Context GititServerPart FileStore
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ServerPartT (ReaderT WikiState IO) FileStore
getFileStore
Request
req <- GititServerPart Request -> StateT Context GititServerPart Request
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GititServerPart Request
forall (m :: * -> *). ServerMonad m => m Request
askRq
let pluginData :: PluginData
pluginData = PluginData :: Config -> Maybe User -> Request -> FileStore -> 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') <- IO (a, Context) -> StateT Context GititServerPart (a, Context)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (a, Context) -> StateT Context GititServerPart (a, Context))
-> IO (a, Context) -> StateT Context GititServerPart (a, Context)
forall a b. (a -> b) -> a -> b
$ PluginM a -> PluginData -> Context -> IO (a, Context)
forall a. PluginM a -> PluginData -> Context -> IO (a, Context)
runPluginM (a -> PluginM a
transform a
inp) PluginData
pluginData Context
context
Context -> ContentTransformer ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Context
context'
a -> ContentTransformer a
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
(Pandoc
-> (Pandoc -> PluginM Pandoc)
-> StateT Context GititServerPart Pandoc)
-> Pandoc
-> [Pandoc -> PluginM Pandoc]
-> StateT Context GititServerPart Pandoc
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Pandoc
-> (Pandoc -> PluginM Pandoc)
-> StateT Context GititServerPart Pandoc
forall a. a -> (a -> PluginM a) -> ContentTransformer a
applyTransform Pandoc
c (Pandoc -> PluginM Pandoc
wikiLinksTransform (Pandoc -> PluginM Pandoc)
-> [Pandoc -> PluginM Pandoc] -> [Pandoc -> PluginM Pandoc]
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 ContentTransformer [String -> PluginM String]
-> ([String -> PluginM String]
-> StateT Context GititServerPart String)
-> StateT Context GititServerPart String
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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(\String
t -> Page -> StateT Context GititServerPart Page
forall (m :: * -> *) a. Monad m => a -> m a
return Page
page'{ pageText :: String
pageText = String
t })
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 (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
wikiDivify :: Html -> ContentTransformer Html
wikiDivify :: Html -> StateT Context GititServerPart Html
wikiDivify Html
c = do
[String]
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
String
base' <- GititServerPart String -> StateT Context GititServerPart String
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GititServerPart String
forall (m :: * -> *). ServerMonad m => m String
getWikiBase
let categoryLink :: String -> Html
categoryLink String
ctg = Html -> Html
li (Html -> Html
anchor (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
href (String -> HtmlAttr) -> String -> HtmlAttr
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) -> String -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< String
ctg)
let htmlCategories :: Html
htmlCategories = if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
categories
then Html
noHtml
else Html -> Html
thediv (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
identifier String
"categoryList"] (Html -> Html) -> Html -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< Html -> Html
ulist (Html -> Html) -> [Html] -> Html
forall a b. HTML a => (Html -> b) -> a -> b
<< (String -> Html) -> [String] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map String -> Html
categoryLink [String]
categories
Html -> StateT Context GititServerPart Html
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
$ Html -> Html
thediv (Html -> Html) -> [HtmlAttr] -> Html -> Html
forall a. ADDATTRS a => a -> [HtmlAttr] -> a
! [String -> HtmlAttr
identifier String
"wikipage"] (Html -> Html) -> [Html] -> Html
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 ((PageLayout -> PageLayout) -> ContentTransformer ())
-> (PageLayout -> PageLayout) -> ContentTransformer ()
forall a b. (a -> b) -> a -> b
$ \PageLayout
layout -> PageLayout
layout{ pgTitle :: String
pgTitle = String
title' }
Pandoc -> StateT Context GititServerPart Pandoc
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 (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
B.setMeta Text
"title" (Text -> Inlines
B.str (String -> Text
T.pack String
title')) Meta
nullMeta)
[Block]
blocks
addMathSupport :: a -> ContentTransformer a
addMathSupport :: a -> ContentTransformer a
addMathSupport a
c = do
Config
conf <- GititServerPart Config -> StateT Context GititServerPart Config
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift GititServerPart Config
getConfig
(PageLayout -> PageLayout) -> ContentTransformer ()
updateLayout ((PageLayout -> PageLayout) -> ContentTransformer ())
-> (PageLayout -> PageLayout) -> ContentTransformer ()
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
a -> ContentTransformer a
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 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ PageLayout -> [String]
pgScripts PageLayout
layout }
getParams :: ContentTransformer Params
getParams :: StateT Context GititServerPart Params
getParams = GititServerPart Params -> StateT Context GititServerPart Params
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 (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
updateLayout :: (PageLayout -> PageLayout) -> ContentTransformer ()
updateLayout :: (PageLayout -> PageLayout) -> ContentTransformer ()
updateLayout PageLayout -> PageLayout
f = do
Context
ctx <- StateT Context GititServerPart Context
forall s (m :: * -> *). MonadState s m => m s
get
let l :: PageLayout
l = Context -> PageLayout
ctxLayout Context
ctx
Context -> ContentTransformer ()
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 (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 :: Extensions
readerExtensions = Extensions
defExts
Extensions -> Extensions -> Extensions
forall a. Semigroup a => a -> a -> a
<> [Extension] -> Extensions
extensionsFromList [Extension
Ext_emoji]
Extensions -> Extensions -> Extensions
forall a. Semigroup a => a -> a -> a
<> PageType -> Bool -> Extensions
getPageTypeDefaultExtensions PageType
pt Bool
lhs
Extensions -> Extensions -> Extensions
forall a. Semigroup a => a -> a -> a
<> ReaderOptions -> Extensions
readerExtensions ReaderOptions
forall a. Default a => a
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 Config
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
Pandoc -> PluginM Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return ((Inline -> Inline) -> Pandoc -> Pandoc
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 (String -> String) -> ([Inline] -> String) -> [Inline] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inline] -> String
inlinesToString
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