"Fossies" - the Fresh Open Source Software Archive

Member "pandoc-2.18/trypandoc/trypandoc.hs" (4 Apr 2022, 3062 Bytes) of package /linux/www/pandoc-2.18.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Haskell source code syntax highlighting (style: standard) with prefixed line numbers. Alternatively you can here view or download the uninterpreted source code file. See also the last Fossies "Diffs" side-by-side code changes report for "trypandoc.hs": 2.16.2_vs_2.17.

    1 {-# LANGUAGE OverloadedStrings #-}
    2 {- |
    3    Module      : Main
    4    Copyright   : © 2014-2022 John MacFarlane <jgm@berkeley.edu>
    5    License     : GNU GPL, version 2 or above
    6 
    7    Maintainer  : John MacFarlane <jgm@berkeley.edu>
    8    Stability   : alpha
    9    Portability : portable
   10 
   11 Provides a webservice which allows to try pandoc in the browser.
   12 -}
   13 module Main where
   14 import Network.Wai.Handler.CGI
   15 import Network.Wai.Middleware.Timeout (timeout)
   16 import Network.Wai
   17 import Data.Maybe (fromMaybe)
   18 import Network.HTTP.Types.Status (status200)
   19 import Network.HTTP.Types.Header (hContentType)
   20 import Network.HTTP.Types.URI (queryToQueryText)
   21 import Text.Pandoc
   22 import Text.Pandoc.Highlighting (pygments)
   23 import Text.Pandoc.Shared (tabFilter)
   24 import Data.Aeson
   25 import qualified Data.Text as T
   26 import Data.Text (Text)
   27 
   28 main :: IO ()
   29 main = run $ timeout 2 app
   30 
   31 app :: Application
   32 app 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 [ "html" .= result
   56                                , "name" .=
   57                                   if fromFormat == "markdown_strict"
   58                                      then T.pack "pandoc (strict)"
   59                                      else T.pack "pandoc"
   60                                , "version" .= pandocVersion]
   61   respond $ responseLBS status200 [(hContentType,"text/json; charset=UTF-8")] output
   62 
   63 checkLength :: Text -> IO Text
   64 checkLength t =
   65   if T.length t > 10000
   66      then error "exceeds length limit of 10,000 characters"
   67      else return t
   68 
   69 writerOpts :: WriterOptions
   70 writerOpts = def { writerReferenceLinks = True,
   71                    writerEmailObfuscation = NoObfuscation,
   72                    writerHTMLMathMethod = MathJax defaultMathJaxURL,
   73                    writerHighlightStyle = Just pygments }
   74 
   75 readerOpts :: ReaderOptions
   76 readerOpts = def