{-# 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
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
}
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 )
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
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
(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 ]
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
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 <- traverse (lookupHighlightingStyle . T.unpack)
$ optHighlightStyle opts
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
}
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
, writerListings :: Bool
writerListings = Opt -> Bool
optListings Opt
opts
, writerHighlightStyle :: Maybe Style
writerHighlightStyle = Maybe Style
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 b. ToMetaValue b => Text -> b -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
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 b. ToMetaValue b => Text -> b -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
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 b. ToMetaValue b => Text -> b -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
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