pandoc-server: allow binary writers/readers.

The expectation (which needs to be documented, along
with everything else about this server) is that the binary
content be base 64 encoded.
This commit is contained in:
John MacFarlane 2022-08-08 09:53:19 -07:00
parent 297e48661d
commit 5335410ace
2 changed files with 23 additions and 17 deletions

View file

@ -799,6 +799,8 @@ executable pandoc-server
pandoc, pandoc,
aeson, aeson,
text, text,
bytestring,
base64 >= 0.4,
servant-server, servant-server,
wai >= 0.3, wai >= 0.3,
wai-extra >= 3.0.24, wai-extra >= 3.0.24,

View file

@ -13,18 +13,21 @@ import Data.Aeson.TH
import Network.Wai import Network.Wai
import Servant import Servant
import Text.Pandoc import Text.Pandoc
import qualified Text.Pandoc.UTF8 as UTF8
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TLE import qualified Data.Text.Lazy.Encoding as TLE
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Char (isAlphaNum) import Data.Char (isAlphaNum)
import Data.ByteString.Lazy (fromStrict, toStrict)
import Data.ByteString.Base64
-- This is the data to be supplied by the JSON payload -- This is the data to be supplied by the JSON payload
-- of requests. Maybe values may be omitted and will be -- of requests. Maybe values may be omitted and will be
-- given default values. -- given default values.
data Params = Params data Params = Params
{ text :: Text { input :: Text
, from :: Maybe Text , from :: Maybe Text
, to :: Maybe Text , to :: Maybe Text
, wrapText :: Maybe WrapOption , wrapText :: Maybe WrapOption
@ -88,22 +91,23 @@ server = convert
Just t -> Just <$> Just t -> Just <$>
compileCustomTemplate toformat t compileCustomTemplate toformat t
else return Nothing else return Nothing
-- We don't yet handle binary formats: let readeropts = def{ readerExtensions = readerExts
reader <- case readerSpec of
TextReader r -> return r
_ -> throwError $ PandocAppError $
readerFormat <> " is not a text reader"
writer <- case writerSpec of
TextWriter w -> return w
_ -> throwError $ PandocAppError $
readerFormat <> " is not a text reader"
reader def{ readerExtensions = readerExts
, readerStandalone = isStandalone } , readerStandalone = isStandalone }
(text params) >>= let writeropts = def{ writerExtensions = writerExts
writer def{ writerExtensions = writerExts
, writerWrapText = fromMaybe WrapAuto (wrapText params) , writerWrapText = fromMaybe WrapAuto (wrapText params)
, writerColumns = fromMaybe 72 (columns params) , writerColumns = fromMaybe 72 (columns params)
, writerTemplate = mbTemplate } , writerTemplate = mbTemplate }
let reader = case readerSpec of
TextReader r -> r readeropts
ByteStringReader r -> \t -> do
let eitherbs = decodeBase64 $ UTF8.fromText t
case eitherbs of
Left errt -> throwError $ PandocSomeError errt
Right bs -> r readeropts $ fromStrict bs
let writer = case writerSpec of
TextWriter w -> w writeropts
ByteStringWriter w -> fmap (encodeBase64 . toStrict) . w writeropts
reader (input params) >>= writer
handleErr (Right t) = return t handleErr (Right t) = return t
handleErr (Left err) = throwError $ handleErr (Left err) = throwError $