    {-# LANGUAGE DataKinds       #-}
    {-# LANGUAGE DeriveGeneric   #-}
    {-# LANGUAGE TypeOperators   #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE OverloadedStrings #-}
    module Text.Pandoc.Server
        ( app
        , API
        , ServerOpts(..)
        , Params(..)
        , Blob(..)
        , parseServerOptsFromArgs
        ) where

    import Data.Aeson
    import qualified Data.Aeson.KeyMap as KeyMap
    import Network.Wai
    import Servant
    import Text.DocTemplates as DocTemplates
    import Text.Pandoc
    import Text.Pandoc.Writers.Shared (lookupMetaString)
    import Text.Pandoc.Citeproc (processCitations)
    import Text.Pandoc.Highlighting (lookupHighlightingStyle)
    import Text.Pandoc.Chunks (PathTemplate(..))
    import qualified Text.Pandoc.UTF8 as UTF8
    import Data.Text (Text)
    import qualified Data.Text as T
    import qualified Data.Text.Lazy as TL
    import qualified Data.Text.Lazy.Encoding as TLE
    import Data.Maybe (fromMaybe)
    import qualified Data.ByteString as BS
    import qualified Data.ByteString.Lazy as BL
    import qualified Data.ByteString.Base64 as Base64 (decodeLenient, encode)
    import Data.Default
    import Control.Monad (when, unless, foldM)
    import qualified Data.Set as Set
    import Skylighting (defaultSyntaxMap)
    import qualified Data.Map as M
    import Text.Collate.Lang (Lang (..), parseLang)
    import System.Console.GetOpt
    import System.Environment (getProgName)
    import qualified Control.Exception as E
    import Text.Pandoc.Shared (safeStrRead)
    import Text.Pandoc.App ( IpynbOutput (..), Opt(..), defaultOpts )
    import Text.Pandoc.Builder (setMeta)
    import Text.Pandoc.Format (parseFlavoredFormat, formatName)
    import Text.Pandoc.SelfContained (makeSelfContained)
    import Text.Pandoc.Transforms (headerShift, filterIpynbOutput,
                                   eastAsianLineBreakFilter)
    import System.Exit
    import GHC.Generics (Generic)
    import Network.Wai.Middleware.Cors ( cors,
               simpleCorsResourcePolicy, CorsResourcePolicy(corsRequestHeaders) )

    data ServerOpts =
      ServerOpts
        { ServerOpts -> Int
    serverPort    :: Int
        , ServerOpts -> Int
    serverTimeout :: Int }
      deriving (Int -> ServerOpts -> ShowS
    [ServerOpts] -> ShowS
    ServerOpts -> String
    (Int -> ServerOpts -> ShowS)
    -> (ServerOpts -> String)
    -> ([ServerOpts] -> ShowS)
    -> Show ServerOpts
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ServerOpts -> ShowS
    showsPrec :: Int -> ServerOpts -> ShowS
    $cshow :: ServerOpts -> String
    show :: ServerOpts -> String
    $cshowList :: [ServerOpts] -> ShowS
    showList :: [ServerOpts] -> ShowS
    Show)

    defaultServerOpts :: ServerOpts
    defaultServerOpts :: ServerOpts
    defaultServerOpts = ServerOpts { serverPort :: Int
    serverPort = Int
    3030, serverTimeout :: Int
    serverTimeout = Int
    2 }

    cliOptions :: [OptDescr (ServerOpts -> IO ServerOpts)]
    cliOptions :: [OptDescr (ServerOpts -> IO ServerOpts)]
    cliOptions =
      [ String
    -> [String]
    -> ArgDescr (ServerOpts -> IO ServerOpts)
    -> String
    -> OptDescr (ServerOpts -> IO ServerOpts)
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option [Char
    'p'] [String
    "port"]
          ((String -> ServerOpts -> IO ServerOpts)
    -> String -> ArgDescr (ServerOpts -> IO ServerOpts)
    forall a. (String -> a) -> String -> ArgDescr a
    ReqArg (\String
    s ServerOpts
    opts -> case String -> Maybe Int
    forall (m :: * -> *) a. (MonadPlus m, Read a) => String -> m a
    safeStrRead String
    s of
                                Just Int
    i -> ServerOpts -> IO ServerOpts
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ServerOpts
    opts{ serverPort = i }
                                Maybe Int
    Nothing ->
                                  PandocError -> IO ServerOpts
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO (PandocError -> IO ServerOpts) -> PandocError -> IO ServerOpts
    forall a b. (a -> b) -> a -> b
    $ Text -> PandocError
    PandocOptionError (Text -> PandocError) -> Text -> PandocError
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack
                                    String
    s Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " is not a number") String
    "NUMBER")
          String
    "port number"
      , String
    -> [String]
    -> ArgDescr (ServerOpts -> IO ServerOpts)
    -> String
    -> OptDescr (ServerOpts -> IO ServerOpts)
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option [Char
    't'] [String
    "timeout"]
          ((String -> ServerOpts -> IO ServerOpts)
    -> String -> ArgDescr (ServerOpts -> IO ServerOpts)
    forall a. (String -> a) -> String -> ArgDescr a
    ReqArg (\String
    s ServerOpts
    opts -> case String -> Maybe Int
    forall (m :: * -> *) a. (MonadPlus m, Read a) => String -> m a
    safeStrRead String
    s of
                                Just Int
    i -> ServerOpts -> IO ServerOpts
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ServerOpts
    opts{ serverTimeout = i }
                                Maybe Int
    Nothing ->
                                  PandocError -> IO ServerOpts
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO (PandocError -> IO ServerOpts) -> PandocError -> IO ServerOpts
    forall a b. (a -> b) -> a -> b
    $ Text -> PandocError
    PandocOptionError (Text -> PandocError) -> Text -> PandocError
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack
                                    String
    s Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    " is not a number") String
    "NUMBER")
          String
    "timeout (seconds)"

      , String
    -> [String]
    -> ArgDescr (ServerOpts -> IO ServerOpts)
    -> String
    -> OptDescr (ServerOpts -> IO ServerOpts)
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option [Char
    'h'] [String
    "help"]
          ((ServerOpts -> IO ServerOpts)
    -> ArgDescr (ServerOpts -> IO ServerOpts)
    forall a. a -> ArgDescr a
    NoArg (\ServerOpts
    _ -> do
            prg <- IO String
    getProgName
            let header = String
    "Usage: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    prg String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    " [OPTION...]"
            putStrLn $ usageInfo header cliOptions
            exitSuccess))
          String
    "help message"

      , String
    -> [String]
    -> ArgDescr (ServerOpts -> IO ServerOpts)
    -> String
    -> OptDescr (ServerOpts -> IO ServerOpts)
    forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
    Option [Char
    'v'] [String
    "version"]
          ((ServerOpts -> IO ServerOpts)
    -> ArgDescr (ServerOpts -> IO ServerOpts)
    forall a. a -> ArgDescr a
    NoArg (\ServerOpts
    _ -> do
            prg <- IO String
    getProgName
            putStrLn $ prg <> " " <> T.unpack pandocVersionText
            exitSuccess))
          String
    "version info"

      ]

    parseServerOptsFromArgs :: [String] -> IO ServerOpts
    parseServerOptsFromArgs :: [String] -> IO ServerOpts
    parseServerOptsFromArgs [String]
    args = do
      let handleUnknownOpt :: a -> a
    handleUnknownOpt a
    x = a
    "Unknown option: " a -> a -> a
    forall a. Semigroup a => a -> a -> a
    <> a
    x
      case ArgOrder (ServerOpts -> IO ServerOpts)
    -> [OptDescr (ServerOpts -> IO ServerOpts)]
    -> [String]
    -> ([ServerOpts -> IO ServerOpts], [String], [String], [String])
    forall a.
    ArgOrder a
    -> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
    getOpt' ArgOrder (ServerOpts -> IO ServerOpts)
    forall a. ArgOrder a
    Permute [OptDescr (ServerOpts -> IO ServerOpts)]
    cliOptions [String]
    args of
        ([ServerOpts -> IO ServerOpts]
    os, [String]
    ns, [String]
    unrecognizedOpts, [String]
    es) -> do
          Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not ([String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    es) Bool -> Bool -> Bool
    || Bool -> Bool
    not ([String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    unrecognizedOpts)) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            PandocError -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO (PandocError -> IO ()) -> PandocError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Text -> PandocError
    PandocOptionError (Text -> PandocError) -> Text -> PandocError
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $
              [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [String]
    es String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    unlines (ShowS -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ShowS
    forall {a}. (Semigroup a, IsString a) => a -> a
    handleUnknownOpt [String]
    unrecognizedOpts) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
              (String
    "Try --help for more information.")
          Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    ns) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            PandocError -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO (PandocError -> IO ()) -> PandocError -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Text -> PandocError
    PandocOptionError (Text -> PandocError) -> Text -> PandocError
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $
                         String
    "Unknown arguments: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> [String] -> String
    unwords [String]
    ns
          (ServerOpts -> (ServerOpts -> IO ServerOpts) -> IO ServerOpts)
    -> ServerOpts -> [ServerOpts -> IO ServerOpts] -> IO ServerOpts
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM (((ServerOpts -> IO ServerOpts) -> ServerOpts -> IO ServerOpts)
    -> ServerOpts -> (ServerOpts -> IO ServerOpts) -> IO ServerOpts
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (ServerOpts -> IO ServerOpts) -> ServerOpts -> IO ServerOpts
    forall a b. (a -> b) -> a -> b
    ($)) ServerOpts
    defaultServerOpts [ServerOpts -> IO ServerOpts]
    os

    newtype Blob = Blob BL.ByteString
      deriving (Int -> Blob -> ShowS
    [Blob] -> ShowS
    Blob -> String
    (Int -> Blob -> ShowS)
    -> (Blob -> String) -> ([Blob] -> ShowS) -> Show Blob
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Blob -> ShowS
    showsPrec :: Int -> Blob -> ShowS
    $cshow :: Blob -> String
    show :: Blob -> String
    $cshowList :: [Blob] -> ShowS
    showList :: [Blob] -> ShowS
    Show, Blob -> Blob -> Bool
    (Blob -> Blob -> Bool) -> (Blob -> Blob -> Bool) -> Eq Blob
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Blob -> Blob -> Bool
    == :: Blob -> Blob -> Bool
    $c/= :: Blob -> Blob -> Bool
    /= :: Blob -> Blob -> Bool
    Eq)

    instance ToJSON Blob where
      toJSON :: Blob -> Value
    toJSON (Blob ByteString
    bs) = Text -> Value
    forall a. ToJSON a => a -> Value
    toJSON (ByteString -> Text
    UTF8.toText (ByteString -> Text)
    -> (ByteString -> ByteString) -> ByteString -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    Base64.encode (ByteString -> Text) -> ByteString -> Text
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    BL.toStrict ByteString
    bs)

    instance FromJSON Blob where
     parseJSON :: Value -> Parser Blob
    parseJSON = String -> (Text -> Parser Blob) -> Value -> Parser Blob
    forall a. String -> (Text -> Parser a) -> Value -> Parser a
    withText String
    "Blob" ((Text -> Parser Blob) -> Value -> Parser Blob)
    -> (Text -> Parser Blob) -> Value -> Parser Blob
    forall a b. (a -> b) -> a -> b
    $
       Blob -> Parser Blob
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Blob -> Parser Blob) -> (Text -> Blob) -> Text -> Parser Blob
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Blob
    Blob (ByteString -> Blob) -> (Text -> ByteString) -> Text -> Blob
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    BL.fromStrict (ByteString -> ByteString)
    -> (Text -> ByteString) -> Text -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    Base64.decodeLenient (ByteString -> ByteString)
    -> (Text -> ByteString) -> Text -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> ByteString
    UTF8.fromText

    -- This is the data to be supplied by the JSON payload
    -- of requests.  Maybe values may be omitted and will be
    -- given default values.
    data Params = Params
      { Params -> Opt
    options               :: Opt
      , Params -> Text
    text                  :: Text
      , Params -> Maybe (Map String Blob)
    files                 :: Maybe (M.Map FilePath Blob)
      , Params -> Maybe Bool
    citeproc              :: Maybe Bool
      } deriving (Int -> Params -> ShowS
    [Params] -> ShowS
    Params -> String
    (Int -> Params -> ShowS)
    -> (Params -> String) -> ([Params] -> ShowS) -> Show Params
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Params -> ShowS
    showsPrec :: Int -> Params -> ShowS
    $cshow :: Params -> String
    show :: Params -> String
    $cshowList :: [Params] -> ShowS
    showList :: [Params] -> ShowS
    Show)

    instance Default Params where
      def :: Params
    def = Params
        { options :: Opt
    options = Opt
    defaultOpts
        , text :: Text
    text = Text
    forall a. Monoid a => a
    mempty
        , files :: Maybe (Map String Blob)
    files = Maybe (Map String Blob)
    forall a. Maybe a
    Nothing
        , citeproc :: Maybe Bool
    citeproc = Maybe Bool
    forall a. Maybe a
    Nothing
        }

    -- Automatically derive code to convert to/from JSON.
    instance FromJSON Params where
     parseJSON :: Value -> Parser Params
    parseJSON = String -> (Object -> Parser Params) -> Value -> Parser Params
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
    withObject String
    "Params" ((Object -> Parser Params) -> Value -> Parser Params)
    -> (Object -> Parser Params) -> Value -> Parser Params
    forall a b. (a -> b) -> a -> b
    $ \Object
    o ->
       Opt -> Text -> Maybe (Map String Blob) -> Maybe Bool -> Params
    Params
         (Opt -> Text -> Maybe (Map String Blob) -> Maybe Bool -> Params)
    -> Parser Opt
    -> Parser (Text -> Maybe (Map String Blob) -> Maybe Bool -> Params)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Value -> Parser Opt
    forall a. FromJSON a => Value -> Parser a
    parseJSON (Object -> Value
    Object Object
    o)
         Parser (Text -> Maybe (Map String Blob) -> Maybe Bool -> Params)
    -> Parser Text
    -> Parser (Maybe (Map String Blob) -> Maybe Bool -> Params)
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Object
    o Object -> Key -> Parser Text
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "text"
         Parser (Maybe (Map String Blob) -> Maybe Bool -> Params)
    -> Parser (Maybe (Map String Blob))
    -> Parser (Maybe Bool -> Params)
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Object
    o Object -> Key -> Parser (Maybe (Map String Blob))
    forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
    .:? Key
    "files"
         Parser (Maybe Bool -> Params)
    -> Parser (Maybe Bool) -> Parser Params
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Object
    o Object -> Key -> Parser (Maybe Bool)
    forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
    .:? Key
    "citeproc"

    instance ToJSON Params where
     toJSON :: Params -> Value
    toJSON Params
    params =
       case Opt -> Value
    forall a. ToJSON a => a -> Value
    toJSON (Params -> Opt
    options Params
    params) of
         (Object Object
    o) -> Object -> Value
    Object (Object -> Value) -> Object -> Value
    forall a b. (a -> b) -> a -> b
    $
           Key -> Value -> Object -> Object
    forall v. Key -> v -> KeyMap v -> KeyMap v
    KeyMap.insert Key
    "text" (Text -> Value
    forall a. ToJSON a => a -> Value
    toJSON (Text -> Value) -> Text -> Value
    forall a b. (a -> b) -> a -> b
    $ Params -> Text
    text Params
    params)
           (Object -> Object) -> (Object -> Object) -> Object -> Object
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Key -> Value -> Object -> Object
    forall v. Key -> v -> KeyMap v -> KeyMap v
    KeyMap.insert Key
    "files" (Maybe (Map String Blob) -> Value
    forall a. ToJSON a => a -> Value
    toJSON (Maybe (Map String Blob) -> Value)
    -> Maybe (Map String Blob) -> Value
    forall a b. (a -> b) -> a -> b
    $ Params -> Maybe (Map String Blob)
    files Params
    params)
           (Object -> Object) -> (Object -> Object) -> Object -> Object
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Key -> Value -> Object -> Object
    forall v. Key -> v -> KeyMap v -> KeyMap v
    KeyMap.insert Key
    "citeproc" (Maybe Bool -> Value
    forall a. ToJSON a => a -> Value
    toJSON (Maybe Bool -> Value) -> Maybe Bool -> Value
    forall a b. (a -> b) -> a -> b
    $ Params -> Maybe Bool
    citeproc Params
    params)
           (Object -> Object) -> Object -> Object
    forall a b. (a -> b) -> a -> b
    $ Object
    o
         Value
    x -> Value
    x

    data Message =
      Message
      { Message -> Verbosity
    verbosity :: Verbosity
      , Message -> Text
    message   :: Text }
      deriving ((forall x. Message -> Rep Message x)
    -> (forall x. Rep Message x -> Message) -> Generic Message
    forall x. Rep Message x -> Message
    forall x. Message -> Rep Message x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. Message -> Rep Message x
    from :: forall x. Message -> Rep Message x
    $cto :: forall x. Rep Message x -> Message
    to :: forall x. Rep Message x -> Message
    Generic, Int -> Message -> ShowS
    [Message] -> ShowS
    Message -> String
    (Int -> Message -> ShowS)
    -> (Message -> String) -> ([Message] -> ShowS) -> Show Message
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Message -> ShowS
    showsPrec :: Int -> Message -> ShowS
    $cshow :: Message -> String
    show :: Message -> String
    $cshowList :: [Message] -> ShowS
    showList :: [Message] -> ShowS
    Show)

    instance ToJSON Message where
     toEncoding :: Message -> Encoding
    toEncoding = Options -> Message -> Encoding
    forall a.
    (Generic a, GToJSON' Encoding Zero (Rep a)) =>
    Options -> a -> Encoding
    genericToEncoding Options
    defaultOptions

    type Base64 = Bool

    data Output = Succeeded Text Base64 [Message]
                | Failed Text
      deriving ((forall x. Output -> Rep Output x)
    -> (forall x. Rep Output x -> Output) -> Generic Output
    forall x. Rep Output x -> Output
    forall x. Output -> Rep Output x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. Output -> Rep Output x
    from :: forall x. Output -> Rep Output x
    $cto :: forall x. Rep Output x -> Output
    to :: forall x. Rep Output x -> Output
    Generic, Int -> Output -> ShowS
    [Output] -> ShowS
    Output -> String
    (Int -> Output -> ShowS)
    -> (Output -> String) -> ([Output] -> ShowS) -> Show Output
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Output -> ShowS
    showsPrec :: Int -> Output -> ShowS
    $cshow :: Output -> String
    show :: Output -> String
    $cshowList :: [Output] -> ShowS
    showList :: [Output] -> ShowS
    Show)

    instance ToJSON Output where
      toEncoding :: Output -> Encoding
    toEncoding (Succeeded Text
    o Bool
    b [Message]
    m) = Series -> Encoding
    pairs
        ( Key
    "output" Key -> Text -> Series
    forall v. ToJSON v => Key -> v -> Series
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= Text
    o  Series -> Series -> Series
    forall a. Semigroup a => a -> a -> a
    <>
          Key
    "base64" Key -> Bool -> Series
    forall v. ToJSON v => Key -> v -> Series
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= Bool
    b  Series -> Series -> Series
    forall a. Semigroup a => a -> a -> a
    <>
          Key
    "messages" Key -> [Message] -> Series
    forall v. ToJSON v => Key -> v -> Series
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= [Message]
    m )
      toEncoding (Failed Text
    errmsg) = Series -> Encoding
    pairs
        ( Key
    "error" Key -> Text -> Series
    forall v. ToJSON v => Key -> v -> Series
    forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
    .= Text
    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 '[OctetStream] BS.ByteString
      :<|>
      ReqBody '[JSON] Params :> Post '[PlainText] Text
      :<|>
      ReqBody '[JSON] Params :> Post '[JSON] Output
      :<|>
      "batch" :> ReqBody '[JSON] [Params] :> Post '[JSON] [Output]
      :<|>
      "babelmark" :> QueryParam' '[Required] "text" Text :> QueryParam "from" Text :> QueryParam "to" Text :> QueryFlag "standalone" :> Get '[JSON] Value
      :<|>
      "version" :> Get '[PlainText, JSON] Text

    app :: Application
    app :: Application
    app = Middleware
    corsWithContentType Middleware -> Middleware
    forall a b. (a -> b) -> a -> b
    $ Proxy API -> Server API -> Application
    forall {k} (api :: k).
    HasServer api '[] =>
    Proxy api -> Server api -> Application
    serve Proxy API
    api Server API
    server

    -- | Allow Content-Type header with values other then allowed by simpleCors.
    corsWithContentType :: Middleware
    corsWithContentType :: Middleware
    corsWithContentType = (Request -> Maybe CorsResourcePolicy) -> Middleware
    cors (Maybe CorsResourcePolicy -> Request -> Maybe CorsResourcePolicy
    forall a b. a -> b -> a
    const (Maybe CorsResourcePolicy -> Request -> Maybe CorsResourcePolicy)
    -> Maybe CorsResourcePolicy -> Request -> Maybe CorsResourcePolicy
    forall a b. (a -> b) -> a -> b
    $ CorsResourcePolicy -> Maybe CorsResourcePolicy
    forall a. a -> Maybe a
    Just CorsResourcePolicy
    policy)
        where
          policy :: CorsResourcePolicy
    policy = CorsResourcePolicy
    simpleCorsResourcePolicy
            { corsRequestHeaders = ["Content-Type"] }

    api :: Proxy API
    api :: Proxy API
    api = Proxy API
    forall {k} (t :: k). Proxy t
    Proxy

    server :: Server API
    server :: Server API
    server = Params -> Handler ByteString
    forall {m :: * -> *}.
    MonadError ServerError m =>
    Params -> m ByteString
    convertBytes
        (Params -> Handler ByteString)
    -> ((Params -> Handler Text)
        :<|> ((Params -> Handler Output)
              :<|> (([Params] -> Handler [Output])
                    :<|> ((Text -> Maybe Text -> Maybe Text -> Bool -> Handler Value)
                          :<|> Handler Text))))
    -> (Params -> Handler ByteString)
       :<|> ((Params -> Handler Text)
             :<|> ((Params -> Handler Output)
                   :<|> (([Params] -> Handler [Output])
                         :<|> ((Text -> Maybe Text -> Maybe Text -> Bool -> Handler Value)
                               :<|> Handler Text))))
    forall a b. a -> b -> a :<|> b
    :<|> Params -> Handler Text
    forall {m :: * -> *}. MonadError ServerError m => Params -> m Text
    convertText
        (Params -> Handler Text)
    -> ((Params -> Handler Output)
        :<|> (([Params] -> Handler [Output])
              :<|> ((Text -> Maybe Text -> Maybe Text -> Bool -> Handler Value)
                    :<|> Handler Text)))
    -> (Params -> Handler Text)
       :<|> ((Params -> Handler Output)
             :<|> (([Params] -> Handler [Output])
                   :<|> ((Text -> Maybe Text -> Maybe Text -> Bool -> Handler Value)
                         :<|> Handler Text)))
    forall a b. a -> b -> a :<|> b
    :<|> Params -> Handler Output
    forall {m :: * -> *}. Monad m => Params -> m Output
    convertJSON
        (Params -> Handler Output)
    -> (([Params] -> Handler [Output])
        :<|> ((Text -> Maybe Text -> Maybe Text -> Bool -> Handler Value)
              :<|> Handler Text))
    -> (Params -> Handler Output)
       :<|> (([Params] -> Handler [Output])
             :<|> ((Text -> Maybe Text -> Maybe Text -> Bool -> Handler Value)
                   :<|> Handler Text))
    forall a b. a -> b -> a :<|> b
    :<|> (Params -> Handler Output) -> [Params] -> Handler [Output]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Params -> Handler Output
    forall {m :: * -> *}. Monad m => Params -> m Output
    convertJSON
        ([Params] -> Handler [Output])
    -> ((Text -> Maybe Text -> Maybe Text -> Bool -> Handler Value)
        :<|> Handler Text)
    -> ([Params] -> Handler [Output])
       :<|> ((Text -> Maybe Text -> Maybe Text -> Bool -> Handler Value)
             :<|> Handler Text)
    forall a b. a -> b -> a :<|> b
    :<|> Text -> Maybe Text -> Maybe Text -> Bool -> Handler Value
    forall {m :: * -> *}.
    MonadError ServerError m =>
    Text -> Maybe Text -> Maybe Text -> Bool -> m Value
    babelmark  -- for babelmark which expects {"html": "", "version": ""}
        (Text -> Maybe Text -> Maybe Text -> Bool -> Handler Value)
    -> Handler Text
    -> (Text -> Maybe Text -> Maybe Text -> Bool -> Handler Value)
       :<|> Handler Text
    forall a b. a -> b -> a :<|> b
    :<|> Text -> Handler Text
    forall a. a -> Handler a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Text
    pandocVersionText
     where
      babelmark :: Text -> Maybe Text -> Maybe Text -> Bool -> m Value
    babelmark Text
    text' Maybe Text
    from' Maybe Text
    to' Bool
    standalone' = do
        res <- Params -> m Text
    forall {m :: * -> *}. MonadError ServerError m => Params -> m Text
    convertText Params
    forall a. Default a => a
    def{
                            text = text',
                            options = defaultOpts{
                              optFrom = from',
                              optTo = to',
                              optStandalone = standalone' }
                          }
        return $ toJSON $ object [ "html" .= res, "version" .= pandocVersion ]

      -- We use runPure for the pandoc conversions, which ensures that
      -- they will do no IO.  This makes the server safe to use.  However,
      -- it will mean that features requiring IO, like RST includes, will not work.
      -- Changing this to
      --    handleErr =<< liftIO (runIO (convert' params))
      -- will allow the IO operations.
      convertText :: Params -> m Text
    convertText Params
    params = Either PandocError Text -> m Text
    forall {m :: * -> *} {a}.
    MonadError ServerError m =>
    Either PandocError a -> m a
    handleErr (Either PandocError Text -> m Text)
    -> Either PandocError Text -> m Text
    forall a b. (a -> b) -> a -> b
    $
        PandocPure Text -> Either PandocError Text
    forall a. PandocPure a -> Either PandocError a
    runPure ((Text -> PandocPure Text)
    -> (ByteString -> PandocPure Text) -> Params -> PandocPure Text
    forall a.
    (Text -> PandocPure a)
    -> (ByteString -> PandocPure a) -> Params -> PandocPure a
    convert' Text -> PandocPure Text
    forall a. a -> PandocPure a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> PandocPure Text
    forall a. a -> PandocPure a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> PandocPure Text)
    -> (ByteString -> Text) -> ByteString -> PandocPure Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Text
    UTF8.toText (ByteString -> Text)
    -> (ByteString -> ByteString) -> ByteString -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                   ByteString -> ByteString
    Base64.encode (ByteString -> ByteString)
    -> (ByteString -> ByteString) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    BL.toStrict) Params
    params)

      convertBytes :: Params -> m ByteString
    convertBytes Params
    params = Either PandocError ByteString -> m ByteString
    forall {m :: * -> *} {a}.
    MonadError ServerError m =>
    Either PandocError a -> m a
    handleErr (Either PandocError ByteString -> m ByteString)
    -> Either PandocError ByteString -> m ByteString
    forall a b. (a -> b) -> a -> b
    $
        PandocPure ByteString -> Either PandocError ByteString
    forall a. PandocPure a -> Either PandocError a
    runPure ((Text -> PandocPure ByteString)
    -> (ByteString -> PandocPure ByteString)
    -> Params
    -> PandocPure ByteString
    forall a.
    (Text -> PandocPure a)
    -> (ByteString -> PandocPure a) -> Params -> PandocPure a
    convert' (ByteString -> PandocPure ByteString
    forall a. a -> PandocPure a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> PandocPure ByteString)
    -> (Text -> ByteString) -> Text -> PandocPure ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> ByteString
    UTF8.fromText) (ByteString -> PandocPure ByteString
    forall a. a -> PandocPure a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString -> PandocPure ByteString)
    -> (ByteString -> ByteString)
    -> ByteString
    -> PandocPure ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    BL.toStrict) Params
    params)

      convertJSON :: Params -> m Output
    convertJSON Params
    params = Either PandocError Output -> m Output
    forall {m :: * -> *}.
    Monad m =>
    Either PandocError Output -> m Output
    handleErrJSON (Either PandocError Output -> m Output)
    -> Either PandocError Output -> m Output
    forall a b. (a -> b) -> a -> b
    $
        PandocPure Output -> Either PandocError Output
    forall a. PandocPure a -> Either PandocError a
    runPure
          ((Text -> PandocPure Output)
    -> (ByteString -> PandocPure Output) -> Params -> PandocPure Output
    forall a.
    (Text -> PandocPure a)
    -> (ByteString -> PandocPure a) -> Params -> PandocPure a
    convert'
            (\Text
    t -> Text -> Bool -> [Message] -> Output
    Succeeded Text
    t Bool
    False ([Message] -> Output)
    -> ([LogMessage] -> [Message]) -> [LogMessage] -> Output
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (LogMessage -> Message) -> [LogMessage] -> [Message]
    forall a b. (a -> b) -> [a] -> [b]
    map LogMessage -> Message
    toMessage ([LogMessage] -> Output)
    -> PandocPure [LogMessage] -> PandocPure Output
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> PandocPure [LogMessage]
    forall (m :: * -> *). PandocMonad m => m [LogMessage]
    getLog)
            (\ByteString
    bs -> Text -> Bool -> [Message] -> Output
    Succeeded (ByteString -> Text
    UTF8.toText (ByteString -> Text) -> ByteString -> Text
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    Base64.encode (ByteString -> ByteString
    BL.toStrict ByteString
    bs)) Bool
    True
                     ([Message] -> Output)
    -> ([LogMessage] -> [Message]) -> [LogMessage] -> Output
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (LogMessage -> Message) -> [LogMessage] -> [Message]
    forall a b. (a -> b) -> [a] -> [b]
    map LogMessage -> Message
    toMessage ([LogMessage] -> Output)
    -> PandocPure [LogMessage] -> PandocPure Output
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> PandocPure [LogMessage]
    forall (m :: * -> *). PandocMonad m => m [LogMessage]
    getLog)
            Params
    params)

      toMessage :: LogMessage -> Message
    toMessage LogMessage
    m = Message { verbosity :: Verbosity
    verbosity = LogMessage -> Verbosity
    messageVerbosity LogMessage
    m
                            , message :: Text
    message = LogMessage -> Text
    showLogMessage LogMessage
    m }

      convert' :: (Text -> PandocPure a)
               -> (BL.ByteString -> PandocPure a)
               -> Params -> PandocPure a
      convert' :: forall a.
    (Text -> PandocPure a)
    -> (ByteString -> PandocPure a) -> Params -> PandocPure a
    convert' Text -> PandocPure a
    textHandler ByteString -> PandocPure a
    bsHandler Params
    params = do
        curtime <- PandocPure UTCTime
    forall (m :: * -> *). PandocMonad m => m UTCTime
    getCurrentTime
        -- put files params in ersatz file system
        let addFile :: FilePath -> Blob -> FileTree -> FileTree
            addFile String
    fp (Blob ByteString
    lbs) =
              String -> FileInfo -> FileTree -> FileTree
    insertInFileTree String
    fp FileInfo{ infoFileMTime :: UTCTime
    infoFileMTime = UTCTime
    curtime
                                          , infoFileContents :: ByteString
    infoFileContents = ByteString -> ByteString
    BL.toStrict ByteString
    lbs }
        case files params of
          Maybe (Map String Blob)
    Nothing -> () -> PandocPure ()
    forall a. a -> PandocPure a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          Just Map String Blob
    fs -> do
            let filetree :: FileTree
    filetree = (String -> Blob -> FileTree -> FileTree)
    -> FileTree -> Map String Blob -> FileTree
    forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
    M.foldrWithKey String -> Blob -> FileTree -> FileTree
    addFile FileTree
    forall a. Monoid a => a
    mempty Map String Blob
    fs
            (PureState -> PureState) -> PandocPure ()
    modifyPureState ((PureState -> PureState) -> PandocPure ())
    -> (PureState -> PureState) -> PandocPure ()
    forall a b. (a -> b) -> a -> b
    $ \PureState
    st -> PureState
    st{ stFiles = filetree }

        let opts = Params -> Opt
    options Params
    params
        readerFormat <- parseFlavoredFormat <$> fromMaybe "markdown" $ optFrom opts
        writerFormat <- parseFlavoredFormat <$> fromMaybe "html" $ optTo opts
        (readerSpec, readerExts) <- getReader readerFormat
        (writerSpec, writerExts) <- getWriter writerFormat

        let isStandalone = Opt -> Bool
    optStandalone Opt
    opts
        let toformat = FlavoredFormat -> Text
    formatName FlavoredFormat
    writerFormat
        hlStyle <- case optSyntaxHighlighting opts of
          Text
    "none"      -> HighlightMethod -> PandocPure HighlightMethod
    forall a. a -> PandocPure a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure HighlightMethod
    NoHighlighting
          Text
    "idiomatic" -> HighlightMethod -> PandocPure HighlightMethod
    forall a. a -> PandocPure a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure HighlightMethod
    IdiomaticHighlighting
          Text
    "default"   -> HighlightMethod -> PandocPure HighlightMethod
    forall a. a -> PandocPure a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure HighlightMethod
    DefaultHighlighting
          Text
    s           -> Style -> HighlightMethod
    Skylighting (Style -> HighlightMethod)
    -> PandocPure Style -> PandocPure HighlightMethod
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> PandocPure Style
    forall (m :: * -> *). PandocMonad m => String -> m Style
    lookupHighlightingStyle (Text -> String
    T.unpack Text
    s)

        mbTemplate <- if isStandalone
                         then case optTemplate opts of
                                Maybe String
    Nothing -> Template Text -> Maybe (Template Text)
    forall a. a -> Maybe a
    Just (Template Text -> Maybe (Template Text))
    -> PandocPure (Template Text) -> PandocPure (Maybe (Template Text))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                                  Text -> PandocPure (Template Text)
    forall (m :: * -> *). PandocMonad m => Text -> m (Template Text)
    compileDefaultTemplate Text
    toformat
                                Just String
    t  -> Template Text -> Maybe (Template Text)
    forall a. a -> Maybe a
    Just (Template Text -> Maybe (Template Text))
    -> PandocPure (Template Text) -> PandocPure (Maybe (Template Text))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                                  Text -> String -> PandocPure (Template Text)
    forall {m :: * -> *} {a}.
    (PandocMonad m, HasChars a, ToText a, FromText a) =>
    Text -> String -> m (Template a)
    compileCustomTemplate Text
    toformat String
    t
                         else return Nothing

        abbrevs <- Set.fromList . filter (not . T.null) . T.lines . UTF8.toText <$>
                     case optAbbreviations opts of
                          Maybe String
    Nothing -> String -> PandocPure ByteString
    forall (m :: * -> *). PandocMonad m => String -> m ByteString
    readDataFile String
    "abbreviations"
                          Just String
    f  -> String -> PandocPure ByteString
    forall (m :: * -> *). PandocMonad m => String -> m ByteString
    readFileStrict String
    f

        let readeropts = ReaderOptions
    forall a. Default a => a
    def{ readerExtensions = readerExts
                            , readerStandalone = isStandalone
                            , readerTabStop = optTabStop opts
                            , readerIndentedCodeClasses =
                                optIndentedCodeClasses opts
                            , readerAbbreviations = abbrevs
                            , readerDefaultImageExtension =
                                optDefaultImageExtension opts
                            , readerTrackChanges = optTrackChanges opts
                            , readerStripComments = optStripComments opts
                            , readerTypstInputs = optTypstInputs opts
                            }

        let writeropts = WriterOptions
                 { writerExtensions :: Extensions
    writerExtensions = Extensions
    writerExts
                 , writerTabStop :: Int
    writerTabStop = Opt -> Int
    optTabStop Opt
    opts
                 , writerWrapText :: WrapOption
    writerWrapText = Opt -> WrapOption
    optWrap Opt
    opts
                 , writerColumns :: Int
    writerColumns = Opt -> Int
    optColumns Opt
    opts
                 , writerTemplate :: Maybe (Template Text)
    writerTemplate = Maybe (Template Text)
    mbTemplate
                 , writerSyntaxMap :: SyntaxMap
    writerSyntaxMap = SyntaxMap
    defaultSyntaxMap
                 , writerVariables :: Context Text
    writerVariables = Opt -> Context Text
    optVariables Opt
    opts
                 , writerTableOfContents :: Bool
    writerTableOfContents = Opt -> Bool
    optTableOfContents Opt
    opts
                 , writerListOfFigures :: Bool
    writerListOfFigures = Opt -> Bool
    optListOfFigures Opt
    opts
                 , writerListOfTables :: Bool
    writerListOfTables = Opt -> Bool
    optListOfTables Opt
    opts
                 , writerIncremental :: Bool
    writerIncremental = Opt -> Bool
    optIncremental Opt
    opts
                 , writerHTMLMathMethod :: HTMLMathMethod
    writerHTMLMathMethod = Opt -> HTMLMathMethod
    optHTMLMathMethod Opt
    opts
                 , writerNumberSections :: Bool
    writerNumberSections = Opt -> Bool
    optNumberSections Opt
    opts
                 , writerNumberOffset :: [Int]
    writerNumberOffset = Opt -> [Int]
    optNumberOffset Opt
    opts
                 , writerSectionDivs :: Bool
    writerSectionDivs = Opt -> Bool
    optSectionDivs Opt
    opts
                 , writerReferenceLinks :: Bool
    writerReferenceLinks = Opt -> Bool
    optReferenceLinks Opt
    opts
                 , writerDpi :: Int
    writerDpi = Opt -> Int
    optDpi Opt
    opts
                 , writerEmailObfuscation :: ObfuscationMethod
    writerEmailObfuscation = Opt -> ObfuscationMethod
    optEmailObfuscation Opt
    opts
                 , writerIdentifierPrefix :: Text
    writerIdentifierPrefix = Opt -> Text
    optIdentifierPrefix Opt
    opts
                 , writerCiteMethod :: CiteMethod
    writerCiteMethod = Opt -> CiteMethod
    optCiteMethod Opt
    opts
                 , writerHtmlQTags :: Bool
    writerHtmlQTags = Opt -> Bool
    optHtmlQTags Opt
    opts
                 , writerSlideLevel :: Maybe Int
    writerSlideLevel = Opt -> Maybe Int
    optSlideLevel Opt
    opts
                 , writerTopLevelDivision :: TopLevelDivision
    writerTopLevelDivision = Opt -> TopLevelDivision
    optTopLevelDivision Opt
    opts
                 , writerHighlightMethod :: HighlightMethod
    writerHighlightMethod = HighlightMethod
    hlStyle
                 , writerSetextHeaders :: Bool
    writerSetextHeaders = Opt -> Bool
    optSetextHeaders Opt
    opts
                 , writerListTables :: Bool
    writerListTables = Opt -> Bool
    optListTables Opt
    opts
                 , writerEpubSubdirectory :: Text
    writerEpubSubdirectory = String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ Opt -> String
    optEpubSubdirectory Opt
    opts
                 , writerEpubMetadata :: Maybe Text
    writerEpubMetadata = String -> Text
    T.pack (String -> Text) -> Maybe String -> Maybe Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Opt -> Maybe String
    optEpubMetadata Opt
    opts
                 , writerEpubFonts :: [String]
    writerEpubFonts = Opt -> [String]
    optEpubFonts Opt
    opts
                 , writerEpubTitlePage :: Bool
    writerEpubTitlePage    = Opt -> Bool
    optEpubTitlePage Opt
    opts
                 , writerSplitLevel :: Int
    writerSplitLevel = Opt -> Int
    optSplitLevel Opt
    opts
                 , writerChunkTemplate :: PathTemplate
    writerChunkTemplate = PathTemplate
    -> (Text -> PathTemplate) -> Maybe Text -> PathTemplate
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Text -> PathTemplate
    PathTemplate Text
    "%s-%i.html")
                                             Text -> PathTemplate
    PathTemplate
                                             (Opt -> Maybe Text
    optChunkTemplate Opt
    opts)
                 , writerTOCDepth :: Int
    writerTOCDepth = Opt -> Int
    optTOCDepth Opt
    opts
                 , writerReferenceDoc :: Maybe String
    writerReferenceDoc = Opt -> Maybe String
    optReferenceDoc Opt
    opts
                 , writerReferenceLocation :: ReferenceLocation
    writerReferenceLocation = Opt -> ReferenceLocation
    optReferenceLocation Opt
    opts
                 , writerFigureCaptionPosition :: CaptionPosition
    writerFigureCaptionPosition = Opt -> CaptionPosition
    optFigureCaptionPosition Opt
    opts
                 , writerTableCaptionPosition :: CaptionPosition
    writerTableCaptionPosition = Opt -> CaptionPosition
    optTableCaptionPosition Opt
    opts
                 , writerPreferAscii :: Bool
    writerPreferAscii = Opt -> Bool
    optAscii Opt
    opts
                 , writerLinkImages :: Bool
    writerLinkImages = Opt -> Bool
    optLinkImages Opt
    opts
                 }

        let reader = case Reader PandocPure
    readerSpec of
                    TextReader forall a. ToSources a => ReaderOptions -> a -> PandocPure Pandoc
    r -> ReaderOptions -> Text -> PandocPure Pandoc
    forall a. ToSources a => ReaderOptions -> a -> PandocPure Pandoc
    r ReaderOptions
    readeropts
                    ByteStringReader ReaderOptions -> ByteString -> PandocPure Pandoc
    r ->
                      ReaderOptions -> ByteString -> PandocPure Pandoc
    r ReaderOptions
    readeropts (ByteString -> PandocPure Pandoc)
    -> (Text -> ByteString) -> Text -> PandocPure Pandoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    BL.fromStrict (ByteString -> ByteString)
    -> (Text -> ByteString) -> Text -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    Base64.decodeLenient
                        (ByteString -> ByteString)
    -> (Text -> ByteString) -> Text -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> ByteString
    UTF8.fromText

        let writer d :: Pandoc
    d@(Pandoc Meta
    meta [Block]
    _) = do
              case Text -> Meta -> Text
    lookupMetaString Text
    "lang" Meta
    meta of
                  Text
    ""      -> Lang -> PandocPure ()
    forall (m :: * -> *). PandocMonad m => Lang -> m ()
    setTranslations (Lang -> PandocPure ()) -> Lang -> PandocPure ()
    forall a b. (a -> b) -> a -> b
    $
                                Text
    -> Maybe Text
    -> Maybe Text
    -> [Text]
    -> [(Text, [(Text, Text)])]
    -> [Text]
    -> Lang
    Lang Text
    "en" Maybe Text
    forall a. Maybe a
    Nothing (Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    "US") [] [] []
                  Text
    l       -> case Text -> Either String Lang
    parseLang Text
    l of
                                  Left String
    _   -> LogMessage -> PandocPure ()
    forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
    report (LogMessage -> PandocPure ()) -> LogMessage -> PandocPure ()
    forall a b. (a -> b) -> a -> b
    $ Text -> LogMessage
    InvalidLang Text
    l
                                  Right Lang
    l' -> Lang -> PandocPure ()
    forall (m :: * -> *). PandocMonad m => Lang -> m ()
    setTranslations Lang
    l'
              case Writer PandocPure
    writerSpec of
                    TextWriter WriterOptions -> Pandoc -> PandocPure Text
    w ->
                      WriterOptions -> Pandoc -> PandocPure Text
    w WriterOptions
    writeropts Pandoc
    d PandocPure Text -> (Text -> PandocPure Text) -> PandocPure Text
    forall a b. PandocPure a -> (a -> PandocPure b) -> PandocPure b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                        (if Opt -> Bool
    optEmbedResources Opt
    opts Bool -> Bool -> Bool
    && Maybe Text -> Bool
    htmlFormat (Opt -> Maybe Text
    optTo Opt
    opts)
                            then Text -> PandocPure Text
    forall (m :: * -> *). PandocMonad m => Text -> m Text
    makeSelfContained
                            else Text -> PandocPure Text
    forall a. a -> PandocPure a
    forall (m :: * -> *) a. Monad m => a -> m a
    return) PandocPure Text -> (Text -> PandocPure a) -> PandocPure a
    forall a b. PandocPure a -> (a -> PandocPure b) -> PandocPure b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                        Text -> PandocPure a
    textHandler
                    ByteStringWriter WriterOptions -> Pandoc -> PandocPure ByteString
    w ->
                      WriterOptions -> Pandoc -> PandocPure ByteString
    w WriterOptions
    writeropts Pandoc
    d PandocPure ByteString
    -> (ByteString -> PandocPure a) -> PandocPure a
    forall a b. PandocPure a -> (a -> PandocPure b) -> PandocPure b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ByteString -> PandocPure a
    bsHandler

        let transforms :: Pandoc -> Pandoc
            transforms = (case Opt -> Int
    optShiftHeadingLevelBy Opt
    opts of
                            Int
    0             -> Pandoc -> Pandoc
    forall a. a -> a
    id
                            Int
    x             -> Int -> Pandoc -> Pandoc
    headerShift Int
    x) (Pandoc -> Pandoc) -> (Pandoc -> Pandoc) -> Pandoc -> Pandoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                       (if Extension -> Extensions -> Bool
    extensionEnabled Extension
    Ext_east_asian_line_breaks
                              Extensions
    readerExts Bool -> Bool -> Bool
    &&
                           Bool -> Bool
    not (Extension -> Extensions -> Bool
    extensionEnabled Extension
    Ext_east_asian_line_breaks
                                  Extensions
    writerExts Bool -> Bool -> Bool
    &&
                                Opt -> WrapOption
    optWrap Opt
    opts WrapOption -> WrapOption -> Bool
    forall a. Eq a => a -> a -> Bool
    == WrapOption
    WrapPreserve)
                           then Pandoc -> Pandoc
    eastAsianLineBreakFilter
                           else Pandoc -> Pandoc
    forall a. a -> a
    id) (Pandoc -> Pandoc) -> (Pandoc -> Pandoc) -> Pandoc -> Pandoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                       (case Opt -> IpynbOutput
    optIpynbOutput Opt
    opts of
                         IpynbOutput
    IpynbOutputAll  -> Pandoc -> Pandoc
    forall a. a -> a
    id
                         IpynbOutput
    IpynbOutputNone -> Maybe Format -> Pandoc -> Pandoc
    filterIpynbOutput Maybe Format
    forall a. Maybe a
    Nothing
                         IpynbOutput
    IpynbOutputBest -> Maybe Format -> Pandoc -> Pandoc
    filterIpynbOutput (Format -> Maybe Format
    forall a. a -> Maybe a
    Just (Format -> Maybe Format) -> Format -> Maybe Format
    forall a b. (a -> b) -> a -> b
    $
                           case Opt -> Maybe Text
    optTo Opt
    opts of
                                Just Text
    "latex"  -> Text -> Format
    Format Text
    "latex"
                                Just Text
    "beamer" -> Text -> Format
    Format Text
    "latex"
                                Maybe Text
    Nothing       -> Text -> Format
    Format Text
    "html"
                                Just Text
    f
                                  | Maybe Text -> Bool
    htmlFormat (Opt -> Maybe Text
    optTo Opt
    opts) -> Text -> Format
    Format Text
    "html"
                                  | Bool
    otherwise -> Text -> Format
    Format Text
    f))

        let meta =   (case Opt -> [String]
    optBibliography Opt
    opts of
                       [] -> Meta -> Meta
    forall a. a -> a
    id
                       [String]
    fs -> Text -> MetaValue -> Meta -> Meta
    forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
    forall b. ToMetaValue b => Text -> b -> Meta -> Meta
    setMeta Text
    "bibliography" ([MetaValue] -> MetaValue
    MetaList
                                ((String -> MetaValue) -> [String] -> [MetaValue]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text -> MetaValue
    MetaString (Text -> MetaValue) -> (String -> Text) -> String -> MetaValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack) [String]
    fs))) (Meta -> Meta) -> (Meta -> Meta) -> Meta -> Meta
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                     (Meta -> Meta)
    -> (String -> Meta -> Meta) -> Maybe String -> Meta -> Meta
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Meta -> Meta
    forall a. a -> a
    id (Text -> MetaValue -> Meta -> Meta
    forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
    forall b. ToMetaValue b => Text -> b -> Meta -> Meta
    setMeta Text
    "csl" (MetaValue -> Meta -> Meta)
    -> (String -> MetaValue) -> String -> Meta -> Meta
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> MetaValue
    MetaString (Text -> MetaValue) -> (String -> Text) -> String -> MetaValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack)
                       (Opt -> Maybe String
    optCSL Opt
    opts) (Meta -> Meta) -> (Meta -> Meta) -> Meta -> Meta
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                     (Meta -> Meta)
    -> (String -> Meta -> Meta) -> Maybe String -> Meta -> Meta
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Meta -> Meta
    forall a. a -> a
    id (Text -> MetaValue -> Meta -> Meta
    forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
    forall b. ToMetaValue b => Text -> b -> Meta -> Meta
    setMeta Text
    "citation-abbreviations" (MetaValue -> Meta -> Meta)
    -> (String -> MetaValue) -> String -> Meta -> Meta
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> MetaValue
    MetaString (Text -> MetaValue) -> (String -> Text) -> String -> MetaValue
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
                                  String -> Text
    T.pack)
                       (Opt -> Maybe String
    optCitationAbbreviations Opt
    opts) (Meta -> Meta) -> Meta -> Meta
    forall a b. (a -> b) -> a -> b
    $
                     Opt -> Meta
    optMetadata Opt
    opts

        let addMetadata Meta
    m' (Pandoc Meta
    m [Block]
    bs) = Meta -> [Block] -> Pandoc
    Pandoc (Meta
    m Meta -> Meta -> Meta
    forall a. Semigroup a => a -> a -> a
    <> Meta
    m') [Block]
    bs

        reader (text params) >>=
          return . transforms . addMetadata meta >>=
            (case citeproc params of
              Just Bool
    True -> Pandoc -> PandocPure Pandoc
    forall (m :: * -> *). PandocMonad m => Pandoc -> m Pandoc
    processCitations
              Maybe Bool
    _ -> Pandoc -> PandocPure Pandoc
    forall a. a -> PandocPure a
    forall (m :: * -> *) a. Monad m => a -> m a
    return) >>=
          writer

      htmlFormat :: Maybe Text -> Bool
      htmlFormat :: Maybe Text -> Bool
    htmlFormat Maybe Text
    Nothing = Bool
    True
      htmlFormat (Just Text
    f) =
        (Text -> Bool) -> [Text] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Text -> Text -> Bool
    `T.isPrefixOf` Text
    f)
          [Text
    "html",Text
    "html4",Text
    "html5",Text
    "s5",Text
    "slidy", Text
    "slideous",Text
    "dzslides",Text
    "revealjs"]

      handleErr :: Either PandocError a -> m a
    handleErr (Right a
    t) = a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    t
      handleErr (Left PandocError
    err) = ServerError -> m a
    forall a. ServerError -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (ServerError -> m a) -> ServerError -> m a
    forall a b. (a -> b) -> a -> b
    $
        ServerError
    err500 { errBody = TLE.encodeUtf8 $ TL.fromStrict $ renderError err }

      handleErrJSON :: Either PandocError Output -> m Output
    handleErrJSON (Right Output
    o) = Output -> m Output
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Output
    o
      handleErrJSON (Left PandocError
    err) =
        Output -> m Output
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Output -> m Output) -> Output -> m Output
    forall a b. (a -> b) -> a -> b
    $ Text -> Output
    Failed (PandocError -> Text
    renderError PandocError
    err)

      compileCustomTemplate :: Text -> String -> m (Template a)
    compileCustomTemplate Text
    toformat String
    t = do
        res <- WithPartials m (Either String (Template a))
    -> m (Either String (Template a))
    forall (m :: * -> *) a. WithPartials m a -> m a
    runWithPartials (WithPartials m (Either String (Template a))
     -> m (Either String (Template a)))
    -> WithPartials m (Either String (Template a))
    -> m (Either String (Template a))
    forall a b. (a -> b) -> a -> b
    $ String -> Text -> WithPartials m (Either String (Template a))
    forall (m :: * -> *) a.
    (TemplateMonad m, TemplateTarget a) =>
    String -> Text -> m (Either String (Template a))
    compileTemplate (String
    "custom." String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Text -> String
    T.unpack Text
    toformat)
                   (String -> Text
    T.pack String
    t)
        case res of
          Left String
    e -> PandocError -> m (Template a)
    forall a. PandocError -> m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (PandocError -> m (Template a)) -> PandocError -> m (Template a)
    forall a b. (a -> b) -> a -> b
    $ Text -> PandocError
    PandocTemplateError (String -> Text
    T.pack String
    e)
          Right Template a
    tpl -> Template a -> m (Template a)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Template a
    tpl