git.iko.soy/typeable/pandoc
on mallard help sign in
typeable/pandoc/trypandoc/trypandoc.hs
103 lines 4.7 kB history raw
1{-# LANGUAGE OverloadedStrings #-}
2module Main where
3import Network.Wai.Handler.CGI
4import Network.Wai
5import Control.Applicative ((<$>))
6import Data.Maybe (mapMaybe, fromMaybe)
7import Network.HTTP.Types.Status (status200)
8import Network.HTTP.Types.Header (hContentType)
9import Network.HTTP.Types.URI (queryToQueryText)
10import Text.Pandoc
11import Text.Pandoc.Error (PandocError)
12import Text.Pandoc.Shared (tabFilter)
13import Text.Highlighting.Kate (pygments)
14import Data.Aeson
15import qualified Data.Text as T
16import Data.Text (Text)
18main :: IO ()
19main = run app
21app :: Application
22app req respond = do
23 let query = queryToQueryText $ queryString req
24 let getParam x = maybe (error $ T.unpack x ++ " paramater not set")
25 return $ lookup x query
26 text <- getParam "text" >>= checkLength . fromMaybe T.empty
27 fromFormat <- fromMaybe "" <$> getParam "from"
28 toFormat <- fromMaybe "" <$> getParam "to"
29 reader <- maybe (error $ "could not find reader for " ++ T.unpack fromFormat) return
30 $ lookup fromFormat fromFormats
31 let writer = maybe (error $ "could not find writer for " ++ T.unpack toFormat) id
32 $ lookup toFormat toFormats
33 let result = case reader $ tabFilter 4 $ T.unpack text of
34 Right doc -> T.pack $ writer doc
35 Left err -> error (show err)
36 let output = encode $ object [ T.pack "result" .= result
37 , T.pack "name" .=
38 if fromFormat == "markdown_strict"
39 then T.pack "pandoc (strict)"
40 else T.pack "pandoc"
41 , T.pack "version" .= pandocVersion]
42 respond $ responseLBS status200 [(hContentType,"text/json; charset=UTF-8")] output
44checkLength :: Text -> IO Text
45checkLength t =
46 if T.length t > 10000
47 then error "exceeds length limit of 10,000 characters"
48 else return t
50writerOpts :: WriterOptions
51writerOpts = def { writerReferenceLinks = True,
52 writerEmailObfuscation = NoObfuscation,
53 writerHTMLMathMethod = MathJax "http://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML",
54 writerHighlight = True,
55 writerHighlightStyle = pygments }
57readerOpts :: ReaderOptions
58readerOpts = def { readerParseRaw = True,
59 readerSmart = True }
61fromFormats :: [(Text, String -> Either PandocError Pandoc)]
62fromFormats = [
63 ("native" , readNative)
64 ,("json" , Text.Pandoc.readJSON readerOpts)
65 ,("markdown" , readMarkdown readerOpts)
66 ,("markdown_strict" , readMarkdown readerOpts{
67 readerExtensions = strictExtensions,
68 readerSmart = False })
69 ,("markdown_phpextra" , readMarkdown readerOpts{
70 readerExtensions = phpMarkdownExtraExtensions })
71 ,("markdown_github" , readMarkdown readerOpts{
72 readerExtensions = githubMarkdownExtensions })
73 ,("markdown_mmd", readMarkdown readerOpts{
74 readerExtensions = multimarkdownExtensions })
75 ,("rst" , readRST readerOpts)
76 ,("mediawiki" , readMediaWiki readerOpts)
77 ,("docbook" , readDocBook readerOpts)
78 ,("opml" , readOPML readerOpts)
79 ,("t2t" , readTxt2TagsNoMacros readerOpts)
80 ,("org" , readOrg readerOpts)
81 ,("textile" , readTextile readerOpts) -- TODO : textile+lhs
82 ,("html" , readHtml readerOpts)
83 ,("latex" , readLaTeX readerOpts)
84 ,("haddock" , readHaddock readerOpts)
85 ]
87toFormats :: [(Text, Pandoc -> String)]
88toFormats = mapMaybe (\(x,y) ->
89 case y of
90 PureStringWriter w -> Just (T.pack x, w writerOpts{
91 writerExtensions =
92 case x of
93 "markdown_strict" -> strictExtensions
94 "markdown_phpextra" -> phpMarkdownExtraExtensions
95 "markdown_mmd" -> multimarkdownExtensions
96 "markdown_github" -> githubMarkdownExtensions
97 _ -> pandocExtensions
98 })
99 _ ->
100 case x of
101 "rtf" -> Just (T.pack x, writeRTF writerOpts)
102 _ -> Nothing) writers