summaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
authorJesse Rosenthal <jrosenthal@jhu.edu>2014-06-24 10:34:07 -0400
committerJesse Rosenthal <jrosenthal@jhu.edu>2014-06-24 10:34:07 -0400
commitbebea5e936d6c3c90b977a1b8f69bb3a290d30dc (patch)
tree801df083781ccd821bf24feae092a8a02854dd7e /src/Text
parent21295c5ab5567126c3112b9417f68c76b4f6debf (diff)
Docx reader: pass code tests.
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Readers/Docx.hs80
1 files changed, 47 insertions, 33 deletions
diff --git a/src/Text/Pandoc/Readers/Docx.hs b/src/Text/Pandoc/Readers/Docx.hs
index ffe7f5a92..5f62d0b21 100644
--- a/src/Text/Pandoc/Readers/Docx.hs
+++ b/src/Text/Pandoc/Readers/Docx.hs
@@ -84,7 +84,7 @@ import Text.Pandoc.Readers.Docx.Parse
import Text.Pandoc.Readers.Docx.Lists
import Text.Pandoc.Readers.Docx.Reducible
import Data.Maybe (mapMaybe, isJust, fromJust)
-import Data.List (delete, isPrefixOf, (\\), intersect)
+import Data.List (delete, isPrefixOf, (\\))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as B
import Data.ByteString.Base64 (encode)
@@ -99,7 +99,7 @@ readDocx opts bytes =
Nothing -> error $ "couldn't parse docx file"
spansToKeep :: [String]
-spansToKeep = ["list-item", "Definition", "DefinitionTerm"] ++ codeSpans
+spansToKeep = ["list-item", "Definition", "DefinitionTerm"]
-- This is empty, but we put it in for future-proofing.
@@ -108,20 +108,28 @@ divsToKeep = []
runStyleToContainers :: RunStyle -> [Container Inline]
runStyleToContainers rPr =
- let formatters = mapMaybe id
- [ if isBold rPr then (Just Strong) else Nothing
- , if isItalic rPr then (Just Emph) else Nothing
- , if isSmallCaps rPr then (Just SmallCaps) else Nothing
- , if isStrike rPr then (Just Strikeout) else Nothing
- , if isSuperScript rPr then (Just Superscript) else Nothing
- , if isSubScript rPr then (Just Subscript) else Nothing
- , rStyle rPr >>=
- (\s -> if s `elem` spansToKeep then Just s else Nothing) >>=
- (\s -> Just $ Span ("", [s], []))
- , underline rPr >>= (\f -> Just $ Span ("", [], [("underline", f)]))
+ let spanClassToContainers :: String -> [Container Inline]
+ spanClassToContainers s | s `elem` codeSpans =
+ [Container $ (\ils -> Code ("", [], []) (concatMap ilToCode ils))]
+ spanClassToContainers s | s `elem` spansToKeep =
+ [Container $ Span ("", [s], [])]
+ spanClassToContainers _ = []
+
+ classContainers = case rStyle rPr of
+ Nothing -> []
+ Just s -> spanClassToContainers s
+
+ formatters = map Container $ mapMaybe id
+ [ if isBold rPr then (Just Strong) else Nothing
+ , if isItalic rPr then (Just Emph) else Nothing
+ , if isSmallCaps rPr then (Just SmallCaps) else Nothing
+ , if isStrike rPr then (Just Strikeout) else Nothing
+ , if isSuperScript rPr then (Just Superscript) else Nothing
+ , if isSubScript rPr then (Just Subscript) else Nothing
+ , underline rPr >>= (\f -> Just $ Span ("", [], [("underline", f)]))
]
in
- map Container formatters
+ classContainers ++ formatters
divAttrToContainers :: [String] -> [(String, String)] -> [Container Block]
@@ -132,7 +140,9 @@ divAttrToContainers (c:cs) _ | isJust (isHeaderClass c) =
[(Container $ \blks ->
Header n ("", delete ("Heading" ++ show n) cs, []) (blksToInlines blks))]
divAttrToContainers (c:_) _ | c `elem` codeDivs =
- [Container $ \blks -> CodeBlock ("", [], []) (concatMap blkToCode blks)]
+ -- This is a bit of a cludge. We make the codeblock from the raw
+ -- parparts in bodyPartToBlocks. But we need something to match against.
+ [Container $ \_ -> CodeBlock ("", [], []) ""]
divAttrToContainers (c:cs) kvs | c `elem` listParagraphDivs =
let kvs' = filter (\(k,_) -> k /= "indent") kvs
in
@@ -183,18 +193,23 @@ runElemToString (Tab) = ['\t']
runElemsToString :: [RunElem] -> String
runElemsToString = concatMap runElemToString
+runToString :: Run -> String
+runToString (Run _ runElems) = runElemsToString runElems
+runToString _ = ""
+
+parPartToString :: ParPart -> String
+parPartToString (PlainRun run) = runToString run
+parPartToString (InternalHyperLink _ runs) = concatMap runToString runs
+parPartToString (ExternalHyperLink _ runs) = concatMap runToString runs
+parPartToString _ = ""
+
inlineCodeContainer :: Container Inline -> Bool
inlineCodeContainer (Container f) = case f [] of
- Span (_, classes, _) _ -> (not . null) (classes `intersect` codeSpans)
+ Code _ "" -> True
_ -> False
inlineCodeContainer _ = False
--- blockCodeContainer :: Container Block -> Bool
--- blockCodeContainer (Container f) = case f [] of
--- Div (ident, classes, kvs) _ -> (not . null) (classes `intersect` codeDivs)
--- _ -> False
--- blockCodeContainer _ = False
runToInlines :: ReaderOptions -> Docx -> Run -> [Inline]
runToInlines _ _ (Run rs runElems)
@@ -274,7 +289,16 @@ cellToBlocks opts docx (Cell bps) = concatMap (bodyPartToBlocks opts docx) bps
rowToBlocksList :: ReaderOptions -> Docx -> Row -> [[Block]]
rowToBlocksList opts docx (Row cells) = map (cellToBlocks opts docx) cells
+blockCodeContainer :: Container Block -> Bool
+blockCodeContainer (Container f) = case f [] of
+ CodeBlock _ _ -> True
+ _ -> False
+blockCodeContainer _ = False
+
bodyPartToBlocks :: ReaderOptions -> Docx -> BodyPart -> [Block]
+bodyPartToBlocks _ _ (Paragraph pPr parparts)
+ | any blockCodeContainer (parStyleToContainers pPr) =
+ [CodeBlock ("", [], []) (concatMap parPartToString parparts)]
bodyPartToBlocks opts docx (Paragraph pPr parparts) =
case parPartsToInlines opts docx parparts of
[] ->
@@ -358,7 +382,8 @@ docxToBlocks opts d@(Docx (Document _ body) _ _ _ _) = bodyToBlocks opts d body
ilToCode :: Inline -> String
ilToCode (Str s) = s
-ilToCode _ = ""
+ilToCode Space = " "
+ilToCode _ = ""
isHeaderClass :: String -> Maybe Int
@@ -369,18 +394,7 @@ isHeaderClass s | "Heading" `isPrefixOf` s =
_ -> Nothing
isHeaderClass _ = Nothing
-
blksToInlines :: [Block] -> [Inline]
blksToInlines (Para ils : _) = ils
blksToInlines (Plain ils : _) = ils
blksToInlines _ = []
-
-
-blkToCode :: Block -> String
-blkToCode (Para []) = ""
-blkToCode (Para ((Code _ s):ils)) = s ++ (blkToCode (Para ils))
-blkToCode (Para ((Span (_, classes, _) ils'): ils))
- | (not . null) (codeSpans `intersect` classes) =
- (init $ unlines $ map ilToCode ils') ++ (blkToCode (Para ils))
-blkToCode _ = ""
-