git.iko.soy/typeable/pandoc
on 2.11 help sign in
typeable/pandoc/trypandoc/trypandoc.hs
81 lines 3.3 kB history raw
1{-# LANGUAGE NoImplicitPrelude #-}
2{-# LANGUAGE OverloadedStrings #-}
3{- |
4 Module : Main
5 Copyright : © 2014-2020 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 standalone <- (==) "1" . fromMaybe "" <$> getParam "standalone"
45 compiledTemplate <- runIO . compileDefaultTemplate $ toFormat
46 let template = if standalone then either (const Nothing) Just compiledTemplate else Nothing
47 let reader = case runPure $ getReader fromFormat of
48 Right (TextReader r, es) -> r readerOpts{
49 readerExtensions = es }
50 _ -> error $ "could not find reader for "
51 ++ T.unpack fromFormat
52 let writer = case runPure $ getWriter toFormat of
53 Right (TextWriter w, es) -> w writerOpts{
54 writerExtensions = es, writerTemplate = template }
55 _ -> error $ "could not find writer for " ++
56 T.unpack toFormat
57 let result = case runPure $ reader (tabFilter 4 text) >>= writer of
58 Right s -> s
59 Left err -> error (show err)
60 let output = encode $ object [ T.pack "html" .= result
61 , T.pack "name" .=
62 if fromFormat == "markdown_strict"
63 then T.pack "pandoc (strict)"
64 else T.pack "pandoc"
65 , T.pack "version" .= pandocVersion]
66 respond $ responseLBS status200 [(hContentType,"text/json; charset=UTF-8")] output
68checkLength :: Text -> IO Text
69checkLength t =
70 if T.length t > 10000
71 then error "exceeds length limit of 10,000 characters"
72 else return t
74writerOpts :: WriterOptions
75writerOpts = def { writerReferenceLinks = True,
76 writerEmailObfuscation = NoObfuscation,
77 writerHTMLMathMethod = MathJax defaultMathJaxURL,
78 writerHighlightStyle = Just pygments }
80readerOpts :: ReaderOptions
81readerOpts = def