1{-# LANGUAGE OverloadedStrings #-}
2module Text.Pandoc.Writers.Math
3  ( texMathToInlines
4  , convertMath
5  , defaultMathJaxURL
6  , defaultKaTeXURL
7  )
8where
9
10import qualified Data.Text as T
11import Text.Pandoc.Class.PandocMonad
12import Text.Pandoc.Definition
13import Text.Pandoc.Logging
14import Text.TeXMath (DisplayType (..), Exp, readTeX, writePandoc)
15import Text.Pandoc.Options (defaultMathJaxURL, defaultKaTeXURL)
16
17-- | Converts a raw TeX math formula to a list of 'Pandoc' inlines.
18-- Defaults to raw formula between @$@ or @$$@ characters if entire formula
19-- can't be converted.
20texMathToInlines :: PandocMonad m
21                 => MathType
22                 -> T.Text         -- ^ String to parse (assumes @'\n'@ line endings)
23                 -> m [Inline]
24texMathToInlines mt inp = do
25  res <- convertMath writePandoc mt inp
26  case res of
27       Right (Just ils)  -> return ils
28       Right Nothing   -> do
29         report $ CouldNotConvertTeXMath inp ""
30         return [mkFallback mt inp]
31       Left il           -> return [il]
32
33mkFallback :: MathType -> T.Text -> Inline
34mkFallback mt str = Str (delim <> str <> delim)
35   where delim = case mt of
36                      DisplayMath -> "$$"
37                      InlineMath  -> "$"
38
39-- | Converts a raw TeX math formula using a writer function,
40-- issuing a warning and producing a fallback (a raw string)
41-- on failure.
42convertMath :: PandocMonad m
43            => (DisplayType -> [Exp] -> a) -> MathType -> T.Text
44            -> m (Either Inline a)
45convertMath writer mt str =
46  case writer dt <$> readTeX str of
47       Right r  -> return (Right r)
48       Left e   -> do
49         report $ CouldNotConvertTeXMath str e
50         return (Left $ mkFallback mt str)
51   where dt = case mt of
52                   DisplayMath -> DisplayBlock
53                   InlineMath  -> DisplayInline
54