From 2bad9a9aa4eeb6cd63eef53422751ce5fd307c6b Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Tue, 27 Sep 2022 11:25:54 +0200 Subject: pandoc-cli: Avoid the CPP language extension Alternative behavior for the *server* flag is implemented by using separate modules. --- pandoc-cli/no-server/PandocCLI/Server.hs | 33 +++++++++++++++++ pandoc-cli/pandoc-cli.cabal | 6 +++- pandoc-cli/server/PandocCLI/Server.hs | 32 +++++++++++++++++ pandoc-cli/src/pandoc.hs | 62 +++++++++++--------------------- 4 files changed, 90 insertions(+), 43 deletions(-) create mode 100644 pandoc-cli/no-server/PandocCLI/Server.hs create mode 100644 pandoc-cli/server/PandocCLI/Server.hs diff --git a/pandoc-cli/no-server/PandocCLI/Server.hs b/pandoc-cli/no-server/PandocCLI/Server.hs new file mode 100644 index 000000000..1f29be9f0 --- /dev/null +++ b/pandoc-cli/no-server/PandocCLI/Server.hs @@ -0,0 +1,33 @@ +{- | + Module : PandocCLI.Server + Copyright : © 2006-2022 John MacFarlane + License : GPL-2.0-or-later + Maintainer : John MacFarlane + +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 diff --git a/pandoc-cli/pandoc-cli.cabal b/pandoc-cli/pandoc-cli.cabal index ddd2a9f52..a7734bd55 100644 --- a/pandoc-cli/pandoc-cli.cabal +++ b/pandoc-cli/pandoc-cli.cabal @@ -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 diff --git a/pandoc-cli/server/PandocCLI/Server.hs b/pandoc-cli/server/PandocCLI/Server.hs new file mode 100644 index 000000000..ce9b4e8d0 --- /dev/null +++ b/pandoc-cli/server/PandocCLI/Server.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} +{- | + Module : Main + Copyright : © 2006-2022 John MacFarlane + License : GPL-2.0-or-later + Maintainer : John MacFarlane + +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) diff --git a/pandoc-cli/src/pandoc.hs b/pandoc-cli/src/pandoc.hs index 9e9fd4b76..4564aa619 100644 --- a/pandoc-cli/src/pandoc.hs +++ b/pandoc-cli/src/pandoc.hs @@ -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 -- cgit v1.2.3