{-# 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 xform :: 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
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 xform :: 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
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
/= '\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 (\l :: 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 resp' :: 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 "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 (\(_modtime :: UTCTime
_modtime, contents :: 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)
(\e :: 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 Nothing = ContentTransformer Response
forall (m :: * -> *) a. MonadPlus m => m a
mzero
textResponse (Just c :: String
c) = String -> String -> ContentTransformer Response
forall (m :: * -> *). Monad m => String -> String -> m Response
mimeResponse String
c "text/plain; charset=utf-8"
mimeFileResponse :: Maybe String -> ContentTransformer Response
mimeFileResponse :: Maybe String -> ContentTransformer Response
mimeFileResponse Nothing = String -> ContentTransformer Response
forall a. HasCallStack => String -> a
error "Unable to retrieve file contents."
mimeFileResponse (Just c :: 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 c :: String
c mimeType :: 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 c :: 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' =
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
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
$ \ctx :: 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
page = case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "redirect" (Page -> [(String, String)]
pageMeta Page
page) of
Nothing -> StateT Context GititServerPart (Either Response Page)
forall a. StateT Context GititServerPart (Either a Page)
isn'tRedirect
Just destination :: String
destination -> String -> StateT Context GititServerPart (Either Response Page)
isRedirect String
destination
where
addMessage :: String -> m ()
addMessage message :: 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
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 source :: String
source = do
(url :: String
url, html :: 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
[ "Redirected from <a href=\""
, String
url
, "?redirect=no\" title=\"Go to original page\">"
, String
html
, "</a>"
]
doubleRedirect :: String -> String -> m String
doubleRedirect source :: String
source destination :: String
destination = do
(url :: String
url, html :: String
html) <- String -> m (String, String)
forall (m :: * -> *). ServerMonad m => String -> m (String, String)
processSource String
source
(url' :: String
url', html' :: 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
[ "This page normally redirects to <a href=\""
, String
url'
, "\" title=\"Continue to destination\">"
, String
html'
, "</a>, but as you were already redirected from <a href=\""
, String
url
, "?redirect=no\" title=\"Go to original page\">"
, String
html
, "</a>"
, ", this was stopped to prevent a double-redirect."
]
cancelledRedirect :: String -> m String
cancelledRedirect destination :: String
destination = do
(url' :: String
url', html' :: 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
[ "This page redirects to <a href=\""
, String
url'
, "\" title=\"Continue to destination\">"
, String
html'
, "</a>."
]
processSource :: String -> m (String, String)
processSource source :: 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 destination :: String
destination = do
String
base' <- m String
forall (m :: * -> *). ServerMonad m => m String
getWikiBase
let (page' :: String
page', fragment :: 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
== '#') 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 "referer" Request
request
URIRef Absolute
uri <- case URIParserOptions
-> ByteString -> Either URIParseError (URIRef Absolute)
parseURI URIParserOptions
laxURIParserOptions ByteString
referer of
Left _ -> Maybe (URIRef Absolute)
forall a. Maybe a
Nothing
Right uri :: URIRef Absolute
uri -> URIRef Absolute -> Maybe (URIRef Absolute)
forall a. a -> Maybe a
Just URIRef Absolute
uri
let Query params :: [(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 "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 "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]
++ "/") (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 "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 destination :: 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) (\_ -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False) (Params -> Maybe String
pRevision Params
params) of
Nothing -> do
Maybe String
source <- ContentTransformer (Maybe String)
getSource
case Maybe String
source of
Just source' :: 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)
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)
, "?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
[ "<!doctype html><html><head><title>307 Redirect"
, "</title></head><body><p>You are being <a href=\""
, String -> String
stringToHtmlString String
url'
, "\">redirected</a>.</body></p></html>"
]
Just 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
(url' :: String
url', html' :: 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
[ "<!doctype html><html><head><title>Redirecting to "
, String
html'
, "</title><meta http-equiv=\"refresh\" contents=\"0; url="
, String
url'
, "\" /><script type=\"text/javascript\">window.location=\""
, String
url'
, "\"</script></head><body><p>Redirecting to <a href=\""
, String
url'
, "\">"
, String
html'
, "</a>...</p></body></html>"
]
Just 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 s :: 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 pandocContents :: 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 = "$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 "toc" Text
tpl
case Either String (Template Text)
res of
Right t :: Template Text
t -> Template Text -> PandocIO (Template Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Template Text
t
Left e :: 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
MathML -> HTMLMathMethod
Pandoc.MathML
WebTeX u :: String
u -> Text -> HTMLMathMethod
Pandoc.WebTeX (Text -> HTMLMathMethod) -> Text -> HTMLMathMethod
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
u
MathJax u :: String
u -> Text -> HTMLMathMethod
Pandoc.MathJax (Text -> HTMLMathMethod) -> Text -> HTMLMathMethod
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
u
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 Nothing = StateT Context GititServerPart Html
forall (m :: * -> *) a. MonadPlus m => m a
mzero
highlightSource (Just source :: 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
(l :: Syntax
l:_) -> 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
/='\r') String
source of
Left e :: 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 r :: [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 x :: Pandoc -> PluginM Pandoc
x) = (Pandoc -> PluginM Pandoc) -> Maybe (Pandoc -> PluginM Pandoc)
forall a. a -> Maybe a
Just Pandoc -> PluginM Pandoc
x
pageTransform _ = 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 x :: String -> PluginM String
x) = (String -> PluginM String) -> Maybe (String -> PluginM String)
forall a. a -> Maybe a
Just String -> PluginM String
x
preParseTransform _ = 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 x :: String -> PluginM String
x) = (String -> PluginM String) -> Maybe (String -> PluginM String)
forall a. a -> Maybe a
Just String -> PluginM String
x
preCommitTransform _ = Maybe (String -> PluginM String)
forall a. Maybe a
Nothing
applyTransform :: a -> (a -> PluginM a) -> ContentTransformer a
applyTransform :: a -> (a -> PluginM a) -> ContentTransformer a
applyTransform inp :: a
inp transform :: 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 }
(result' :: a
result', context' :: 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 c :: 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
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
>>=
(\t :: 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 c :: 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 c :: 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 ctg :: 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]
++ "/_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 "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 "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 title' :: String
title' (Pandoc _ blocks :: [Block]
blocks) = do
(PageLayout -> PageLayout) -> ContentTransformer ()
updateLayout ((PageLayout -> PageLayout) -> ContentTransformer ())
-> (PageLayout -> PageLayout) -> ContentTransformer ()
forall a b. (a -> b) -> a -> b
$ \layout :: 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 "title" (Text -> Inlines
B.str (String -> Text
T.pack String
title')) Meta
nullMeta)
[Block]
blocks
addMathSupport :: a -> ContentTransformer a
addMathSupport :: a -> ContentTransformer a
addMathSupport c :: 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
$ \l :: PageLayout
l ->
case Config -> MathMethod
mathMethod Config
conf of
MathML -> PageLayout -> [String] -> PageLayout
addScripts PageLayout
l ["MathMLinHTML.js"]
WebTeX _ -> PageLayout
l
MathJax u :: String
u -> PageLayout -> [String] -> PageLayout
addScripts PageLayout
l [String
u]
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 layout :: PageLayout
layout scriptPaths :: [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 f :: 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 pt :: PageType
pt lhs :: 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
RST -> ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readRST ReaderOptions
defPS
Markdown -> ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readMarkdown ReaderOptions
defPS
CommonMark -> ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readCommonMark ReaderOptions
defPS
LaTeX -> ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readLaTeX ReaderOptions
defPS
HTML -> ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readHtml ReaderOptions
defPS
Textile -> ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readTextile ReaderOptions
defPS
Org -> ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readOrg ReaderOptions
defPS
DocBook -> ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> m Pandoc
readDocBook ReaderOptions
defPS
MediaWiki -> ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *).
PandocMonad m =>
ReaderOptions -> Text -> 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
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 cfg :: Config
cfg (Link attr :: Attr
attr ref :: [Inline]
ref ("", "")) | Config -> Bool
useAbsoluteUrls Config
cfg =
Attr -> [Inline] -> Target -> Inline
Link Attr
attr [Inline]
ref (String -> Text
T.pack ("/" String -> String -> String
</> Config -> String
baseUrl Config
cfg String -> String -> String
</> [Inline] -> String
inlinesToURL [Inline]
ref),
"Go to wiki page")
convertWikiLinks _cfg :: Config
_cfg (Link attr :: Attr
attr ref :: [Inline]
ref ("", "")) =
Attr -> [Inline] -> Target -> Inline
Link Attr
attr [Inline]
ref (String -> Text
T.pack ([Inline] -> String
inlinesToURL [Inline]
ref), "Go to wiki page")
convertWikiLinks _cfg :: Config
_cfg x :: 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 x :: Inline
x = case Inline
x of
Str s :: Text
s -> Text
s
Emph xs :: [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 xs :: [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 xs :: [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 xs :: [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 xs :: [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 xs :: [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 xs -> mconcat $ map go xs
#endif
Quoted DoubleQuote xs :: [Inline]
xs -> "\"" 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
<> "\""
Quoted SingleQuote xs :: [Inline]
xs -> "'" 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
<> "'"
Cite _ xs :: [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 _ s :: Text
s -> Text
s
Space -> " "
SoftBreak -> " "
LineBreak -> " "
Math DisplayMath s :: Text
s -> "$$" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "$$"
Math InlineMath s :: Text
s -> "$" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "$"
RawInline (Format "tex") s :: Text
s -> Text
s
RawInline _ _ -> ""
Link _ xs :: [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
Image _ xs :: [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
Note _ -> ""
Span _ xs :: [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