PandocServer: return error in JSON object if response is JSON.

3 files changed, 70 insertions, 26 deletions

diff --git a/doc/pandoc-server.md b/doc/pandoc-server.md
index 32c247500..108e9c1f6 100644
--- a/doc/pandoc-server.md
+++ b/doc/pandoc-server.md
@@ -56,17 +56,44 @@ does, however, impose certain limitations:
 ## Root endpoint
 
 The root (`/`) endpoint accepts only POST requests.
+
+### Response
+
 It returns a converted document in one of the following
-formats, depending on Accept headers:
+formats (in order of preference), depending on the `Accept` header:
 
+- `application/octet-stream`
 - `text/plain`
 - `application/json`
-- `application/octet-stream`
 
 If the result is a binary format (e.g., `epub` or `docx`)
 and the content is returned as plain text or JSON, the
 binary will be base64 encoded.
 
+If a JSON response is given, it will have one of the
+following formats. If the conversion is not successful:
+
+```
+{ "error": string with the error message }
+```
+
+If the conversion is successful:
+
+```
+{ "output": string with textual or base64-encoded binary output,
+  "base64": boolean (true means the "output" is base64-encoded),
+  "messages": array of message objects (see below) }
+```
+
+Each element of the "messages" array will have the format
+
+```
+{ "message": string,
+  "verbosity": string (either "WARNING" or "INFO") }
+```
+
+### Request
+
 The body of the POST request should be a JSON object,
 with the following fields.  Only the `text` field is
 required; all of the others can be omitted for default
@@ -337,8 +364,7 @@ except for these two points:
 
 - It accepts a JSON array, each element of which is a JSON
   object like the one expected by the root endpoint.
-- It returns a JSON array of results.  (It will not return
-  plain text or octet-stream, like the root endpoint.)
+- It returns a JSON array of JSON results.
 
 This endpoint can be used to convert a sequence of small
 snippets in one request.
diff --git a/pandoc.cabal b/pandoc.cabal
index 96da70d99..dd0835d40 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -532,7 +532,7 @@ library
                  yaml                  >= 0.11     && < 0.12,
                  zip-archive           >= 0.2.3.4  && < 0.5,
                  zlib                  >= 0.5      && < 0.7,
-                 servant-server,
+                 servant-server        >= 0.19     && < 0.20,
                  wai                   >= 0.3
 
   if !os(windows)
diff --git a/src/Text/Pandoc/Server.hs b/src/Text/Pandoc/Server.hs
index 5b4cc7712..43e8c73c1 100644
--- a/src/Text/Pandoc/Server.hs
+++ b/src/Text/Pandoc/Server.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Text.Pandoc.Server
     ( app
+    , API
     , ServerOpts(..)
     , Params(..)
     , Blob(..)
@@ -12,6 +13,7 @@ module Text.Pandoc.Server
     ) where
 
 import Data.Aeson
+import qualified Data.Aeson.KeyMap as KeyMap
 import Network.Wai
 import Servant
 import Text.DocTemplates as DocTemplates
@@ -145,6 +147,16 @@ instance FromJSON Params where
      <*> o .:? "files"
      <*> o .:? "citeproc"
 
+instance ToJSON Params where
+ toJSON params =
+   case toJSON (options params) of
+     (Object o) -> Object $
+       KeyMap.insert "text" (toJSON $ text params)
+       . KeyMap.insert "files" (toJSON $ files params)
+       . KeyMap.insert "citeproc" (toJSON $ citeproc params)
+       $ o
+     x -> x
+
 data Message =
   Message
   { verbosity :: Verbosity
@@ -154,28 +166,32 @@ data Message =
 instance ToJSON Message where
  toEncoding = genericToEncoding defaultOptions
 
-data Output =
-  Output
-  { output    :: Text
-  , base64    :: Bool
-  , messages  :: [Message] }
+type Base64 = Bool
+
+data Output = Succeeded Text Base64 [Message]
+            | Failed Text
   deriving (Generic, Show)
 
 instance ToJSON Output where
- toEncoding = genericToEncoding defaultOptions
+  toEncoding (Succeeded o b m) = pairs
+    ( "output" .= o  <>
+      "base64" .= b  <>
+      "messages" .= m )
+  toEncoding (Failed errmsg) = pairs
+    ( "error" .= errmsg )
 
 -- This is the API.  The "/convert" endpoint takes a request body
 -- consisting of a JSON-encoded Params structure and responds to
 -- Get requests with either plain text or JSON, depending on the
 -- Accept header.
 type API =
-  ReqBody '[JSON] Params :> Post '[PlainText] Text
-  :<|>
   ReqBody '[JSON] Params :> Post '[OctetStream] BS.ByteString
   :<|>
+  ReqBody '[JSON] Params :> Post '[PlainText] Text
+  :<|>
   ReqBody '[JSON] Params :> Post '[JSON] Output
   :<|>
-  "batch" :> ReqBody '[JSON] [Params] :> Post '[JSON] [Text]
+  "batch" :> ReqBody '[JSON] [Params] :> Post '[JSON] [Output]
   :<|>
   "babelmark" :> QueryParam' '[Required] "text" Text :> QueryParam "from" Text :> QueryParam "to" Text :> QueryFlag "standalone" :> Get '[JSON] Value
   :<|>
@@ -188,15 +204,16 @@ api :: Proxy API
 api = Proxy
 
 server :: Server API
-server = convert
-    :<|> convertBytes
+server = convertBytes
+    :<|> convertText
     :<|> convertJSON
-    :<|> mapM convert
+    :<|> mapM convertJSON
     :<|> babelmark  -- for babelmark which expects {"html": "", "version": ""}
     :<|> pure pandocVersion
  where
   babelmark text' from' to' standalone' = do
-    res <- convert def{ text = text',
+    res <- convertText def{
+                        text = text',
                         options = defaultOpts{
                           optFrom = from',
                           optTo = to',
@@ -210,25 +227,22 @@ server = convert
   -- Changing this to
   --    handleErr =<< liftIO (runIO (convert' params))
   -- will allow the IO operations.
-  convert params = handleErr $
+  convertText params = handleErr $
     runPure (convert' return (return . encodeBase64 . BL.toStrict) params)
 
   convertBytes params = handleErr $
     runPure (convert' (return . UTF8.fromText) (return . BL.toStrict) params)
 
-  convertJSON params = handleErr $
+  convertJSON params = handleErrJSON $
     runPure
       (convert'
         (\t -> do
             msgs <- getLog
-            return Output{ output = t
-                         , base64 = False
-                         , messages = map toMessage msgs })
+            return $ Succeeded t False (map toMessage msgs))
         (\bs -> do
             msgs <- getLog
-            return Output{ output = encodeBase64 (BL.toStrict bs)
-                         , base64 = True
-                         , messages = map toMessage msgs })
+            return $ Succeeded (encodeBase64 (BL.toStrict bs)) True
+                               (map toMessage msgs))
         params)
 
   toMessage m = Message { verbosity = messageVerbosity m
@@ -402,6 +416,10 @@ server = convert
   handleErr (Left err) = throwError $
     err500 { errBody = TLE.encodeUtf8 $ TL.fromStrict $ renderError err }
 
+  handleErrJSON (Right o) = return o
+  handleErrJSON (Left err) =
+    return $ Failed (renderError err)
+
   compileCustomTemplate toformat t = do
     res <- runWithPartials $ compileTemplate ("custom." <> T.unpack toformat)
                (T.pack t)