{-# LANGUAGE GADTs, OverloadedStrings #-}
module Image.LaTeX.Render.Pandoc (
convertFormulaSVG,
convertAllFormulaeSVG,
convertFormulaFiles,
convertAllFormulaeFiles,
NameSupply,
newNameSupply,
PandocFormulaOptions(..),
ShrinkSize,
defaultPandocFormulaOptions,
hideError,
displayError,
convertFormulaSVGWith,
convertAllFormulaeSVGWith,
convertFormulaFilesWith,
convertAllFormulaeFilesWith,
) where
import Data.IORef (IORef, modifyIORef, newIORef, readIORef)
import Data.String (IsString (..))
import Numeric (showFFloat)
import System.FilePath ((<.>), (</>))
import Text.Pandoc.Definition (Format (..), Inline (..), MathType (..), Pandoc, nullAttr)
import Text.Pandoc.Walk (walkM)
import qualified Data.Text as T
import Image.LaTeX.Render
data PandocFormulaOptions = PandocFormulaOptions
{ errorDisplay :: RenderError -> Inline
, formulaOptions :: MathType -> FormulaOptions
}
defaultPandocFormulaOptions :: PandocFormulaOptions
defaultPandocFormulaOptions = PandocFormulaOptions
{ errorDisplay = displayError
, formulaOptions = fopts
}
where
fopts DisplayMath = displaymath
fopts InlineMath = math
type ShrinkSize = Int
convertFormulaSVG
:: EnvironmentOptions
-> PandocFormulaOptions
-> Inline -> IO Inline
convertFormulaSVG = convertFormulaSVGWith . imageForFormula
convertAllFormulaeSVG
:: EnvironmentOptions
-> PandocFormulaOptions
-> Pandoc -> IO Pandoc
convertAllFormulaeSVG e = walkM . convertFormulaSVG e
convertFormulaSVGWith
:: (FormulaOptions -> Formula -> IO (Either RenderError SVG))
-> PandocFormulaOptions
-> Inline -> IO Inline
convertFormulaSVGWith f o (Math t s) = do
res <- f (formulaOptions o t) (toString s)
case res of
Left e -> return $ errorDisplay o e
Right svg -> return $ RawInline (Format "html") $ fromString $ alterForHTML svg
convertFormulaSVGWith _ _ x = return x
convertAllFormulaeSVGWith
:: (FormulaOptions -> Formula -> IO (Either RenderError SVG))
-> PandocFormulaOptions
-> Pandoc -> IO Pandoc
convertAllFormulaeSVGWith f = walkM . convertFormulaSVGWith f
type NameSupply = IORef Int
newNameSupply :: IO NameSupply
newNameSupply = newIORef 0
convertFormulaFilesWith
:: (FormulaOptions -> Formula -> IO (Either RenderError SVG))
-> NameSupply
-> FilePath
-> PandocFormulaOptions
-> Inline -> IO Inline
convertFormulaFilesWith f ns bn o (Math t s) = f (formulaOptions o t) (toString s) >>= \res -> case res of
Left e -> return $ errorDisplay o e
Right svg -> do
let baseline = getBaseline svg
fn <- readIORef ns
modifyIORef ns (+1)
let uri = bn </> show fn <.> "svg"
writeFile uri svg
return $ RawInline (Format "html") $ fromString $
"<img src=\"" ++ uri ++ "\"" ++
" class=" ++ (case t of InlineMath -> "inline-math"; DisplayMath -> "display-math") ++
" style=\"margin:0; vertical-align:-" ++ showFFloat (Just 6) baseline "" ++ "pt;\"/>"
convertFormulaFilesWith _ _ _ _ x = return x
convertFormulaFiles
:: EnvironmentOptions
-> NameSupply
-> FilePath
-> PandocFormulaOptions
-> Inline -> IO Inline
convertFormulaFiles = convertFormulaFilesWith . imageForFormula
convertAllFormulaeFiles
:: EnvironmentOptions
-> NameSupply
-> FilePath
-> PandocFormulaOptions
-> Pandoc -> IO Pandoc
convertAllFormulaeFiles eo ns fp = walkM . convertFormulaFiles eo ns fp
convertAllFormulaeFilesWith
:: (FormulaOptions -> Formula -> IO (Either RenderError SVG))
-> NameSupply
-> FilePath
-> PandocFormulaOptions
-> Pandoc -> IO Pandoc
convertAllFormulaeFilesWith x y a = walkM . convertFormulaFilesWith x y a
hideError :: RenderError -> Inline
hideError = const $ Str blank
where
blank = "Error"
displayError :: RenderError -> Inline
displayError (LaTeXFailure str) = pandocError [Str "LaTeX failed:", LineBreak, Code nullAttr $ fromString str]
displayError (DVISVGMFailure str) = pandocError [Str "DVIPS failed:", LineBreak, Code nullAttr $ fromString str]
displayError (IOException e) = pandocError [Str "IO Exception:", LineBreak, Code nullAttr $ fromString $ show e]
pandocError :: [Inline] -> Inline
pandocError = Strong . (Emph [Str "Error:"] :)
class IsString s => ToString s where
toString :: s -> String
instance Char ~ c => ToString [c] where
toString = id
instance ToString T.Text where
toString = T.unpack