Added trypandoc flag to build trypandoc cgi executable.

Supporting files are in trypandoc/.
2014-08-17 16:11:09 -07:00 · 2014-08-17 16:11:09 -07:00 · 886cc0dd36
commit 886cc0dd36
parent fa0d9a28df
4 changed files with 269 additions and 0 deletions
--- a/pandoc.cabal
+++ b/pandoc.cabal
@ -93,6 +93,9 @@ Extra-Source-Files:
                 -- generated man pages (produced post-build)
                 man/man1/pandoc.1
                 man/man5/pandoc_markdown.5
+                 -- trypandoc
+                 trypandoc/Makefile
+                 trypandoc/index.html
                 -- tests
                 tests/bodybg.gif
                 tests/*.native
@ -184,6 +187,10 @@ Flag embed_data_files
  Description:   Embed data files in binary for relocatable executable.
  Default:       False

+Flag trypandoc
+  Description:   Build trypandoc cgi executable.
+  Default:       False
+
 Flag https
  Description:   Enable support for downloading of resources over https.
  Default:       True
@ -352,6 +359,17 @@ Executable pandoc
  Main-Is:         pandoc.hs
  Buildable:       True

+Executable trypandoc
+  Main-Is:         trypandoc.hs
+  Hs-Source-Dirs:  trypandoc
+  build-depends:   base, aeson, pandoc, highlighting-kate,
+                   text, wai-extra, wai >= 0.3, http-types
+  default-language: Haskell2010
+  if flag(trypandoc)
+    Buildable:     True
+  else
+    Buildable:     False
+
 -- NOTE:  A trick in Setup.hs makes sure this won't be installed:
 Executable make-pandoc-man-pages
  Main-Is:       make-pandoc-man-pages.hs
--- a/trypandoc/Makefile
+++ b/trypandoc/Makefile
@ -0,0 +1,14 @@
+CGIBIN=/home/website/cgi-bin
+TRYPANDOC=/home/website/html/pandoc/try/
+CGI=${CGIBIN}/trypandoc
+BIN=../dist/build/trypandoc/trypandoc
+
+install: ${CGI} ${TRYPANDOC}/index.html
+
+${TRYPANDOC}/%: %
+	cp $< $@ && chown website:www-data $@ && chmod a+r $@
+
+${CGI}: ${BIN}
+	cp $< $@ && chown website:www-data $@ && chmod a+rx $@
+
+.PHONY: install
--- a/trypandoc/index.html
+++ b/trypandoc/index.html
@ -0,0 +1,137 @@
+<!doctype html>
+<html lang="en">
+<head>
+  <meta charset="utf-8">
+  <title>Try pandoc!</title>
+  <script src="//code.jquery.com/jquery-1.11.0.min.js"></script>
+  <script src="//maxcdn.bootstrapcdn.com/bootstrap/3.1.1/js/bootstrap.min.js"></script>
+  <link href="//maxcdn.bootstrapcdn.com/bootstrap/3.1.1/css/bootstrap.min.css" rel="stylesheet">
+  <script type="text/javascript">
+(function($) { // http://stackoverflow.com/questions/901115/how-can-i-get-query-string-values
+	$.QueryString = (function(a) {
+	    if (a == "") return {};
+	    var b = {};
+	    for (var i = 0; i < a.length; ++i)
+	    {
+		var p=a[i].split('=');
+		if (p.length != 2) continue;
+		b[p[0]] = decodeURIComponent(p[1].replace(/\+/g, " "));
+	    }
+	    return b;
+        })(window.location.search.substr(1).split('&'))
+})(jQuery);
+
+function newpage() {
+  var input = $("#text").val();
+  var from = $("#from").val();
+  var to = $("#to").val();
+  var href = window.location.href;
+  window.location.href = href.replace(/([?].*)?$/,"?" + $.param({text: input, from: from, to: to}));
+};
+
+function process(res) {
+  $("#results").text(res.result);
+  $("#version").text(res.version);
+}
+
+$(document).ready(function() {
+    var text = $.QueryString["text"];
+    $("#text").val(text);
+    var from = $.QueryString["from"] || "markdown";
+    $("#from").val(from);
+    var to = $.QueryString["to"] || "html";
+    $("#to").val(to);
+    if (text && text != "") {
+       $.getJSON("http://johnmacfarlane.net/cgi-bin/trypandoc", { from: from, to: to, text: text }, process);
+    };
+    $("#convert").click(newpage);
+});
+  </script>
+  <style type="text/css">
+    h1 { margin-bottom: 1em; }
+    body { margin: auto; }
+    textarea { height: auto; width: 100%; font-family: monospace; margin-top: 15px; }
+    div.alert { margin: 1em; }
+    h3 { margin-top: 0; margin-bottom: 0; padding: 0; font-size: 100%; }
+    pre#results { width: 100%; margin-top: 15px; }
+    footer { color: #555; text-align: center; margin: 1em; }
+    p.version { color: #555; }
+    button#convert { vertical-align: bottom; }
+  </style>
+</head>
+<body>
+<div class="container">
+  <div class="row">
+    <h1>Try <a href="http://johnmacfarlane.net/pandoc/">pandoc</a>!</h1>
+  </div>
+  <div class="row">
+    <div class="col-md-6">
+      <label for="from">
+      from
+      </label>
+      <select id="from">
+        <option value="markdown" selected>Markdown</option>
+        <option value="markdown_strict">Markdown/strict</option>
+        <option value="markdown_phpextra">PHP Markdown Extra</option>
+        <option value="markdown_github">Github Markdown</option>
+        <option value="markdown_mmd">MultiMarkdown</option>
+        <option value="rst">reStructuredText</option>
+        <option value="textile">Textile</option>
+        <option value="latex">LaTeX</option>
+        <option value="html">HTML</option>
+        <option value="docbook">DocBook</option>
+        <option value="opml">OPML</option>
+        <option value="org">Emacs Org Mode</option>
+        <option value="t2t">Txt2Tags</option>
+        <option value="mediawiki">MediaWiki</option>
+        <option value="haddock">Haddock markup</option>
+      </select>
+      <br/>
+      <textarea id="text" maxlength="3000" rows="15"></textarea>
+    </div>
+    <div class="col-md-6">
+      <label for="to">
+      to
+      </label>
+      <select id="to">
+        <option value="html" selected>HTML</option>
+        <option value="html5">HTML 5</option>
+        <option value="markdown">Markdown</option>
+        <option value="markdown_strict">Markdown/strict</option>
+        <option value="markdown_phpextra">PHP Markdown Extra</option>
+        <option value="markdown_github">Github Markdown</option>
+        <option value="markdown_mmd">MultiMarkdown</option>
+        <option value="rst">reStructuredText</option>
+        <option value="asciidoc">AsciiDoc</option>
+        <option value="textile">Textile</option>
+        <option value="mediawiki">MediaWiki</option>
+        <option value="dokuwiki">DokuWiki</option>
+        <option value="org">Emacs Org Mode</option>
+        <option value="latex">LaTeX</option>
+        <option value="beamer">LaTeX Beamer</option>
+        <option value="context">ConTeXt</option>
+        <option value="man">Groff man</option>
+        <option value="texinfo">Texinfo</option>
+        <option value="docbook">DocBook</option>
+        <option value="opml">OPML</option>
+        <option value="icml">ICML</option>
+        <option value="opendocument">OpenDocument</option>
+        <option value="rtf">RTF</option>
+        <option value="dzslides">DZSlides</option>
+        <option value="slidy">Slidy</option>
+        <option value="S5">S5</option>
+        <option value="slideous">Slideous</option>
+      </select>
+      &nbsp;
+      <button class="btn btn-primary btn-xs" id="convert">Convert</button>
+      <br/>
+      <pre id="results"></pre>
+    </div>
+  </div>
+</div>
+<footer>
+ <p class="version">pandoc <span id="version"></span></p>
+ <p>&copy; 2013&ndash;2014 <a href="http://johnmacfarlane.net">John MacFarlane</a></p>
+</footer>
+</body>
+</html>
--- a/trypandoc/trypandoc.hs
+++ b/trypandoc/trypandoc.hs
@ -0,0 +1,100 @@
+{-# 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.Shared (tabFilter)
+import Text.Highlighting.Kate (pygments)
+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 = T.pack $ writer $ reader $ tabFilter 4 $ T.unpack text
+  let output = encode $ object [ T.pack "result" .= 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,
+                   writerHighlightStyle = pygments }
+
+readerOpts :: ReaderOptions
+readerOpts = def { readerParseRaw = True,
+                   readerSmart = True }
+
+fromFormats :: [(Text, String -> 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
+