diff options
| -rw-r--r-- | src/Text/Pandoc/Readers/Docx.hs | 176 |
1 files changed, 172 insertions, 4 deletions
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs index 61c17156e..9f73f2e7f 100644 --- a/src/Text/Pandoc/Readers/Docx.hs +++ b/src/Text/Pandoc/Readers/Docx.hs @@ -84,9 +84,10 @@ 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 Data.Maybe (mapMaybe) -import Data.List (delete, isPrefixOf, (\\)) +import Data.Maybe (mapMaybe, fromMaybe) +import Data.List (delete, isPrefixOf, (\\), intercalate) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as B import Data.ByteString.Base64 (encode) @@ -94,6 +95,7 @@ import System.FilePath (combine) import qualified Data.Map as M import Control.Monad.Reader import Control.Monad.State +import Text.Printf (printf) readDocx :: ReaderOptions -> B.ByteString @@ -103,7 +105,8 @@ readDocx opts bytes = Just docx -> Pandoc nullMeta (docxToBlocks opts docx) Nothing -> error $ "couldn't parse docx file" -data DState = DState { docxAnchorMap :: M.Map String String } +data DState = DState { docxAnchorMap :: M.Map String String + , docxInTexSubscript :: Bool } data DEnv = DEnv { docxOptions :: ReaderOptions , docxDocument :: Docx} @@ -115,6 +118,14 @@ updateDState f = do st <- get put $ f st +withDState :: DState -> DocxContext a -> DocxContext a +withDState ds dctx = do + ds' <- get + updateDState (\_ -> ds) + dctx' <- dctx + put ds' + return dctx' + evalDocxContext :: DocxContext a -> DEnv -> DState -> a evalDocxContext ctx env st = evalState (runReaderT ctx env) st @@ -318,6 +329,158 @@ parPartToInlines (ExternalHyperLink relid runs) = do [Link rs (target, "")] Nothing -> [Link rs ("", "")] +parPartToInlines (PlainOMath omath) = do + s <- oMathToTexString omath + return [Math InlineMath s] + +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 + 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) + 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 | "\\rightarrow" `isPrefixOf` s = + "\\to" ++ (arrowToTo $ drop (length "\\rightarrow") 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 | "\\rightarrow" `isPrefixOf` s = + "\\to" ++ (arrowToTo $ drop (length "\\rightarrow") 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) + + 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 + ds <- gets (\s -> s{docxInTexSubscript = True}) + subString <- withDState ds $ 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 (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 +oMathElemToTexString _ = return "[NOT IMPLEMENTED]" + +baseToTexString :: Base -> DocxContext String +baseToTexString (Base mathElems) = + concatMapM oMathElemToTexString mathElems + isAnchorSpan :: Inline -> Bool isAnchorSpan (Span (ident, classes, kvs) ils) = @@ -445,6 +608,10 @@ bodyPartToBlocks (Tbl cap _ look (r:rs)) = do widths = replicate size 0 :: [Double] return [Table caption alignments widths hdrCells cells] +bodyPartToBlocks (OMathPara _ maths) = do + omaths <- mapM oMathToTexString maths + return [Para $ map (\s -> Math DisplayMath s) omaths] + -- replace targets with generated anchors. rewriteLink :: Inline -> DocxContext Inline @@ -480,7 +647,8 @@ bodyToBlocks (Body bps) = do docxToBlocks :: ReaderOptions -> Docx -> [Block] docxToBlocks opts d@(Docx (Document _ body) _ _ _ _) = - let dState = DState { docxAnchorMap = M.empty } + let dState = DState { docxAnchorMap = M.empty + , docxInTexSubscript = False} dEnv = DEnv { docxOptions = opts , docxDocument = d} in |