{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-
Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu>

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

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

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

{- Functions for exporting wiki pages in various formats.
-}

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}
    -- We sanitize the body only, to protect against XSS attacks.
    -- (Sanitizing the whole HTML page would strip out javascript
    -- needed for the slides.)  We then pass the body into the
    -- slide template using the 'body' variable.
    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) -- just body
          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
              -- ensure that LaTeX \include commands can't include
              -- files outside the working directory, e.g. /etc/passwd:
              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}

-- | When we create a PDF or ODT from a Gitit page, we need to fix the URLs of any
-- images on the page. Those URLs will often be relative to the staticDir, but the
-- PDF or ODT processor only understands paths relative to the working directory.
--
-- Because the working directory will not in general be the root of the gitit instance
-- at the time the Pandoc is fed to e.g. pdflatex, this function replaces the URLs of
-- images in the staticDir with their correct absolute file path.
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)     -- (description, writer)
                , (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