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