37a82b0b11
Quite a few modules were missing copyright notices. This commit adds copyright notices everywhere via haddock module headers. The old license boilerplate comment is redundant with this and has been removed. Update copyright years to 2019. Closes #4592.
79 lines
3 KiB
Haskell
79 lines
3 KiB
Haskell
{-# LANGUAGE NoImplicitPrelude #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{- |
|
|
Module : Main
|
|
Copyright : © 2014-2019 John MacFarlane <jgm@berkeley.edu>
|
|
License : GNU GPL, version 2 or above
|
|
|
|
Maintainer : John MacFarlane <jgm@berkeley.edu>
|
|
Stability : alpha
|
|
Portability : portable
|
|
|
|
Provides a webservice which allows to try pandoc in the browser.
|
|
-}
|
|
module Main where
|
|
import Prelude
|
|
import Network.Wai.Handler.CGI
|
|
import Network.Wai
|
|
import Control.Applicative ((<$>))
|
|
import Data.Maybe (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.Writers.Math (defaultMathJaxURL)
|
|
import Text.Pandoc.Highlighting (pygments)
|
|
import Text.Pandoc.Readers (getReader, Reader(..))
|
|
import Text.Pandoc.Writers (getWriter, Writer(..))
|
|
import Text.Pandoc.Shared (tabFilter)
|
|
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 ++ " parameter not set")
|
|
return $ lookup x query
|
|
text <- getParam "text" >>= checkLength . fromMaybe T.empty
|
|
fromFormat <- fromMaybe "" <$> getParam "from"
|
|
toFormat <- fromMaybe "" <$> getParam "to"
|
|
let reader = case getReader (T.unpack fromFormat) of
|
|
Right (TextReader r, es) -> r readerOpts{
|
|
readerExtensions = es }
|
|
_ -> error $ "could not find reader for "
|
|
++ T.unpack fromFormat
|
|
let writer = case getWriter (T.unpack toFormat) of
|
|
Right (TextWriter w, es) -> w writerOpts{
|
|
writerExtensions = es }
|
|
_ -> error $ "could not find writer for " ++
|
|
T.unpack toFormat
|
|
let result = case runPure $ reader (tabFilter 4 text) >>= writer of
|
|
Right s -> s
|
|
Left err -> error (show err)
|
|
let output = encode $ object [ T.pack "html" .= 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 (defaultMathJaxURL ++
|
|
"MathJax.js?config=TeX-AMS_CHTML-full"),
|
|
writerHighlightStyle = Just pygments }
|
|
|
|
readerOpts :: ReaderOptions
|
|
readerOpts = def
|