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