Docx reader: Use TeXMath to write math
The new version of TeXMath can translate from its type system into LaTeX. So instead of writing the LaTeX ourself, we write to the TeXMath `Exp` type, and let TeXMath do the rest.
This commit is contained in:
Jesse Rosenthal
parent
1819bdfaed
commit
3bc2ea4cf7
2 changed files with 312 additions and 174 deletions
|
|
@ -82,17 +82,17 @@ import Text.Pandoc.Walk
|
|||
import Text.Pandoc.Readers.Docx.Parse
|
||||
import Text.Pandoc.Readers.Docx.Lists
|
||||
import Text.Pandoc.Readers.Docx.Reducible
|
||||
import Text.Pandoc.Readers.Docx.TexChar
|
||||
import Text.Pandoc.Shared
|
||||
import Text.Pandoc.MediaBag (insertMedia, MediaBag)
|
||||
import Data.Maybe (mapMaybe, fromMaybe)
|
||||
import Data.List (delete, stripPrefix, (\\), intercalate, intersect)
|
||||
import Data.List (delete, stripPrefix, (\\), intersperse, intersect)
|
||||
import Data.Monoid
|
||||
import Text.TeXMath (writeTeX)
|
||||
import qualified Text.TeXMath.Types as TM
|
||||
import qualified Data.ByteString.Lazy as B
|
||||
import qualified Data.Map as M
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.State
|
||||
import Text.Printf (printf)
|
||||
|
||||
readDocx :: ReaderOptions
|
||||
-> B.ByteString
|
||||
|
|
@ -381,158 +381,192 @@ parPartToInlines (ExternalHyperLink target runs) = do
|
|||
ils <- concatMapM runToInlines runs
|
||||
return [Link ils (target, "")]
|
||||
parPartToInlines (PlainOMath omath) = do
|
||||
s <- oMathToTexString omath
|
||||
return [Math InlineMath s]
|
||||
e <- oMathToExps omath
|
||||
return [Math InlineMath (writeTeX e)]
|
||||
|
||||
oMathToTexString :: OMath -> DocxContext String
|
||||
oMathToTexString (OMath omathElems) = do
|
||||
ss <- mapM oMathElemToTexString omathElems
|
||||
return $ intercalate " " ss
|
||||
oMathElemToTexString :: OMathElem -> DocxContext String
|
||||
oMathElemToTexString (Accent style base) | Just c <- accentChar style = do
|
||||
baseString <- baseToTexString base
|
||||
return $ case lookupTexChar c of
|
||||
s@('\\' : _) -> printf "%s{%s}" s baseString
|
||||
_ -> printf "\\acute{%s}" baseString -- we default.
|
||||
oMathElemToTexString (Accent _ base) =
|
||||
baseToTexString base >>= (\s -> return $ printf "\\acute{%s}" s)
|
||||
oMathElemToTexString (Bar style base) = do
|
||||
baseString <- baseToTexString base
|
||||
oMathToExps :: OMath -> DocxContext [TM.Exp]
|
||||
oMathToExps (OMath oMathElems) = concatMapM oMathElemToExps oMathElems
|
||||
|
||||
oMathElemToExps :: OMathElem -> DocxContext [TM.Exp]
|
||||
oMathElemToExps (Accent style base) = do
|
||||
baseExp <- baseToExp base
|
||||
let chr = case accentChar style of
|
||||
Just c -> c
|
||||
Nothing -> '\180' -- default to acute.
|
||||
return [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr])]
|
||||
oMathElemToExps(Bar style base) = do
|
||||
baseExp <- baseToExp base
|
||||
return $ case barPos style of
|
||||
Top -> printf "\\overline{%s}" baseString
|
||||
Bottom -> printf "\\underline{%s}" baseString
|
||||
oMathElemToTexString (Box base) = baseToTexString base
|
||||
oMathElemToTexString (BorderBox base) =
|
||||
baseToTexString base >>= (\s -> return $ printf "\\boxed{%s}" s)
|
||||
oMathElemToTexString (Delimiter dPr bases) = do
|
||||
let beg = fromMaybe '(' (delimBegChar dPr)
|
||||
Top -> [TM.EOver False baseExp (TM.ESymbol TM.Accent "\175")]
|
||||
Bottom -> [TM.EUnder False baseExp (TM.ESymbol TM.Accent "\818")]
|
||||
oMathElemToExps (Box base) =
|
||||
(\e -> return [e]) =<< baseToExp base
|
||||
oMathElemToExps (BorderBox base) =
|
||||
-- TODO: This should be "\\boxed" somehow
|
||||
(\e -> return [e]) =<< baseToExp base
|
||||
oMathElemToExps (Delimiter dPr bases) = do
|
||||
baseExps <- mapM baseToExp bases
|
||||
let inDelimExps = map Right baseExps
|
||||
beg = fromMaybe '(' (delimBegChar dPr)
|
||||
end = fromMaybe ')' (delimEndChar dPr)
|
||||
sep = fromMaybe '|' (delimSepChar dPr)
|
||||
left = "\\left" ++ lookupTexChar beg
|
||||
right = "\\right" ++ lookupTexChar end
|
||||
mid = "\\middle" ++ lookupTexChar sep
|
||||
baseStrings <- mapM baseToTexString bases
|
||||
return $ printf "%s %s %s"
|
||||
left
|
||||
(intercalate (" " ++ mid ++ " ") baseStrings)
|
||||
right
|
||||
oMathElemToTexString (EquationArray bases) = do
|
||||
baseStrings <- mapM baseToTexString bases
|
||||
inSub <- gets docxInTexSubscript
|
||||
return $
|
||||
if inSub
|
||||
then
|
||||
printf "\\substack{%s}" (intercalate "\\\\ " baseStrings)
|
||||
else
|
||||
printf
|
||||
"\\begin{aligned}\n%s\n\\end{aligned}"
|
||||
(intercalate "\\\\\n" baseStrings)
|
||||
oMathElemToTexString (Fraction num denom) = do
|
||||
numString <- concatMapM oMathElemToTexString num
|
||||
denString <- concatMapM oMathElemToTexString denom
|
||||
return $ printf "\\frac{%s}{%s}" numString denString
|
||||
oMathElemToTexString (Function fname base) = do
|
||||
fnameString <- concatMapM oMathElemToTexString fname
|
||||
baseString <- baseToTexString base
|
||||
return $ printf "%s %s" fnameString baseString
|
||||
oMathElemToTexString (Group style base)
|
||||
| Just c <- groupChr style
|
||||
, grouper <- lookupTexChar c
|
||||
, notElem grouper ["\\overbrace", "\\underbrace"]
|
||||
= do
|
||||
baseString <- baseToTexString base
|
||||
return $ case groupPos style of
|
||||
Just Top -> printf "\\overset{%s}{%s}" grouper baseString
|
||||
_ -> printf "\\underset{%s}{%s}" grouper baseString
|
||||
oMathElemToTexString (Group style base) = do
|
||||
baseString <- baseToTexString base
|
||||
return $ case groupPos style of
|
||||
Just Top -> printf "\\overbrace{%s}" baseString
|
||||
_ -> printf "\\underbrace{%s}" baseString
|
||||
oMathElemToTexString (LowerLimit base limElems) = do
|
||||
baseString <- baseToTexString base
|
||||
lim <- concatMapM oMathElemToTexString limElems
|
||||
-- we want to make sure to replace the `\rightarrow` with `\to`
|
||||
let arrowToTo :: String -> String
|
||||
arrowToTo "" = ""
|
||||
arrowToTo s | Just s' <- stripPrefix "\\rightarrow" s =
|
||||
"\\to" ++ arrowToTo s'
|
||||
arrowToTo (c:cs) = c : arrowToTo cs
|
||||
lim' = arrowToTo lim
|
||||
return $ case baseString of
|
||||
"lim" -> printf "\\lim_{%s}" lim'
|
||||
"max" -> printf "\\max_{%s}" lim'
|
||||
"min" -> printf "\\min_{%s}" lim'
|
||||
_ -> printf "\\operatorname*{%s}_{%s}" baseString lim'
|
||||
oMathElemToTexString (UpperLimit base limElems) = do
|
||||
baseString <- baseToTexString base
|
||||
lim <- concatMapM oMathElemToTexString limElems
|
||||
-- we want to make sure to replace the `\rightarrow` with `\to`
|
||||
let arrowToTo :: String -> String
|
||||
arrowToTo "" = ""
|
||||
arrowToTo s | Just s' <- stripPrefix "\\rightarrow" s =
|
||||
"\\to" ++ arrowToTo s'
|
||||
arrowToTo (c:cs) = c : arrowToTo cs
|
||||
lim' = arrowToTo lim
|
||||
return $ case baseString of
|
||||
"lim" -> printf "\\lim^{%s}" lim'
|
||||
"max" -> printf "\\max^{%s}" lim'
|
||||
"min" -> printf "\\min^{%s}" lim'
|
||||
_ -> printf "\\operatorname*{%s}^{%s}" baseString lim'
|
||||
oMathElemToTexString (Matrix bases) = do
|
||||
let rowString :: [Base] -> DocxContext String
|
||||
rowString bs = liftM (intercalate " & ") (mapM baseToTexString bs)
|
||||
exps = intersperse (Left [sep]) inDelimExps
|
||||
return [TM.EDelimited [beg] [end] exps]
|
||||
oMathElemToExps (EquationArray bases) = do
|
||||
let f b = do bs <- baseToExp' b
|
||||
return [bs]
|
||||
baseExps <- mapM f bases
|
||||
return [TM.EArray [] baseExps]
|
||||
oMathElemToExps (Fraction num denom) = do
|
||||
numExp <- concatMapM oMathElemToExps num >>= (return . TM.EGrouped)
|
||||
denExp <- concatMapM oMathElemToExps denom >>= (return . TM.EGrouped)
|
||||
return [TM.EFraction TM.NormalFrac numExp denExp]
|
||||
oMathElemToExps (Function fname base) = do
|
||||
-- We need a string for the fname, but omml gives it to us as a
|
||||
-- series of oMath elems. We're going to filter out the oMathRuns,
|
||||
-- which should work for us most of the time.
|
||||
let f :: OMathElem -> String
|
||||
f (OMathRun _ run) = runToString run
|
||||
f _ = ""
|
||||
fnameString = concatMap f fname
|
||||
baseExp <- baseToExp base
|
||||
return [TM.EMathOperator fnameString, baseExp]
|
||||
oMathElemToExps (Group style base)
|
||||
| Just Top <- groupPos style = do
|
||||
baseExp <- baseToExp base
|
||||
let chr = case groupChr style of
|
||||
Just c -> c
|
||||
Nothing -> '\65079' -- default to overbrace
|
||||
return [TM.EOver False baseExp (TM.ESymbol TM.Accent [chr])]
|
||||
| otherwise = do
|
||||
baseExp <- baseToExp base
|
||||
let chr = case groupChr style of
|
||||
Just c -> c
|
||||
Nothing -> '\65080' -- default to underbrace
|
||||
return [TM.EUnder False baseExp (TM.ESymbol TM.Accent [chr])]
|
||||
oMathElemToExps (LowerLimit base limElems) = do
|
||||
baseExp <- baseToExp base
|
||||
lim <- concatMapM oMathElemToExps limElems >>= (return . TM.EGrouped)
|
||||
return [TM.EUnder True lim baseExp]
|
||||
oMathElemToExps (UpperLimit base limElems) = do
|
||||
baseExp <- baseToExp base
|
||||
lim <- concatMapM oMathElemToExps limElems >>= (return . TM.EGrouped)
|
||||
return [TM.EOver True lim baseExp]
|
||||
oMathElemToExps (Matrix bases) = do
|
||||
rows <- mapM (mapM (\b -> baseToExp' b)) bases
|
||||
return [TM.EArray [TM.AlignCenter] rows]
|
||||
oMathElemToExps (NAry style sub sup base) = do
|
||||
subExps <- concatMapM oMathElemToExps sub
|
||||
supExps <- concatMapM oMathElemToExps sup
|
||||
baseExp <- baseToExp base
|
||||
let opChar = case nAryChar style of
|
||||
Just c -> c
|
||||
-- default to integral
|
||||
Nothing -> '\8747'
|
||||
return [ TM.ESubsup
|
||||
(TM.ESymbol TM.Op [opChar])
|
||||
(TM.EGrouped subExps)
|
||||
(TM.EGrouped supExps)
|
||||
, baseExp]
|
||||
oMathElemToExps (Phantom base) =
|
||||
(\e -> return [TM.EPhantom e]) =<< baseToExp base
|
||||
oMathElemToExps (Radical degree base) = do
|
||||
degExps <- concatMapM oMathElemToExps degree
|
||||
baseExp <- baseToExp base
|
||||
return $ case degExps of
|
||||
[] -> [TM.ESqrt baseExp]
|
||||
ds -> [TM.ERoot (TM.EGrouped ds) baseExp]
|
||||
oMathElemToExps (PreSubSuper sub sup base) = do
|
||||
subExps <- concatMapM oMathElemToExps sub
|
||||
supExps <- concatMapM oMathElemToExps sup
|
||||
baseExp <- baseToExp base
|
||||
return [ TM.ESubsup
|
||||
(TM.EIdentifier "") (TM.EGrouped subExps) (TM.EGrouped supExps)
|
||||
, baseExp]
|
||||
oMathElemToExps (Sub base sub) = do
|
||||
baseExp <- baseToExp base
|
||||
subExps <- concatMapM oMathElemToExps sub
|
||||
return [TM.ESub baseExp (TM.EGrouped subExps)]
|
||||
oMathElemToExps (SubSuper base sub sup) = do
|
||||
baseExp <- baseToExp base
|
||||
subExps <- concatMapM oMathElemToExps sub
|
||||
supExps <- concatMapM oMathElemToExps sup
|
||||
return [TM.ESubsup baseExp (TM.EGrouped subExps) (TM.EGrouped supExps)]
|
||||
oMathElemToExps (Super base sup) = do
|
||||
baseExp <- baseToExp base
|
||||
supExps <- concatMapM oMathElemToExps sup
|
||||
return [TM.ESuper baseExp (TM.EGrouped supExps)]
|
||||
oMathElemToExps (OMathRun sty run@(Run _ _))
|
||||
| NoStyle <- oMathRunTextStyle sty =
|
||||
return $ [TM.EIdentifier $ runToString run]
|
||||
| Nothing <- oMathRunStyleToTextType sty =
|
||||
return $ [TM.EIdentifier $ runToString run]
|
||||
| Just textType <- oMathRunStyleToTextType sty =
|
||||
return $ if oMathLit sty
|
||||
then [TM.EText textType (runToString run)]
|
||||
else [TM.EStyled textType [TM.EIdentifier $ runToString run]]
|
||||
oMathElemToExps (OMathRun _ _) = return []
|
||||
|
||||
s <- liftM (intercalate " \\\\\n")(mapM rowString bases)
|
||||
return $ printf "\\begin{matrix}\n%s\n\\end{matrix}" s
|
||||
oMathElemToTexString (NAry style sub sup base) | Just c <- nAryChar style = do
|
||||
subString <- withDState (\s -> s{docxInTexSubscript = True}) $
|
||||
concatMapM oMathElemToTexString sub
|
||||
supString <- concatMapM oMathElemToTexString sup
|
||||
baseString <- baseToTexString base
|
||||
return $ case M.lookup c uniconvMap of
|
||||
Just s@('\\':_) -> printf "%s_{%s}^{%s}{%s}"
|
||||
s subString supString baseString
|
||||
_ -> printf "\\operatorname*{%s}_{%s}^{%s}{%s}"
|
||||
[c] subString supString baseString
|
||||
oMathElemToTexString (NAry _ sub sup base) = do
|
||||
subString <- concatMapM oMathElemToTexString sub
|
||||
supString <- concatMapM oMathElemToTexString sup
|
||||
baseString <- baseToTexString base
|
||||
return $ printf "\\int_{%s}^{%s}{%s}"
|
||||
subString supString baseString
|
||||
oMathElemToTexString (Phantom base) = do
|
||||
baseString <- baseToTexString base
|
||||
return $ printf "\\phantom{%s}" baseString
|
||||
oMathElemToTexString (Radical degree base) = do
|
||||
degString <- concatMapM oMathElemToTexString degree
|
||||
baseString <- baseToTexString base
|
||||
return $ case trim degString of
|
||||
"" -> printf "\\sqrt{%s}" baseString
|
||||
_ -> printf "\\sqrt[%s]{%s}" degString baseString
|
||||
oMathElemToTexString (PreSubSuper sub sup base) = do
|
||||
subString <- concatMapM oMathElemToTexString sub
|
||||
supString <- concatMapM oMathElemToTexString sup
|
||||
baseString <- baseToTexString base
|
||||
return $ printf "_{%s}^{%s}%s" subString supString baseString
|
||||
oMathElemToTexString (Sub base sub) = do
|
||||
baseString <- baseToTexString base
|
||||
subString <- concatMapM oMathElemToTexString sub
|
||||
return $ printf "%s_{%s}" baseString subString
|
||||
oMathElemToTexString (SubSuper base sub sup) = do
|
||||
baseString <- baseToTexString base
|
||||
subString <- concatMapM oMathElemToTexString sub
|
||||
supString <- concatMapM oMathElemToTexString sup
|
||||
return $ printf "%s_{%s}^{%s}" baseString subString supString
|
||||
oMathElemToTexString (Super base sup) = do
|
||||
baseString <- baseToTexString base
|
||||
supString <- concatMapM oMathElemToTexString sup
|
||||
return $ printf "%s^{%s}" baseString supString
|
||||
oMathElemToTexString (OMathRun _ run) = return $ stringToTex $ runToString run
|
||||
oMathRunStyleToTextType :: OMathRunStyle -> Maybe TM.TextType
|
||||
oMathRunStyleToTextType mrPr
|
||||
| Normal <- oMathRunTextStyle mrPr =
|
||||
Just $ TM.TextNormal
|
||||
| Styled scr sty <- oMathRunTextStyle mrPr
|
||||
,Just OBold <- sty
|
||||
, Just OSansSerif <- scr =
|
||||
Just $ TM.TextSansSerifBold
|
||||
| Styled scr sty <- oMathRunTextStyle mrPr
|
||||
, Just OBoldItalic <- sty
|
||||
, Just OSansSerif <- scr =
|
||||
Just $ TM.TextSansSerifBoldItalic
|
||||
| Styled scr sty <- oMathRunTextStyle mrPr
|
||||
, Just OBold <- sty
|
||||
, Just OScript <- scr =
|
||||
Just $ TM.TextBoldScript
|
||||
| Styled scr sty <- oMathRunTextStyle mrPr
|
||||
, Just OBold <- sty
|
||||
, Just OFraktur <- scr =
|
||||
Just $ TM.TextBoldFraktur
|
||||
| Styled scr sty <- oMathRunTextStyle mrPr
|
||||
, Just OItalic <- sty
|
||||
, Just OSansSerif <- scr =
|
||||
Just $ TM.TextSansSerifItalic
|
||||
| Styled _ sty <- oMathRunTextStyle mrPr
|
||||
, Just OBold <- sty =
|
||||
Just $ TM.TextBold
|
||||
| Styled _ sty <- oMathRunTextStyle mrPr
|
||||
, Just OItalic <- sty =
|
||||
Just $ TM.TextItalic
|
||||
| Styled scr _ <- oMathRunTextStyle mrPr
|
||||
, Just OMonospace <- scr =
|
||||
Just $ TM.TextMonospace
|
||||
| Styled scr _ <- oMathRunTextStyle mrPr
|
||||
, Just OSansSerif <- scr =
|
||||
Just $ TM.TextSansSerif
|
||||
| Styled scr _ <- oMathRunTextStyle mrPr
|
||||
, Just ODoubleStruck <- scr =
|
||||
Just $ TM.TextDoubleStruck
|
||||
| Styled scr _ <- oMathRunTextStyle mrPr
|
||||
, Just OScript <- scr =
|
||||
Just $ TM.TextDoubleStruck
|
||||
| Styled scr _ <- oMathRunTextStyle mrPr
|
||||
, Just OFraktur <- scr =
|
||||
Just $ TM.TextFraktur
|
||||
| Styled _ sty <- oMathRunTextStyle mrPr
|
||||
, Just OBoldItalic <- sty =
|
||||
Just $ TM.TextBoldItalic
|
||||
| otherwise = Nothing
|
||||
|
||||
baseToTexString :: Base -> DocxContext String
|
||||
baseToTexString (Base mathElems) =
|
||||
concatMapM oMathElemToTexString mathElems
|
||||
|
||||
|
||||
baseToExp :: Base -> DocxContext TM.Exp
|
||||
baseToExp (Base mathElems) =
|
||||
concatMapM oMathElemToExps mathElems >>= (return . TM.EGrouped)
|
||||
|
||||
-- an ungrouped version of baseToExp
|
||||
baseToExp' :: Base -> DocxContext [TM.Exp]
|
||||
baseToExp' (Base mathElems) =
|
||||
concatMapM oMathElemToExps mathElems
|
||||
|
||||
|
||||
isAnchorSpan :: Inline -> Bool
|
||||
|
|
@ -659,9 +693,10 @@ bodyPartToBlocks (Tbl cap _ look (r:rs)) = do
|
|||
|
||||
return [Table caption alignments widths hdrCells cells]
|
||||
bodyPartToBlocks (OMathPara _ maths) = do
|
||||
omaths <- mapM oMathToTexString maths
|
||||
return [Para $ map (\s -> Math DisplayMath s) omaths]
|
||||
|
||||
omaths <- mapM oMathToExps maths
|
||||
return [Para $
|
||||
map (\m -> Math DisplayMath (writeTeX m))
|
||||
omaths]
|
||||
|
||||
-- replace targets with generated anchors.
|
||||
rewriteLink :: Inline -> DocxContext Inline
|
||||
|
|
|
|||
|
|
@ -45,6 +45,10 @@ module Text.Pandoc.Readers.Docx.Parse ( Docx(..)
|
|||
, NAryStyle(..)
|
||||
, DelimStyle(..)
|
||||
, GroupStyle(..)
|
||||
, OMathRunStyle(..)
|
||||
, OMathRunTextStyle(..)
|
||||
, OMathTextScript(..)
|
||||
, OMathTextStyle(..)
|
||||
, Run(..)
|
||||
, RunElem(..)
|
||||
, Notes
|
||||
|
|
@ -93,13 +97,14 @@ maybeToD :: Maybe a -> D a
|
|||
maybeToD (Just a) = return a
|
||||
maybeToD Nothing = throwError DocxError
|
||||
|
||||
mapD :: (a -> D b) -> [a] -> D [b]
|
||||
mapD _ [] = return []
|
||||
mapD f (x:xs) = do
|
||||
y <- (f x >>= (\z -> return [z])) `catchError` (\_ -> return [])
|
||||
ys <- mapD f xs
|
||||
return $ y ++ ys
|
||||
concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
|
||||
concatMapM f xs = liftM concat (mapM f xs)
|
||||
|
||||
mapD :: (a -> D b) -> [a] -> D [b]
|
||||
mapD f xs =
|
||||
let handler x = (f x >>= (\y-> return [y])) `catchError` (\_ -> return [])
|
||||
in
|
||||
concatMapM handler xs
|
||||
|
||||
type NameSpaces = [(String, String)]
|
||||
|
||||
|
|
@ -128,6 +133,7 @@ type Level = (String, String, String, Maybe Integer)
|
|||
|
||||
data Relationship = Relationship (RelId, Target)
|
||||
deriving Show
|
||||
|
||||
data Notes = Notes NameSpaces
|
||||
(Maybe (M.Map String Element))
|
||||
(Maybe (M.Map String Element))
|
||||
|
|
@ -223,6 +229,30 @@ data NAryStyle = NAryStyle { nAryChar :: Maybe Char
|
|||
, nAryLimLoc :: LimLoc}
|
||||
deriving Show
|
||||
|
||||
data OMathRunStyle = OMathRunStyle { oMathLit :: Bool
|
||||
, oMathRunTextStyle :: OMathRunTextStyle }
|
||||
deriving Show
|
||||
|
||||
data OMathRunTextStyle = NoStyle
|
||||
| Normal
|
||||
| Styled { oMathScript :: Maybe OMathTextScript
|
||||
, oMathStyle :: Maybe OMathTextStyle }
|
||||
deriving Show
|
||||
|
||||
data OMathTextScript = ORoman
|
||||
| OScript
|
||||
| OFraktur
|
||||
| ODoubleStruck
|
||||
| OSansSerif
|
||||
| OMonospace
|
||||
deriving (Show, Eq)
|
||||
|
||||
data OMathTextStyle = OPlain
|
||||
| OBold
|
||||
| OItalic
|
||||
| OBoldItalic
|
||||
deriving (Show, Eq)
|
||||
|
||||
defaultNAryStyle :: NAryStyle
|
||||
defaultNAryStyle = NAryStyle { nAryChar = Nothing -- integral, in practice
|
||||
, nAryLimLoc = SubSup }
|
||||
|
|
@ -246,9 +276,6 @@ data GroupStyle = GroupStyle { groupChr :: Maybe Char
|
|||
defaultGroupStyle :: GroupStyle
|
||||
defaultGroupStyle = GroupStyle {groupChr = Nothing, groupPos = Nothing}
|
||||
|
||||
type OMathRunStyle = [String]
|
||||
|
||||
|
||||
data Run = Run RunStyle [RunElem]
|
||||
| Footnote [BodyPart]
|
||||
| Endnote [BodyPart]
|
||||
|
|
@ -596,6 +623,75 @@ elemToBase ns element | isElem ns "m" "e" element =
|
|||
(\es -> return $ Base es)
|
||||
elemToBase _ _ = throwError WrongElem
|
||||
|
||||
-- TODO: The right way to do this is to use the ampersand to break the
|
||||
-- text lines into multiple columns. That's tricky, though, and this
|
||||
-- will get us most of the way for the time being.
|
||||
filterAmpersand :: OMathElem -> OMathElem
|
||||
filterAmpersand (OMathRun mrPr (Run wrPr elems)) =
|
||||
let f (TextRun s) = TextRun $ filter ('&' /=) s
|
||||
f re = re
|
||||
in
|
||||
OMathRun mrPr $ Run wrPr (map f elems)
|
||||
filterAmpersand e = e
|
||||
|
||||
elemToBaseNoAmpersand :: NameSpaces -> Element -> D Base
|
||||
elemToBaseNoAmpersand ns element | isElem ns "m" "e" element =
|
||||
mapD
|
||||
(\e -> (elemToMathElem ns e >>= (return . filterAmpersand)))
|
||||
(elChildren element) >>=
|
||||
(\es -> return $ Base es)
|
||||
elemToBaseNoAmpersand _ _ = throwError WrongElem
|
||||
|
||||
|
||||
elemToOMathRunStyle :: NameSpaces -> Element -> OMathRunStyle
|
||||
elemToOMathRunStyle ns element =
|
||||
let lit =
|
||||
case
|
||||
findChild (elemName ns "m" "lit") element >>=
|
||||
findAttr (elemName ns "m" "val")
|
||||
of
|
||||
Just "on" -> True
|
||||
_ -> False
|
||||
in
|
||||
OMathRunStyle { oMathLit = lit
|
||||
, oMathRunTextStyle = (elemToOMathRunTextStyle ns element)
|
||||
}
|
||||
|
||||
elemToOMathRunTextStyle :: NameSpaces -> Element -> OMathRunTextStyle
|
||||
elemToOMathRunTextStyle ns element
|
||||
| Just mrPr <- findChild (elemName ns "m" "rPr") element
|
||||
, Just _ <- findChild (elemName ns "m" "nor") mrPr =
|
||||
Normal
|
||||
| Just mrPr <- findChild (elemName ns "m" "rPr") element =
|
||||
let scr =
|
||||
case
|
||||
findChild (elemName ns "m" "scr") mrPr >>=
|
||||
findAttr (elemName ns "m" "val")
|
||||
of
|
||||
Just "roman" -> Just ORoman
|
||||
Just "script" -> Just OScript
|
||||
Just "fraktur" -> Just OFraktur
|
||||
Just "double-struck" -> Just ODoubleStruck
|
||||
Just "sans-serif" -> Just OSansSerif
|
||||
Just "monospace" -> Just OMonospace
|
||||
_ -> Nothing
|
||||
|
||||
sty =
|
||||
case
|
||||
findChild (elemName ns "m" "sty") mrPr >>=
|
||||
findAttr (elemName ns "m" "val")
|
||||
of
|
||||
Just "p" -> Just OPlain
|
||||
Just "b" -> Just OBold
|
||||
Just "i" -> Just OItalic
|
||||
Just "bi" -> Just OBoldItalic
|
||||
_ -> Nothing
|
||||
in
|
||||
Styled { oMathScript = scr, oMathStyle = sty }
|
||||
| otherwise = NoStyle
|
||||
|
||||
|
||||
|
||||
elemToNAryStyle :: NameSpaces -> Element -> NAryStyle
|
||||
elemToNAryStyle ns element
|
||||
| Just narypr <- findChild (QName "naryPr" (lookup "m" ns) (Just "m")) element =
|
||||
|
|
@ -618,13 +714,13 @@ elemToDelimStyle ns element
|
|||
| Just dPr <- findChild (QName "dPr" (lookup "m" ns) (Just "m")) element =
|
||||
let begChr = findChild (QName "begChr" (lookup "m" ns) (Just "m")) dPr >>=
|
||||
findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
|
||||
(\c -> if null c then Nothing else (Just $ head c))
|
||||
(\c -> if null c then (Just ' ') else (Just $ head c))
|
||||
sepChr = findChild (QName "sepChr" (lookup "m" ns) (Just "m")) dPr >>=
|
||||
findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
|
||||
(\c -> if null c then Nothing else (Just $ head c))
|
||||
(\c -> if null c then (Just ' ') else (Just $ head c))
|
||||
endChr = findChild (QName "endChr" (lookup "m" ns) (Just "m")) dPr >>=
|
||||
findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
|
||||
(\c -> if null c then Nothing else (Just $ head c))
|
||||
(\c -> if null c then (Just ' ') else (Just $ head c))
|
||||
in
|
||||
DelimStyle { delimBegChar = begChr
|
||||
, delimSepChar = sepChr
|
||||
|
|
@ -647,9 +743,9 @@ elemToGroupStyle _ _ = defaultGroupStyle
|
|||
elemToMathElem :: NameSpaces -> Element -> D OMathElem
|
||||
elemToMathElem ns element | isElem ns "m" "acc" element = do
|
||||
let accChar =
|
||||
findChild (QName "accPr" (lookup "m" ns) (Just "m")) element >>=
|
||||
findChild (QName "chr" (lookup "m" ns) (Just "m")) >>=
|
||||
findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=
|
||||
findChild (elemName ns "m" "accPr") element >>=
|
||||
findChild (elemName ns "m" "chr") >>=
|
||||
findAttr (elemName ns "m" "val") >>=
|
||||
Just . head
|
||||
accPr = AccentStyle { accentChar = accChar}
|
||||
base <-(maybeToD $ findChild (elemName ns "m" "e") element) >>=
|
||||
|
|
@ -681,7 +777,7 @@ elemToMathElem ns element | isElem ns "m" "d" element =
|
|||
mapD (elemToBase ns) (elChildren element) >>=
|
||||
(\es -> return $ Delimiter style es)
|
||||
elemToMathElem ns element | isElem ns "m" "eqArr" element =
|
||||
mapD (elemToBase ns) (elChildren element) >>=
|
||||
mapD (elemToBaseNoAmpersand ns) (elChildren element) >>=
|
||||
(\es -> return $ EquationArray es)
|
||||
elemToMathElem ns element | isElem ns "m" "f" element = do
|
||||
num <- maybeToD $ findChild (elemName ns "m" "num") element
|
||||
|
|
@ -763,12 +859,12 @@ elemToMathElem ns element | isElem ns "m" "sSup" element = do
|
|||
elemToBase ns
|
||||
sup <- maybeToD (findChild (elemName ns "m" "sup") element) >>=
|
||||
(\e -> mapD (elemToMathElem ns) (elChildren e))
|
||||
return $ Sub base sup
|
||||
return $ Super base sup
|
||||
elemToMathElem ns element | isElem ns "m" "r" element = do
|
||||
let style = [] -- placeholder
|
||||
rstyle = elemToRunStyle ns element
|
||||
let mrPr = elemToOMathRunStyle ns element
|
||||
wrPr = elemToRunStyle ns element
|
||||
relems <- elemToRunElems ns element
|
||||
return $ OMathRun style $ Run rstyle relems
|
||||
return $ OMathRun mrPr $ Run wrPr relems
|
||||
elemToMathElem _ _ = throwError WrongElem
|
||||
|
||||
lookupRelationship :: RelId -> [Relationship] -> Maybe Target
|
||||
|
|
@ -832,6 +928,9 @@ elemToParPart ns element
|
|||
return $ case lookupRelationship relId rels of
|
||||
Just target -> ExternalHyperLink target runs
|
||||
Nothing -> ExternalHyperLink "" runs
|
||||
elemToParPart ns element
|
||||
| isElem ns "m" "oMath" element =
|
||||
elemToMath ns element >>= (return . PlainOMath)
|
||||
elemToParPart _ _ = throwError WrongElem
|
||||
|
||||
lookupFootnote :: String -> Notes -> Maybe Element
|
||||
|
|
@ -908,7 +1007,9 @@ elemToRunStyle _ _ = defaultRunStyle
|
|||
|
||||
elemToRunElem :: NameSpaces -> Element -> D RunElem
|
||||
elemToRunElem ns element
|
||||
| isElem ns "w" "t" element || isElem ns "w" "delText" element =
|
||||
| isElem ns "w" "t" element
|
||||
|| isElem ns "w" "delText" element
|
||||
|| isElem ns "m" "t" element =
|
||||
return $ TextRun $ strContent element
|
||||
| isElem ns "w" "br" element = return LnBrk
|
||||
| isElem ns "w" "tab" element = return Tab
|
||||
|
|
@ -916,7 +1017,9 @@ elemToRunElem ns element
|
|||
|
||||
elemToRunElems :: NameSpaces -> Element -> D [RunElem]
|
||||
elemToRunElems ns element
|
||||
| isElem ns "w" "r" element = mapD (elemToRunElem ns) (elChildren element)
|
||||
| isElem ns "w" "r" element
|
||||
|| isElem ns "m" "r" element =
|
||||
mapD (elemToRunElem ns) (elChildren element)
|
||||
elemToRunElems _ _ = throwError WrongElem
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue