{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module Network.Gitit.Export ( exportFormats ) where
import Control.Exception (throwIO)
import Text.Pandoc hiding (HTMLMathMethod(..), getDataFileName)
import qualified Text.Pandoc as Pandoc
import Text.Pandoc.PDF (makePDF)
import Text.Pandoc.SelfContained as SelfContained
import qualified Text.Pandoc.UTF8 as UTF8
import qualified Data.Map as M
import Network.Gitit.Server
import Network.Gitit.Framework (pathForPage)
import Network.Gitit.State (getConfig)
import Network.Gitit.Types
import Network.Gitit.Cache (cacheContents, lookupCache)
import Text.DocTemplates as DT
import Control.Monad.Trans (liftIO)
import Control.Monad (unless)
import Text.XHtml (noHtml)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import System.FilePath ((</>), takeDirectory)
import System.Environment (setEnv)
import System.Directory (doesFileExist)
import Text.HTML.SanitizeXSS
import Data.ByteString.Lazy (fromStrict)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.List (isPrefixOf)
import Skylighting (styleToCss, pygments)
import System.IO.Temp (withSystemTempDirectory)
import Paths_gitit (getDataFileName)
defaultRespOptions :: WriterOptions
defaultRespOptions :: WriterOptions
defaultRespOptions = WriterOptions
forall a. Default a => a
def { writerHighlightStyle :: Maybe Style
writerHighlightStyle = Style -> Maybe Style
forall a. a -> Maybe a
Just Style
pygments }
respondX :: String -> String -> String
-> (WriterOptions -> Pandoc -> PandocIO L.ByteString)
-> WriterOptions -> String -> Pandoc -> Handler
respondX :: String
-> String
-> String
-> (WriterOptions -> Pandoc -> PandocIO ByteString)
-> WriterOptions
-> String
-> Pandoc
-> Handler
respondX String
templ String
mimetype String
ext WriterOptions -> Pandoc -> PandocIO ByteString
fn WriterOptions
opts String
page Pandoc
doc = do
Config
cfg <- GititServerPart Config
getConfig
Pandoc
doc' <- if String
ext String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"odt",String
"pdf",String
"beamer",String
"epub",String
"docx",String
"rtf"]
then String -> Pandoc -> GititServerPart Pandoc
fixURLs String
page Pandoc
doc
else Pandoc -> GititServerPart Pandoc
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
doc
Either PandocError ByteString
doc'' <- IO (Either PandocError ByteString)
-> ServerPartT
(ReaderT WikiState IO) (Either PandocError ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either PandocError ByteString)
-> ServerPartT
(ReaderT WikiState IO) (Either PandocError ByteString))
-> IO (Either PandocError ByteString)
-> ServerPartT
(ReaderT WikiState IO) (Either PandocError ByteString)
forall a b. (a -> b) -> a -> b
$ PandocIO ByteString -> IO (Either PandocError ByteString)
forall a. PandocIO a -> IO (Either PandocError a)
runIO (PandocIO ByteString -> IO (Either PandocError ByteString))
-> PandocIO ByteString -> IO (Either PandocError ByteString)
forall a b. (a -> b) -> a -> b
$ do
Maybe String -> PandocIO ()
forall (m :: * -> *). PandocMonad m => Maybe String -> m ()
setUserDataDir (Maybe String -> PandocIO ()) -> Maybe String -> PandocIO ()
forall a b. (a -> b) -> a -> b
$ Config -> Maybe String
pandocUserData Config
cfg
Template Text
compiledTemplate <- Text -> PandocIO (Template Text)
forall (m :: * -> *). PandocMonad m => Text -> m (Template Text)
compileDefaultTemplate (String -> Text
T.pack String
templ)
WriterOptions -> Pandoc -> PandocIO ByteString
fn WriterOptions
opts{ writerTemplate :: Maybe (Template Text)
writerTemplate = Template Text -> Maybe (Template Text)
forall a. a -> Maybe a
Just Template Text
compiledTemplate } Pandoc
doc'
(PandocError -> Handler)
-> (ByteString -> Handler)
-> Either PandocError ByteString
-> Handler
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IO Response -> Handler
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Response -> Handler)
-> (PandocError -> IO Response) -> PandocError -> Handler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocError -> IO Response
forall e a. Exception e => e -> IO a
throwIO)
(Response -> Handler
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok (Response -> Handler)
-> (ByteString -> Response) -> ByteString -> Handler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Response -> Response
setContentType String
mimetype (Response -> Response)
-> (ByteString -> Response) -> ByteString -> Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ext then Response -> Response
forall a. a -> a
id else String -> Response -> Response
setFilename (String
page String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ext)) (Response -> Response)
-> (ByteString -> Response) -> ByteString -> Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
ByteString -> ByteString -> Response
toResponseBS ByteString
B.empty)
Either PandocError ByteString
doc''
respondS :: String -> String -> String -> (WriterOptions -> Pandoc -> PandocIO Text)
-> WriterOptions -> String -> Pandoc -> Handler
respondS :: String
-> String
-> String
-> (WriterOptions -> Pandoc -> PandocIO Text)
-> WriterOptions
-> String
-> Pandoc
-> Handler
respondS String
templ String
mimetype String
ext WriterOptions -> Pandoc -> PandocIO Text
fn =
String
-> String
-> String
-> (WriterOptions -> Pandoc -> PandocIO ByteString)
-> WriterOptions
-> String
-> Pandoc
-> Handler
respondX String
templ String
mimetype String
ext (\WriterOptions
o Pandoc
d -> ByteString -> ByteString
fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString) -> PandocIO Text -> PandocIO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> Pandoc -> PandocIO Text
fn WriterOptions
o Pandoc
d)
respondSlides :: String -> (WriterOptions -> Pandoc -> PandocIO Text) -> String -> Pandoc -> Handler
respondSlides :: String
-> (WriterOptions -> Pandoc -> PandocIO Text)
-> String
-> Pandoc
-> Handler
respondSlides String
templ WriterOptions -> Pandoc -> PandocIO Text
fn String
page Pandoc
doc = do
Config
cfg <- GititServerPart Config
getConfig
let math :: HTMLMathMethod
math = 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
MathMethod
_ -> HTMLMathMethod
Pandoc.PlainMath
let opts' :: WriterOptions
opts' = WriterOptions
defaultRespOptions { writerIncremental :: Bool
writerIncremental = Bool
True
, writerHTMLMathMethod :: HTMLMathMethod
writerHTMLMathMethod = HTMLMathMethod
math}
Pandoc Meta
meta [Block]
blocks <- String -> Pandoc -> GititServerPart Pandoc
fixURLs String
page Pandoc
doc
Either PandocError Text
docOrError <- IO (Either PandocError Text)
-> ServerPartT (ReaderT WikiState IO) (Either PandocError Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either PandocError Text)
-> ServerPartT (ReaderT WikiState IO) (Either PandocError Text))
-> IO (Either PandocError Text)
-> ServerPartT (ReaderT WikiState IO) (Either PandocError Text)
forall a b. (a -> b) -> a -> b
$ PandocIO Text -> IO (Either PandocError Text)
forall a. PandocIO a -> IO (Either PandocError a)
runIO (PandocIO Text -> IO (Either PandocError Text))
-> PandocIO Text -> IO (Either PandocError Text)
forall a b. (a -> b) -> a -> b
$ do
Maybe String -> PandocIO ()
forall (m :: * -> *). PandocMonad m => Maybe String -> m ()
setUserDataDir (Maybe String -> PandocIO ()) -> Maybe String -> PandocIO ()
forall a b. (a -> b) -> a -> b
$ Config -> Maybe String
pandocUserData Config
cfg
Text
body' <- WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeHtml5String WriterOptions
opts' (Meta -> [Block] -> Pandoc
Pandoc Meta
meta [Block]
blocks)
let body'' :: String
body'' = Text -> String
T.unpack
(Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ (if Config -> Bool
xssSanitize Config
cfg then Text -> Text
sanitizeBalance else Text -> Text
forall a. a -> a
id)
(Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
body'
let setVariable :: String -> String -> Context a -> Context a
setVariable String
key String
val (DT.Context Map Text (Val a)
ctx) =
Map Text (Val a) -> Context a
forall a. Map Text (Val a) -> Context a
DT.Context (Map Text (Val a) -> Context a) -> Map Text (Val a) -> Context a
forall a b. (a -> b) -> a -> b
$ Text -> Val a -> Map Text (Val a) -> Map Text (Val a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (String -> Text
T.pack String
key) (Text -> Val a
forall a b. ToContext a b => b -> Val a
toVal (String -> Text
T.pack String
val)) Map Text (Val a)
ctx
Context Text
variables' <- if Config -> MathMethod
mathMethod Config
cfg MathMethod -> MathMethod -> Bool
forall a. Eq a => a -> a -> Bool
== MathMethod
MathML
then do
ByteString
s <- String -> PandocIO ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readDataFile String
"MathMLinHTML.js"
Context Text -> PandocIO (Context Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Context Text -> PandocIO (Context Text))
-> Context Text -> PandocIO (Context Text)
forall a b. (a -> b) -> a -> b
$ String -> String -> Context Text -> Context Text
forall a.
ToContext a Text =>
String -> String -> Context a -> Context a
setVariable String
"mathml-script"
(ByteString -> String
UTF8.toString ByteString
s) Context Text
forall a. Monoid a => a
mempty
else Context Text -> PandocIO (Context Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Context Text
forall a. Monoid a => a
mempty
Template Text
compiledTemplate <- Text -> PandocIO (Template Text)
forall (m :: * -> *). PandocMonad m => Text -> m (Template Text)
compileDefaultTemplate (String -> Text
T.pack String
templ)
String
dzcore <- if String
templ String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"dzslides"
then do
ByteString
dztempl <- String -> PandocIO ByteString
forall (m :: * -> *). PandocMonad m => String -> m ByteString
readDataFile (String -> PandocIO ByteString) -> String -> PandocIO ByteString
forall a b. (a -> b) -> a -> b
$ String
"dzslides" String -> String -> String
</> String
"template.html"
String -> PandocIO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> PandocIO String) -> String -> PandocIO String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"<!-- {{{{ dzslides core")
([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ ByteString -> String
UTF8.toString ByteString
dztempl
else String -> PandocIO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
let opts'' :: WriterOptions
opts'' = WriterOptions
opts'{
writerVariables :: Context Text
writerVariables =
String -> String -> Context Text -> Context Text
forall a.
ToContext a Text =>
String -> String -> Context a -> Context a
setVariable String
"body" String
body'' (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
String -> String -> Context Text -> Context Text
forall a.
ToContext a Text =>
String -> String -> Context a -> Context a
setVariable String
"dzslides-core" String
dzcore (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$
String -> String -> Context Text -> Context Text
forall a.
ToContext a Text =>
String -> String -> Context a -> Context a
setVariable String
"highlighting-css" String
pygmentsCss
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Context Text
variables'
,writerTemplate :: Maybe (Template Text)
writerTemplate = Template Text -> Maybe (Template Text)
forall a. a -> Maybe a
Just Template Text
compiledTemplate }
Text
h <- WriterOptions -> Pandoc -> PandocIO Text
fn WriterOptions
opts'' (Meta -> [Block] -> Pandoc
Pandoc Meta
meta [])
Text -> PandocIO Text
forall (m :: * -> *). PandocMonad m => Text -> m Text
makeSelfContained Text
h
(PandocError -> Handler)
-> (Text -> Handler) -> Either PandocError Text -> Handler
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IO Response -> Handler
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Response -> Handler)
-> (PandocError -> IO Response) -> PandocError -> Handler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocError -> IO Response
forall e a. Exception e => e -> IO a
throwIO)
(Response -> Handler
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
ok (Response -> Handler) -> (Text -> Response) -> Text -> Handler
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Response -> Response
setContentType String
"text/html;charset=UTF-8" (Response -> Response) -> (Text -> Response) -> Text -> Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(String -> Response -> Response
setFilename (String
page String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".html")) (Response -> Response) -> (Text -> Response) -> Text -> Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
ByteString -> ByteString -> Response
toResponseBS ByteString
B.empty (ByteString -> Response)
-> (Text -> ByteString) -> Text -> Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
UTF8.fromText)
Either PandocError Text
docOrError
respondLaTeX :: String -> Pandoc -> Handler
respondLaTeX :: String -> Pandoc -> Handler
respondLaTeX = String
-> String
-> String
-> (WriterOptions -> Pandoc -> PandocIO Text)
-> WriterOptions
-> String
-> Pandoc
-> Handler
respondS String
"latex" String
"application/x-latex" String
"tex"
WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeLaTeX WriterOptions
defaultRespOptions
respondConTeXt :: String -> Pandoc -> Handler
respondConTeXt :: String -> Pandoc -> Handler
respondConTeXt = String
-> String
-> String
-> (WriterOptions -> Pandoc -> PandocIO Text)
-> WriterOptions
-> String
-> Pandoc
-> Handler
respondS String
"context" String
"application/x-context" String
"tex"
WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeConTeXt WriterOptions
defaultRespOptions
respondRTF :: String -> Pandoc -> Handler
respondRTF :: String -> Pandoc -> Handler
respondRTF = String
-> String
-> String
-> (WriterOptions -> Pandoc -> PandocIO ByteString)
-> WriterOptions
-> String
-> Pandoc
-> Handler
respondX String
"rtf" String
"application/rtf" String
"rtf"
(\WriterOptions
o Pandoc
d -> ByteString -> ByteString
L.fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
UTF8.fromText (Text -> ByteString) -> PandocIO Text -> PandocIO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeRTF WriterOptions
o Pandoc
d) WriterOptions
defaultRespOptions
respondRST :: String -> Pandoc -> Handler
respondRST :: String -> Pandoc -> Handler
respondRST = String
-> String
-> String
-> (WriterOptions -> Pandoc -> PandocIO Text)
-> WriterOptions
-> String
-> Pandoc
-> Handler
respondS String
"rst" String
"text/plain; charset=utf-8" String
""
WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeRST WriterOptions
defaultRespOptions{writerReferenceLinks :: Bool
writerReferenceLinks = Bool
True}
respondMarkdown :: String -> Pandoc -> Handler
respondMarkdown :: String -> Pandoc -> Handler
respondMarkdown = String
-> String
-> String
-> (WriterOptions -> Pandoc -> PandocIO Text)
-> WriterOptions
-> String
-> Pandoc
-> Handler
respondS String
"markdown" String
"text/plain; charset=utf-8" String
""
WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeMarkdown WriterOptions
defaultRespOptions{writerReferenceLinks :: Bool
writerReferenceLinks = Bool
True}
respondCommonMark :: String -> Pandoc -> Handler
respondCommonMark :: String -> Pandoc -> Handler
respondCommonMark = String
-> String
-> String
-> (WriterOptions -> Pandoc -> PandocIO Text)
-> WriterOptions
-> String
-> Pandoc
-> Handler
respondS String
"commonmark" String
"text/plain; charset=utf-8" String
""
WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeCommonMark WriterOptions
defaultRespOptions{writerReferenceLinks :: Bool
writerReferenceLinks = Bool
True}
respondPlain :: String -> Pandoc -> Handler
respondPlain :: String -> Pandoc -> Handler
respondPlain = String
-> String
-> String
-> (WriterOptions -> Pandoc -> PandocIO Text)
-> WriterOptions
-> String
-> Pandoc
-> Handler
respondS String
"plain" String
"text/plain; charset=utf-8" String
""
WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writePlain WriterOptions
defaultRespOptions
respondMan :: String -> Pandoc -> Handler
respondMan :: String -> Pandoc -> Handler
respondMan = String
-> String
-> String
-> (WriterOptions -> Pandoc -> PandocIO Text)
-> WriterOptions
-> String
-> Pandoc
-> Handler
respondS String
"man" String
"text/plain; charset=utf-8" String
""
WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeMan WriterOptions
defaultRespOptions
respondTexinfo :: String -> Pandoc -> Handler
respondTexinfo :: String -> Pandoc -> Handler
respondTexinfo = String
-> String
-> String
-> (WriterOptions -> Pandoc -> PandocIO Text)
-> WriterOptions
-> String
-> Pandoc
-> Handler
respondS String
"texinfo" String
"application/x-texinfo" String
"texi"
WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeTexinfo WriterOptions
defaultRespOptions
respondDocbook :: String -> Pandoc -> Handler
respondDocbook :: String -> Pandoc -> Handler
respondDocbook = String
-> String
-> String
-> (WriterOptions -> Pandoc -> PandocIO Text)
-> WriterOptions
-> String
-> Pandoc
-> Handler
respondS String
"docbook" String
"application/docbook+xml" String
"xml"
WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeDocbook5 WriterOptions
defaultRespOptions
respondOrg :: String -> Pandoc -> Handler
respondOrg :: String -> Pandoc -> Handler
respondOrg = String
-> String
-> String
-> (WriterOptions -> Pandoc -> PandocIO Text)
-> WriterOptions
-> String
-> Pandoc
-> Handler
respondS String
"org" String
"text/plain; charset=utf-8" String
""
WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeOrg WriterOptions
defaultRespOptions
respondICML :: String -> Pandoc -> Handler
respondICML :: String -> Pandoc -> Handler
respondICML = String
-> String
-> String
-> (WriterOptions -> Pandoc -> PandocIO ByteString)
-> WriterOptions
-> String
-> Pandoc
-> Handler
respondX String
"icml" String
"application/xml; charset=utf-8" String
""
(\WriterOptions
o Pandoc
d -> ByteString -> ByteString
L.fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
UTF8.fromText (Text -> ByteString) -> PandocIO Text -> PandocIO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeICML WriterOptions
o Pandoc
d)
WriterOptions
defaultRespOptions
respondTextile :: String -> Pandoc -> Handler
respondTextile :: String -> Pandoc -> Handler
respondTextile = String
-> String
-> String
-> (WriterOptions -> Pandoc -> PandocIO Text)
-> WriterOptions
-> String
-> Pandoc
-> Handler
respondS String
"textile" String
"text/plain; charset=utf-8" String
""
WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeTextile WriterOptions
defaultRespOptions
respondAsciiDoc :: String -> Pandoc -> Handler
respondAsciiDoc :: String -> Pandoc -> Handler
respondAsciiDoc = String
-> String
-> String
-> (WriterOptions -> Pandoc -> PandocIO Text)
-> WriterOptions
-> String
-> Pandoc
-> Handler
respondS String
"asciidoc" String
"text/plain; charset=utf-8" String
""
WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeAsciiDoc WriterOptions
defaultRespOptions
respondMediaWiki :: String -> Pandoc -> Handler
respondMediaWiki :: String -> Pandoc -> Handler
respondMediaWiki = String
-> String
-> String
-> (WriterOptions -> Pandoc -> PandocIO Text)
-> WriterOptions
-> String
-> Pandoc
-> Handler
respondS String
"mediawiki" String
"text/plain; charset=utf-8" String
""
WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeMediaWiki WriterOptions
defaultRespOptions
respondODT :: String -> Pandoc -> Handler
respondODT :: String -> Pandoc -> Handler
respondODT = String
-> String
-> String
-> (WriterOptions -> Pandoc -> PandocIO ByteString)
-> WriterOptions
-> String
-> Pandoc
-> Handler
respondX String
"opendocument" String
"application/vnd.oasis.opendocument.text"
String
"odt" WriterOptions -> Pandoc -> PandocIO ByteString
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writeODT WriterOptions
defaultRespOptions
respondEPUB :: String -> Pandoc -> Handler
respondEPUB :: String -> Pandoc -> Handler
respondEPUB = String
-> String
-> String
-> (WriterOptions -> Pandoc -> PandocIO ByteString)
-> WriterOptions
-> String
-> Pandoc
-> Handler
respondX String
"html" String
"application/epub+zip" String
"epub" WriterOptions -> Pandoc -> PandocIO ByteString
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writeEPUB3
WriterOptions
defaultRespOptions
respondDocx :: String -> Pandoc -> Handler
respondDocx :: String -> Pandoc -> Handler
respondDocx = String
-> String
-> String
-> (WriterOptions -> Pandoc -> PandocIO ByteString)
-> WriterOptions
-> String
-> Pandoc
-> Handler
respondX String
"native"
String
"application/vnd.openxmlformats-officedocument.wordprocessingml.document"
String
"docx" WriterOptions -> Pandoc -> PandocIO ByteString
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m ByteString
writeDocx WriterOptions
defaultRespOptions
respondPDF :: Bool -> String -> Pandoc -> Handler
respondPDF :: Bool -> String -> Pandoc -> Handler
respondPDF Bool
useBeamer String
page Pandoc
old_pndc = String -> Pandoc -> GititServerPart Pandoc
fixURLs String
page Pandoc
old_pndc GititServerPart Pandoc -> (Pandoc -> Handler) -> Handler
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Pandoc
pndc -> do
Config
cfg <- GititServerPart Config
getConfig
Bool
-> ServerPartT (ReaderT WikiState IO) ()
-> ServerPartT (ReaderT WikiState IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Config -> Bool
pdfExport Config
cfg) (ServerPartT (ReaderT WikiState IO) ()
-> ServerPartT (ReaderT WikiState IO) ())
-> ServerPartT (ReaderT WikiState IO) ()
-> ServerPartT (ReaderT WikiState IO) ()
forall a b. (a -> b) -> a -> b
$ String -> ServerPartT (ReaderT WikiState IO) ()
forall a. HasCallStack => String -> a
error String
"PDF export disabled"
let cacheName :: String
cacheName = String -> String -> String
pathForPage String
page (Config -> String
defaultExtension Config
cfg) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".export.pdf"
Maybe (UTCTime, ByteString)
cached <- if Config -> Bool
useCache Config
cfg
then String -> GititServerPart (Maybe (UTCTime, ByteString))
lookupCache String
cacheName
else Maybe (UTCTime, ByteString)
-> GititServerPart (Maybe (UTCTime, ByteString))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (UTCTime, ByteString)
forall a. Maybe a
Nothing
Either ByteString ByteString
pdf' <- case Maybe (UTCTime, ByteString)
cached of
Just (UTCTime
_modtime, ByteString
bs) -> Either ByteString ByteString
-> ServerPartT
(ReaderT WikiState IO) (Either ByteString ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString ByteString
-> ServerPartT
(ReaderT WikiState IO) (Either ByteString ByteString))
-> Either ByteString ByteString
-> ServerPartT
(ReaderT WikiState IO) (Either ByteString ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ByteString ByteString
forall a b. b -> Either a b
Right (ByteString -> Either ByteString ByteString)
-> ByteString -> Either ByteString ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
L.fromChunks [ByteString
bs]
Maybe (UTCTime, ByteString)
Nothing -> IO (Either ByteString ByteString)
-> ServerPartT
(ReaderT WikiState IO) (Either ByteString ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ByteString ByteString)
-> ServerPartT
(ReaderT WikiState IO) (Either ByteString ByteString))
-> IO (Either ByteString ByteString)
-> ServerPartT
(ReaderT WikiState IO) (Either ByteString ByteString)
forall a b. (a -> b) -> a -> b
$
String
-> (String -> IO (Either ByteString ByteString))
-> IO (Either ByteString ByteString)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> m a) -> m a
withSystemTempDirectory String
"gitit" ((String -> IO (Either ByteString ByteString))
-> IO (Either ByteString ByteString))
-> (String -> IO (Either ByteString ByteString))
-> IO (Either ByteString ByteString)
forall a b. (a -> b) -> a -> b
$ \String
tmpdir -> do
let toc :: Bool
toc = Config -> Bool
tableOfContents Config
cfg
String -> String -> IO ()
writeFile (String
tmpdir String -> String -> String
</> String
"texmf.cnf")
String
"openout_any = p\nopenin_any = p\n"
String -> String -> IO ()
setEnv String
"TEXMFCNF" (String
tmpdir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":")
Either PandocError (Either ByteString ByteString)
res <- PandocIO (Either ByteString ByteString)
-> IO (Either PandocError (Either ByteString ByteString))
forall a. PandocIO a -> IO (Either PandocError a)
runIO (PandocIO (Either ByteString ByteString)
-> IO (Either PandocError (Either ByteString ByteString)))
-> PandocIO (Either ByteString ByteString)
-> IO (Either PandocError (Either ByteString ByteString))
forall a b. (a -> b) -> a -> b
$ do
Maybe String -> PandocIO ()
forall (m :: * -> *). PandocMonad m => Maybe String -> m ()
setUserDataDir (Maybe String -> PandocIO ()) -> Maybe String -> PandocIO ()
forall a b. (a -> b) -> a -> b
$ Config -> Maybe String
pandocUserData Config
cfg
[String] -> PandocIO ()
forall (m :: * -> *). PandocMonad m => [String] -> m ()
setInputFiles [Config -> String
baseUrl Config
cfg]
let templ :: Text
templ = if Bool
useBeamer then Text
"beamer" else Text
"latex"
Template Text
compiledTemplate <- Text -> PandocIO (Template Text)
forall (m :: * -> *). PandocMonad m => Text -> m (Template Text)
compileDefaultTemplate Text
templ
String
-> [String]
-> (WriterOptions -> Pandoc -> PandocIO Text)
-> WriterOptions
-> Pandoc
-> PandocIO (Either ByteString ByteString)
makePDF String
"pdflatex" [] (if Bool
useBeamer then WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeBeamer else WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeLaTeX)
WriterOptions
defaultRespOptions{ writerTemplate :: Maybe (Template Text)
writerTemplate = Template Text -> Maybe (Template Text)
forall a. a -> Maybe a
Just Template Text
compiledTemplate
, writerTableOfContents :: Bool
writerTableOfContents = Bool
toc } Pandoc
pndc
(PandocError -> IO (Either ByteString ByteString))
-> (Either ByteString ByteString
-> IO (Either ByteString ByteString))
-> Either PandocError (Either ByteString ByteString)
-> IO (Either ByteString ByteString)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IO (Either ByteString ByteString)
-> IO (Either ByteString ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ByteString ByteString)
-> IO (Either ByteString ByteString))
-> (PandocError -> IO (Either ByteString ByteString))
-> PandocError
-> IO (Either ByteString ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PandocError -> IO (Either ByteString ByteString)
forall e a. Exception e => e -> IO a
throwIO) Either ByteString ByteString -> IO (Either ByteString ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Either PandocError (Either ByteString ByteString)
res
case Either ByteString ByteString
pdf' of
Left ByteString
logOutput' -> String -> Handler
forall (m :: * -> *). Monad m => String -> ServerPartT m Response
simpleErrorHandler (String
"PDF creation failed:\n"
String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
UTF8.toStringLazy ByteString
logOutput')
Right ByteString
pdfBS -> do
case Maybe (UTCTime, ByteString)
cached of
Maybe (UTCTime, ByteString)
Nothing ->
String -> ByteString -> ServerPartT (ReaderT WikiState IO) ()
cacheContents String
cacheName (ByteString -> ServerPartT (ReaderT WikiState IO) ())
-> ByteString -> ServerPartT (ReaderT WikiState IO) ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
pdfBS
Maybe (UTCTime, ByteString)
_ -> () -> ServerPartT (ReaderT WikiState IO) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
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 -> Response
setContentType String
"application/pdf" (Response -> Response) -> Response -> Response
forall a b. (a -> b) -> a -> b
$ String -> Response -> Response
setFilename (String
page String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".pdf") (Response -> Response) -> Response -> Response
forall a b. (a -> b) -> a -> b
$
(Html -> Response
forall a. ToMessage a => a -> Response
toResponse Html
noHtml) {rsBody :: ByteString
rsBody = ByteString
pdfBS}
fixURLs :: String -> Pandoc -> GititServerPart Pandoc
fixURLs :: String -> Pandoc -> GititServerPart Pandoc
fixURLs String
page Pandoc
pndc = do
Config
cfg <- GititServerPart Config
getConfig
String
defaultStatic <- IO String -> ServerPartT (ReaderT WikiState IO) String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> ServerPartT (ReaderT WikiState IO) String)
-> IO String -> ServerPartT (ReaderT WikiState IO) String
forall a b. (a -> b) -> a -> b
$ String -> IO String
getDataFileName (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
"data" String -> String -> String
</> String
"static"
let static :: String
static = Config -> String
staticDir Config
cfg
let repoPath :: String
repoPath = Config -> String
repositoryPath Config
cfg
let go :: Inline -> IO Inline
go (Image Attr
attr [Inline]
ils (Text
url, Text
title)) = do
String
fixedURL <- String -> IO String
fixURL (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
url
Inline -> IO Inline
forall (m :: * -> *) a. Monad m => a -> m a
return (Inline -> IO Inline) -> Inline -> IO Inline
forall a b. (a -> b) -> a -> b
$ Attr -> [Inline] -> (Text, Text) -> Inline
Image Attr
attr [Inline]
ils (String -> Text
T.pack String
fixedURL, Text
title)
go Inline
x = Inline -> IO Inline
forall (m :: * -> *) a. Monad m => a -> m a
return Inline
x
fixURL :: String -> IO String
fixURL (Char
'/':String
url) = String -> IO String
resolve String
url
fixURL String
url = String -> IO String
resolve (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
page String -> String -> String
</> String
url
resolve :: String -> IO String
resolve String
p = do
Bool
sp <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
static String -> String -> String
</> String
p
Bool
dsp <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
defaultStatic String -> String -> String
</> String
p
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (if Bool
sp then String
static String -> String -> String
</> String
p
else (if Bool
dsp then String
defaultStatic String -> String -> String
</> String
p
else String
repoPath String -> String -> String
</> String
p))
IO Pandoc -> GititServerPart Pandoc
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Pandoc -> GititServerPart Pandoc)
-> IO Pandoc -> GititServerPart Pandoc
forall a b. (a -> b) -> a -> b
$ (Inline -> IO Inline) -> Pandoc -> IO Pandoc
forall (m :: * -> *) a b.
(Monad m, Data a, Data b) =>
(a -> m a) -> b -> m b
bottomUpM Inline -> IO Inline
go Pandoc
pndc
exportFormats :: Config -> [(String, String -> Pandoc -> Handler)]
exportFormats :: Config -> [(String, String -> Pandoc -> Handler)]
exportFormats Config
cfg = if Config -> Bool
pdfExport Config
cfg
then (String
"PDF", Bool -> String -> Pandoc -> Handler
respondPDF Bool
False) (String, String -> Pandoc -> Handler)
-> [(String, String -> Pandoc -> Handler)]
-> [(String, String -> Pandoc -> Handler)]
forall a. a -> [a] -> [a]
:
(String
"Beamer", Bool -> String -> Pandoc -> Handler
respondPDF Bool
True) (String, String -> Pandoc -> Handler)
-> [(String, String -> Pandoc -> Handler)]
-> [(String, String -> Pandoc -> Handler)]
forall a. a -> [a] -> [a]
:
[(String, String -> Pandoc -> Handler)]
rest
else [(String, String -> Pandoc -> Handler)]
rest
where rest :: [(String, String -> Pandoc -> Handler)]
rest = [ (String
"LaTeX", String -> Pandoc -> Handler
respondLaTeX)
, (String
"ConTeXt", String -> Pandoc -> Handler
respondConTeXt)
, (String
"Texinfo", String -> Pandoc -> Handler
respondTexinfo)
, (String
"reST", String -> Pandoc -> Handler
respondRST)
, (String
"Markdown", String -> Pandoc -> Handler
respondMarkdown)
, (String
"CommonMark",String -> Pandoc -> Handler
respondCommonMark)
, (String
"Plain text",String -> Pandoc -> Handler
respondPlain)
, (String
"MediaWiki", String -> Pandoc -> Handler
respondMediaWiki)
, (String
"Org-mode", String -> Pandoc -> Handler
respondOrg)
, (String
"ICML", String -> Pandoc -> Handler
respondICML)
, (String
"Textile", String -> Pandoc -> Handler
respondTextile)
, (String
"AsciiDoc", String -> Pandoc -> Handler
respondAsciiDoc)
, (String
"Man page", String -> Pandoc -> Handler
respondMan)
, (String
"DocBook", String -> Pandoc -> Handler
respondDocbook)
, (String
"DZSlides", String
-> (WriterOptions -> Pandoc -> PandocIO Text)
-> String
-> Pandoc
-> Handler
respondSlides String
"dzslides" WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeDZSlides)
, (String
"Slidy", String
-> (WriterOptions -> Pandoc -> PandocIO Text)
-> String
-> Pandoc
-> Handler
respondSlides String
"slidy" WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeSlidy)
, (String
"S5", String
-> (WriterOptions -> Pandoc -> PandocIO Text)
-> String
-> Pandoc
-> Handler
respondSlides String
"s5" WriterOptions -> Pandoc -> PandocIO Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeS5)
, (String
"EPUB", String -> Pandoc -> Handler
respondEPUB)
, (String
"ODT", String -> Pandoc -> Handler
respondODT)
, (String
"DOCX", String -> Pandoc -> Handler
respondDocx)
, (String
"RTF", String -> Pandoc -> Handler
respondRTF) ]
pygmentsCss :: String
pygmentsCss :: String
pygmentsCss = Style -> String
styleToCss Style
pygments