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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
|
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Network.Wai.Handler.CGI
import Network.Wai
import Control.Applicative ((<$>))
import Data.Maybe (mapMaybe, 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.Error (PandocError)
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 ++ " paramater not set")
return $ lookup x query
text <- getParam "text" >>= checkLength . fromMaybe T.empty
fromFormat <- fromMaybe "" <$> getParam "from"
toFormat <- fromMaybe "" <$> getParam "to"
reader <- maybe (error $ "could not find reader for " ++ T.unpack fromFormat) return
$ lookup fromFormat fromFormats
let writer = maybe (error $ "could not find writer for " ++ T.unpack toFormat) id
$ lookup toFormat toFormats
let result = case reader $ tabFilter 4 $ T.unpack text of
Right doc -> T.pack $ writer doc
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 "http://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML",
writerHighlight = True }
readerOpts :: ReaderOptions
readerOpts = def { readerParseRaw = True,
readerSmart = True }
fromFormats :: [(Text, String -> Either PandocError Pandoc)]
fromFormats = [
("native" , readNative)
,("json" , Text.Pandoc.readJSON readerOpts)
,("markdown" , readMarkdown readerOpts)
,("markdown_strict" , readMarkdown readerOpts{
readerExtensions = strictExtensions,
readerSmart = False })
,("markdown_phpextra" , readMarkdown readerOpts{
readerExtensions = phpMarkdownExtraExtensions })
,("markdown_github" , readMarkdown readerOpts{
readerExtensions = githubMarkdownExtensions })
,("markdown_mmd", readMarkdown readerOpts{
readerExtensions = multimarkdownExtensions })
,("rst" , readRST readerOpts)
,("mediawiki" , readMediaWiki readerOpts)
,("docbook" , readDocBook readerOpts)
,("opml" , readOPML readerOpts)
,("t2t" , readTxt2TagsNoMacros readerOpts)
,("org" , readOrg readerOpts)
,("textile" , readTextile readerOpts) -- TODO : textile+lhs
,("html" , readHtml readerOpts)
,("latex" , readLaTeX readerOpts)
,("haddock" , readHaddock readerOpts)
]
toFormats :: [(Text, Pandoc -> String)]
toFormats = mapMaybe (\(x,y) ->
case y of
PureStringWriter w -> Just (T.pack x, w writerOpts{
writerExtensions =
case x of
"markdown_strict" -> strictExtensions
"markdown_phpextra" -> phpMarkdownExtraExtensions
"markdown_mmd" -> multimarkdownExtensions
"markdown_github" -> githubMarkdownExtensions
_ -> pandocExtensions
})
_ ->
case x of
"rtf" -> Just (T.pack x, writeRTF writerOpts)
_ -> Nothing) writers
|
