    {-# 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.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 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 templ :: String
    templ mimetype :: String
    mimetype ext :: String
    ext fn :: WriterOptions -> Pandoc -> PandocIO ByteString
    fn opts :: WriterOptions
    opts page :: String
    page doc :: 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` ["odt","pdf","beamer","epub","docx","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
    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 templ :: String
    templ mimetype :: String
    mimetype ext :: String
    ext fn :: WriterOptions -> Pandoc -> PandocIO Text
    fn =
      String
    -> String
    -> String
    -> (WriterOptions -> Pandoc -> PandocIO ByteString)
    -> WriterOptions
    -> String
    -> Pandoc
    -> Handler
    respondX String
    templ String
    mimetype String
    ext (\o :: WriterOptions
    o d :: 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 templ :: String
    templ fn :: WriterOptions -> Pandoc -> PandocIO Text
    fn page :: String
    page doc :: Pandoc
    doc = do
        Config
    cfg <- GititServerPart Config
    getConfig
        let math :: HTMLMathMethod
    math = 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
                       _            -> 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
    meta blocks :: [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 key :: String
    key val :: String
    val (DT.Context ctx :: 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 "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 "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
    == "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
    $ "dzslides" 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 "<!-- {{{{ 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 ""
              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 "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 "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 "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 "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]
    ++ ".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 "latex" "application/x-latex" "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 "context" "application/x-context" "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 "rtf" "application/rtf" "rtf"
      (\o :: WriterOptions
    o d :: 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 "rst" "text/plain; charset=utf-8" ""
      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 "markdown" "text/plain; charset=utf-8" ""
      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 "commonmark" "text/plain; charset=utf-8" ""
      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 "plain" "text/plain; charset=utf-8" ""
      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 "man" "text/plain; charset=utf-8" ""
      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 "texinfo" "application/x-texinfo" "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 "docbook" "application/docbook+xml" "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 "org" "text/plain; charset=utf-8" ""
      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 "icml" "application/xml; charset=utf-8" ""
                  (\o :: WriterOptions
    o d :: 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 "textile" "text/plain; charset=utf-8" ""
      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 "asciidoc" "text/plain; charset=utf-8" ""
      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 "mediawiki" "text/plain; charset=utf-8" ""
      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 "opendocument" "application/vnd.oasis.opendocument.text"
                  "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 "html" "application/epub+zip" "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 "native"
      "application/vnd.openxmlformats-officedocument.wordprocessingml.document"
      "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 useBeamer :: Bool
    useBeamer page :: String
    page old_pndc :: 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
    >>= \pndc :: 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 "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]
    ++ ".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 (_modtime :: UTCTime
    _modtime, bs :: 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]
                Nothing -> do
                  let toc :: Bool
    toc = Config -> Bool
    tableOfContents Config
    cfg
                  Either PandocError (Either ByteString ByteString)
    res <- IO (Either PandocError (Either ByteString ByteString))
    -> ServerPartT
         (ReaderT WikiState IO)
         (Either PandocError (Either ByteString ByteString))
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either PandocError (Either ByteString ByteString))
     -> ServerPartT
          (ReaderT WikiState IO)
          (Either PandocError (Either ByteString ByteString)))
    -> IO (Either PandocError (Either ByteString ByteString))
    -> ServerPartT
         (ReaderT WikiState IO)
         (Either PandocError (Either ByteString ByteString))
    forall a b. (a -> b) -> a -> b
    $ 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 "beamer" else "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 "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
     -> ServerPartT
          (ReaderT WikiState IO) (Either ByteString ByteString))
    -> (Either ByteString ByteString
        -> ServerPartT
             (ReaderT WikiState IO) (Either ByteString ByteString))
    -> Either PandocError (Either ByteString ByteString)
    -> ServerPartT
         (ReaderT WikiState IO) (Either ByteString ByteString)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (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))
    -> (PandocError -> IO (Either ByteString ByteString))
    -> PandocError
    -> ServerPartT
         (ReaderT WikiState 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
    -> ServerPartT
         (ReaderT WikiState 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 logOutput' :: ByteString
    logOutput' -> String -> Handler
    forall (m :: * -> *). Monad m => String -> ServerPartT m Response
    simpleErrorHandler ("PDF creation failed:\n"
                               String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ByteString -> String
    UTF8.toStringLazy ByteString
    logOutput')
           Right pdfBS :: ByteString
    pdfBS -> do
                  case Maybe (UTCTime, ByteString)
    cached of
                    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
                    _ -> () -> 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 "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]
    ++ ".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 page :: String
    page pndc :: 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
    $ "data" 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
    attr ils :: [Inline]
    ils (url :: Text
    url, title :: 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] -> Target -> Inline
    Image Attr
    attr [Inline]
    ils (String -> Text
    T.pack String
    fixedURL, Text
    title)
            go x :: Inline
    x                        = Inline -> IO Inline
    forall (m :: * -> *) a. Monad m => a -> m a
    return Inline
    x

            fixURL :: String -> IO String
    fixURL ('/':url :: String
    url) = String -> IO String
    resolve String
    url
            fixURL url :: 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 p :: 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 cfg :: Config
    cfg = if Config -> Bool
    pdfExport Config
    cfg
                           then ("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]
    :
                                ("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 = [ ("LaTeX",     String -> Pandoc -> Handler
    respondLaTeX)     -- (description, writer)
                    , ("ConTeXt",   String -> Pandoc -> Handler
    respondConTeXt)
                    , ("Texinfo",   String -> Pandoc -> Handler
    respondTexinfo)
                    , ("reST",      String -> Pandoc -> Handler
    respondRST)
                    , ("Markdown",  String -> Pandoc -> Handler
    respondMarkdown)
                    , ("CommonMark",String -> Pandoc -> Handler
    respondCommonMark)
                    , ("Plain text",String -> Pandoc -> Handler
    respondPlain)
                    , ("MediaWiki", String -> Pandoc -> Handler
    respondMediaWiki)
                    , ("Org-mode",  String -> Pandoc -> Handler
    respondOrg)
                    , ("ICML",      String -> Pandoc -> Handler
    respondICML)
                    , ("Textile",   String -> Pandoc -> Handler
    respondTextile)
                    , ("AsciiDoc",  String -> Pandoc -> Handler
    respondAsciiDoc)
                    , ("Man page",  String -> Pandoc -> Handler
    respondMan)
                    , ("DocBook",   String -> Pandoc -> Handler
    respondDocbook)
                    , ("DZSlides",  String
    -> (WriterOptions -> Pandoc -> PandocIO Text)
    -> String
    -> Pandoc
    -> Handler
    respondSlides "dzslides" WriterOptions -> Pandoc -> PandocIO Text
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> m Text
    writeDZSlides)
                    , ("Slidy",     String
    -> (WriterOptions -> Pandoc -> PandocIO Text)
    -> String
    -> Pandoc
    -> Handler
    respondSlides "slidy" WriterOptions -> Pandoc -> PandocIO Text
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> m Text
    writeSlidy)
                    , ("S5",        String
    -> (WriterOptions -> Pandoc -> PandocIO Text)
    -> String
    -> Pandoc
    -> Handler
    respondSlides "s5" WriterOptions -> Pandoc -> PandocIO Text
    forall (m :: * -> *).
    PandocMonad m =>
    WriterOptions -> Pandoc -> m Text
    writeS5)
                    , ("EPUB",      String -> Pandoc -> Handler
    respondEPUB)
                    , ("ODT",       String -> Pandoc -> Handler
    respondODT)
                    , ("DOCX",      String -> Pandoc -> Handler
    respondDocx)
                    , ("RTF",       String -> Pandoc -> Handler
    respondRTF) ]

    pygmentsCss :: String
    pygmentsCss :: String
    pygmentsCss = Style -> String
    styleToCss Style
    pygments