pandoc-cli: Avoid the CPP language extension

Alternative behavior for the *server* flag is implemented by using
separate modules.
This commit is contained in:
Albert Krewinkel
2022-09-27 08:42:27 -07:00
committed by John MacFarlane
parent 5e6b28cd0e
commit 2bad9a9aa4
4 changed files with 90 additions and 43 deletions
+33
View File
@@ -0,0 +1,33 @@
{- |
Module : PandocCLI.Server
Copyright : © 2006-2022 John MacFarlane
License : GPL-2.0-or-later
Maintainer : John MacFarlane <jgm@berkeley@edu>
Placeholder module to be used when pandoc is compiled without server
support.
-}
module PandocCLI.Server
( runCGI
, runServer
)
where
import System.IO (hPutStrLn, stderr)
import System.Exit (exitWith, ExitCode(ExitFailure))
-- | Placeholder function for the CGI server; prints an error message
-- and exists with error code.
runCGI :: IO ()
runCGI = serverUnsupported
-- | Placeholder function for the HTTP server; prints an error message
-- and exists with error code.
runServer :: IO ()
runServer = serverUnsupported
serverUnsupported :: IO ()
serverUnsupported = do
hPutStrLn stderr $ "Server mode unsupported.\n" <>
"Pandoc was not compiled with the 'server' flag."
exitWith $ ExitFailure 4
+5 -1
View File
@@ -27,6 +27,7 @@ flag server
common common-options
default-language: Haskell2010
other-extensions: OverloadedStrings
build-depends: base >= 4.12 && < 5
ghc-options: -Wall -fno-warn-unused-do-bind
-Wincomplete-record-updates
@@ -59,9 +60,12 @@ executable pandoc
buildable: True
build-depends: pandoc,
hslua-cli >= 1.1 && < 1.2
other-modules: PandocCLI.Server
if flag(server)
build-depends: pandoc-server >= 0.1 && < 0.2,
wai-extra >= 3.0.24,
warp,
safe
cpp-options: -D_SERVER
hs-source-dirs: server
else
hs-source-dirs: no-server
+32
View File
@@ -0,0 +1,32 @@
{-# LANGUAGE OverloadedStrings #-}
{- |
Module : Main
Copyright : © 2006-2022 John MacFarlane
License : GPL-2.0-or-later
Maintainer : John MacFarlane <jgm@berkeley@edu>
Functions for the pandoc server CLI.
-}
module PandocCLI.Server
( runCGI
, runServer
)
where
import qualified Network.Wai.Handler.CGI as CGI
import qualified Network.Wai.Handler.Warp as Warp
import Network.Wai.Middleware.Timeout (timeout)
import Safe (readDef)
import System.Environment (lookupEnv)
import Text.Pandoc.Server (ServerOpts(..), parseServerOpts, app)
-- | Runs the CGI server.
runCGI :: IO ()
runCGI = do
cgiTimeout <- maybe 2 (readDef 2) <$> lookupEnv "PANDOC_SERVER_TIMEOUT"
CGI.run (timeout cgiTimeout app)
-- | Runs the HTTP server.
runServer :: IO ()
runServer = do
sopts <- parseServerOpts
Warp.run (serverPort sopts) (timeout (serverTimeout sopts) app)
+20 -42
View File
@@ -1,5 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{- |
Module : Main
Copyright : Copyright (C) 2006-2022 John MacFarlane
@@ -16,54 +15,33 @@ module Main where
import Control.Monad ((<=<))
import qualified Control.Exception as E
import HsLua.CLI (Settings (..), runStandalone)
import Text.Pandoc.App (convertWithOpts, defaultOpts, options, parseOptions)
import System.Environment (getArgs, getProgName)
import Text.Pandoc.App ( convertWithOpts, defaultOpts, options
, parseOptionsFromArgs)
import Text.Pandoc.Class (runIOorExplode)
import Text.Pandoc.Error (handleError)
import Text.Pandoc.Lua (runLua)
import Text.Pandoc.Shared (pandocVersion)
import System.Environment (getProgName)
#ifdef _SERVER
import qualified Network.Wai.Handler.CGI as CGI
import qualified Network.Wai.Handler.Warp as Warp
import Network.Wai.Middleware.Timeout (timeout)
import Text.Pandoc.Server (ServerOpts(..), parseServerOpts, app)
import Safe (readDef)
import System.Environment (lookupEnv)
#else
import System.IO (hPutStrLn, stderr)
import System.Exit (exitWith, ExitCode(ExitFailure))
#endif
import qualified Text.Pandoc.UTF8 as UTF8
import PandocCLI.Server
main :: IO ()
main = E.handle (handleError . Left) $ do
prg <- getProgName
rawArgs <- map UTF8.decodeArg <$> getArgs
case prg of
"pandoc-server.cgi" -> do
#ifdef _SERVER
cgiTimeout <- maybe 2 (readDef 2) <$> lookupEnv "PANDOC_SERVER_TIMEOUT"
CGI.run (timeout cgiTimeout app)
#else
serverUnsupported
#endif
"pandoc-server" -> do
#ifdef _SERVER
sopts <- parseServerOpts
Warp.run (serverPort sopts) (timeout (serverTimeout sopts) app)
#else
serverUnsupported
#endif
"pandoc-lua" -> do
let settings = Settings
{ settingsVersionInfo = "\nEmbedded in pandoc " <> pandocVersion
, settingsRunner = handleError <=< runIOorExplode . runLua
}
runStandalone settings
_ -> parseOptions options defaultOpts >>= convertWithOpts
"pandoc-server.cgi" -> runCGI
"pandoc-server" -> runServer
"pandoc-lua" -> runLuaInterpreter prg rawArgs
_ -> parseOptionsFromArgs options defaultOpts prg rawArgs
>>= convertWithOpts
#ifndef _SERVER
serverUnsupported :: IO ()
serverUnsupported = do
hPutStrLn stderr $ "Server mode unsupported.\n" <>
"Pandoc was not compiled with the 'server' flag."
exitWith $ ExitFailure 4
#endif
-- | Runs pandoc as a Lua interpreter that is (mostly) compatible with
-- the default @lua@ program shipping with Lua.
runLuaInterpreter :: String -> [String] -> IO ()
runLuaInterpreter _progName _args = do
let settings = Settings
{ settingsVersionInfo = "\nEmbedded in pandoc " <> pandocVersion
, settingsRunner = handleError <=< runIOorExplode . runLua
}
runStandalone settings