diff --git a/pandoc.cabal b/pandoc.cabal index 78c501d1b..9afd9507e 100644 --- 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 diff --git a/trypandoc/Makefile b/trypandoc/Makefile new file mode 100644 index 000000000..29942ac00 --- /dev/null +++ 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 diff --git a/trypandoc/index.html b/trypandoc/index.html new file mode 100644 index 000000000..2c9c55ef2 --- /dev/null +++ b/trypandoc/index.html @@ -0,0 +1,137 @@ + + + + + Try pandoc! + + + + + + + +
+
+

Try pandoc!

+
+
+
+ + +
+ +
+
+ + +   + +
+ 

+    

+  

+

+
+
+
diff --git a/trypandoc/trypandoc.hs b/trypandoc/trypandoc.hs
new file mode 100644
index 000000000..c530f45f2
--- /dev/null
+++ 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
+