blob: b00d66d0d3c66f74a00ad75edcc3447de83253e0 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
Module : Main
Copyright : © 2014-2019 John MacFarlane <jgm@berkeley.edu>
License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <jgm@berkeley.edu>
Stability : alpha
Portability : portable
Provides a webservice which allows to try pandoc in the browser.
-}
module Main where
import Prelude
import Network.Wai.Handler.CGI
import Network.Wai
import Control.Applicative ((<$>))
import Data.Maybe (fromMaybe)
import Network.HTTP.Types.Status (status200)
import Network.HTTP.Types.Header (hContentType)
import Network.HTTP.Types.URI (queryToQueryText)
import Text.Pandoc
import Text.Pandoc.Writers.Math (defaultMathJaxURL)
import Text.Pandoc.Highlighting (pygments)
import Text.Pandoc.Readers (getReader, Reader(..))
import Text.Pandoc.Writers (getWriter, Writer(..))
import Text.Pandoc.Shared (tabFilter)
import Data.Aeson
import qualified Data.Text as T
import Data.Text (Text)
main :: IO ()
main = run app
app :: Application
app req respond = do
let query = queryToQueryText $ queryString req
let getParam x = maybe (error $ T.unpack x ++ " parameter not set")
return $ lookup x query
text <- getParam "text" >>= checkLength . fromMaybe T.empty
fromFormat <- fromMaybe "" <$> getParam "from"
toFormat <- fromMaybe "" <$> getParam "to"
let reader = case runPure $ getReader (T.unpack fromFormat) of
Right (TextReader r, es) -> r readerOpts{
readerExtensions = es }
_ -> error $ "could not find reader for "
++ T.unpack fromFormat
let writer = case runPure $ getWriter (T.unpack toFormat) of
Right (TextWriter w, es) -> w writerOpts{
writerExtensions = es }
_ -> error $ "could not find writer for " ++
T.unpack toFormat
let result = case runPure $ reader (tabFilter 4 text) >>= writer of
Right s -> s
Left err -> error (show err)
let output = encode $ object [ T.pack "html" .= result
, T.pack "name" .=
if fromFormat == "markdown_strict"
then T.pack "pandoc (strict)"
else T.pack "pandoc"
, T.pack "version" .= pandocVersion]
respond $ responseLBS status200 [(hContentType,"text/json; charset=UTF-8")] output
checkLength :: Text -> IO Text
checkLength t =
if T.length t > 10000
then error "exceeds length limit of 10,000 characters"
else return t
writerOpts :: WriterOptions
writerOpts = def { writerReferenceLinks = True,
writerEmailObfuscation = NoObfuscation,
writerHTMLMathMethod = MathJax (defaultMathJaxURL ++
"tex-mml-chtml.js"),
writerHighlightStyle = Just pygments }
readerOpts :: ReaderOptions
readerOpts = def
|
