|
Packit |
dda32d |
{-
|
|
Packit |
dda32d |
Copyright (C) 2014-2017 Jesse Rosenthal <jrosenthal@jhu.edu>
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
This program is free software; you can redistribute it and/or modify
|
|
Packit |
dda32d |
it under the terms of the GNU General Public License as published by
|
|
Packit |
dda32d |
the Free Software Foundation; either version 2 of the License, or
|
|
Packit |
dda32d |
(at your option) any later version.
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
This program is distributed in the hope that it will be useful,
|
|
Packit |
dda32d |
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
Packit |
dda32d |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
Packit |
dda32d |
GNU General Public License for more details.
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
You should have received a copy of the GNU General Public License
|
|
Packit |
dda32d |
along with this program; if not, write to the Free Software
|
|
Packit |
dda32d |
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
Packit |
dda32d |
-}
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
{- |
|
|
Packit |
dda32d |
Module : Text.Pandoc.Readers.Docx.Lists
|
|
Packit |
dda32d |
Copyright : Copyright (C) 2014-2017 Jesse Rosenthal
|
|
Packit |
dda32d |
License : GNU GPL, version 2 or above
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu>
|
|
Packit |
dda32d |
Stability : alpha
|
|
Packit |
dda32d |
Portability : portable
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
Functions for converting flat docx paragraphs into nested lists.
|
|
Packit |
dda32d |
-}
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
module Text.Pandoc.Readers.Docx.Lists ( blocksToBullets
|
|
Packit |
dda32d |
, blocksToDefinitions
|
|
Packit |
dda32d |
, listParagraphDivs
|
|
Packit |
dda32d |
) where
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
import Data.List
|
|
Packit |
dda32d |
import Data.Maybe
|
|
Packit |
dda32d |
import Text.Pandoc.Generic (bottomUp)
|
|
Packit |
dda32d |
import Text.Pandoc.JSON
|
|
Packit |
dda32d |
import Text.Pandoc.Shared (trim)
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
isListItem :: Block -> Bool
|
|
Packit |
dda32d |
isListItem (Div (_, classes, _) _) | "list-item" `elem` classes = True
|
|
Packit |
dda32d |
isListItem _ = False
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
getLevel :: Block -> Maybe Integer
|
|
Packit |
dda32d |
getLevel (Div (_, _, kvs) _) = fmap read $ lookup "level" kvs
|
|
Packit |
dda32d |
getLevel _ = Nothing
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
getLevelN :: Block -> Integer
|
|
Packit |
dda32d |
getLevelN b = fromMaybe (-1) (getLevel b)
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
getNumId :: Block -> Maybe Integer
|
|
Packit |
dda32d |
getNumId (Div (_, _, kvs) _) = fmap read $ lookup "num-id" kvs
|
|
Packit |
dda32d |
getNumId _ = Nothing
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
getNumIdN :: Block -> Integer
|
|
Packit |
dda32d |
getNumIdN b = fromMaybe (-1) (getNumId b)
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
getText :: Block -> Maybe String
|
|
Packit |
dda32d |
getText (Div (_, _, kvs) _) = lookup "text" kvs
|
|
Packit |
dda32d |
getText _ = Nothing
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
data ListType = Itemized | Enumerated ListAttributes
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
listStyleMap :: [(String, ListNumberStyle)]
|
|
Packit |
dda32d |
listStyleMap = [("upperLetter", UpperAlpha),
|
|
Packit |
dda32d |
("lowerLetter", LowerAlpha),
|
|
Packit |
dda32d |
("upperRoman", UpperRoman),
|
|
Packit |
dda32d |
("lowerRoman", LowerRoman),
|
|
Packit |
dda32d |
("decimal", Decimal)]
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
listDelimMap :: [(String, ListNumberDelim)]
|
|
Packit |
dda32d |
listDelimMap = [("%1)", OneParen),
|
|
Packit |
dda32d |
("(%1)", TwoParens),
|
|
Packit |
dda32d |
("%1.", Period)]
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
getListType :: Block -> Maybe ListType
|
|
Packit |
dda32d |
getListType b@(Div (_, _, kvs) _) | isListItem b =
|
|
Packit |
dda32d |
let
|
|
Packit |
dda32d |
start = lookup "start" kvs
|
|
Packit |
dda32d |
frmt = lookup "format" kvs
|
|
Packit |
dda32d |
txt = lookup "text" kvs
|
|
Packit |
dda32d |
in
|
|
Packit |
dda32d |
case frmt of
|
|
Packit |
dda32d |
Just "bullet" -> Just Itemized
|
|
Packit |
dda32d |
Just f ->
|
|
Packit |
dda32d |
case txt of
|
|
Packit |
dda32d |
Just t -> Just $ Enumerated (
|
|
Packit |
dda32d |
read (fromMaybe "1" start) :: Int,
|
|
Packit |
dda32d |
fromMaybe DefaultStyle (lookup f listStyleMap),
|
|
Packit |
dda32d |
fromMaybe DefaultDelim (lookup t listDelimMap))
|
|
Packit |
dda32d |
Nothing -> Nothing
|
|
Packit |
dda32d |
_ -> Nothing
|
|
Packit |
dda32d |
getListType _ = Nothing
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
listParagraphDivs :: [String]
|
|
Packit |
dda32d |
listParagraphDivs = ["ListParagraph"]
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
-- This is a first stab at going through and attaching meaning to list
|
|
Packit |
dda32d |
-- paragraphs, without an item marker, following a list item. We
|
|
Packit |
dda32d |
-- assume that these are paragraphs in the same item.
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
handleListParagraphs :: [Block] -> [Block]
|
|
Packit |
dda32d |
handleListParagraphs [] = []
|
|
Packit |
dda32d |
handleListParagraphs (
|
|
Packit |
dda32d |
Div attr1@(_, classes1, _) blks1 :
|
|
Packit |
dda32d |
Div (ident2, classes2, kvs2) blks2 :
|
|
Packit |
dda32d |
blks
|
|
Packit |
dda32d |
) | "list-item" `elem` classes1 &&
|
|
Packit |
dda32d |
notElem "list-item" classes2 &&
|
|
Packit |
dda32d |
(not . null) (listParagraphDivs `intersect` classes2) =
|
|
Packit |
dda32d |
-- We don't want to keep this indent.
|
|
Packit |
dda32d |
let newDiv2 =
|
|
Packit |
dda32d |
Div (ident2, classes2, filter (\kv -> fst kv /= "indent") kvs2) blks2
|
|
Packit |
dda32d |
in
|
|
Packit |
dda32d |
handleListParagraphs (Div attr1 (blks1 ++ [newDiv2]) : blks)
|
|
Packit |
dda32d |
handleListParagraphs (blk:blks) = blk : handleListParagraphs blks
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
separateBlocks' :: Block -> [[Block]] -> [[Block]]
|
|
Packit |
dda32d |
separateBlocks' blk [[]] = [[blk]]
|
|
Packit |
dda32d |
separateBlocks' b@(BulletList _) acc = init acc ++ [last acc ++ [b]]
|
|
Packit |
dda32d |
separateBlocks' b@(OrderedList _ _) acc = init acc ++ [last acc ++ [b]]
|
|
Packit |
dda32d |
-- The following is for the invisible bullet lists. This is how
|
|
Packit |
dda32d |
-- pandoc-generated ooxml does multiparagraph item lists.
|
|
Packit |
dda32d |
separateBlocks' b acc | fmap trim (getText b) == Just "" =
|
|
Packit |
dda32d |
init acc ++ [last acc ++ [b]]
|
|
Packit |
dda32d |
separateBlocks' b acc = acc ++ [[b]]
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
separateBlocks :: [Block] -> [[Block]]
|
|
Packit |
dda32d |
separateBlocks blks = foldr separateBlocks' [[]] (reverse blks)
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
flatToBullets' :: Integer -> [Block] -> [Block]
|
|
Packit |
dda32d |
flatToBullets' _ [] = []
|
|
Packit |
dda32d |
flatToBullets' num xs@(b : elems)
|
|
Packit |
dda32d |
| getLevelN b == num = b : flatToBullets' num elems
|
|
Packit |
dda32d |
| otherwise =
|
|
Packit |
dda32d |
let bNumId = getNumIdN b
|
|
Packit |
dda32d |
bLevel = getLevelN b
|
|
Packit |
dda32d |
(children, remaining) =
|
|
Packit |
dda32d |
span
|
|
Packit |
dda32d |
(\b' ->
|
|
Packit |
dda32d |
(getLevelN b') > bLevel ||
|
|
Packit |
dda32d |
((getLevelN b') == bLevel && (getNumIdN b') == bNumId))
|
|
Packit |
dda32d |
xs
|
|
Packit |
dda32d |
in
|
|
Packit |
dda32d |
case getListType b of
|
|
Packit |
dda32d |
Just (Enumerated attr) ->
|
|
Packit |
dda32d |
OrderedList attr (separateBlocks $ flatToBullets' bLevel children) :
|
|
Packit |
dda32d |
flatToBullets' num remaining
|
|
Packit |
dda32d |
_ ->
|
|
Packit |
dda32d |
BulletList (separateBlocks $ flatToBullets' bLevel children) :
|
|
Packit |
dda32d |
flatToBullets' num remaining
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
flatToBullets :: [Block] -> [Block]
|
|
Packit |
dda32d |
flatToBullets elems = flatToBullets' (-1) elems
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
singleItemHeaderToHeader :: Block -> Block
|
|
Packit |
dda32d |
singleItemHeaderToHeader (OrderedList _ [[h@Header{}]]) = h
|
|
Packit |
dda32d |
singleItemHeaderToHeader blk = blk
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
blocksToBullets :: [Block] -> [Block]
|
|
Packit |
dda32d |
blocksToBullets blks =
|
|
Packit |
dda32d |
map singleItemHeaderToHeader $
|
|
Packit |
dda32d |
bottomUp removeListDivs $flatToBullets (handleListParagraphs blks)
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
plainParaInlines :: Block -> [Inline]
|
|
Packit |
dda32d |
plainParaInlines (Plain ils) = ils
|
|
Packit |
dda32d |
plainParaInlines (Para ils) = ils
|
|
Packit |
dda32d |
plainParaInlines _ = []
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
blocksToDefinitions' :: [([Inline], [[Block]])] -> [Block] -> [Block] -> [Block]
|
|
Packit |
dda32d |
blocksToDefinitions' [] acc [] = reverse acc
|
|
Packit |
dda32d |
blocksToDefinitions' defAcc acc [] =
|
|
Packit |
dda32d |
reverse $ DefinitionList (reverse defAcc) : acc
|
|
Packit |
dda32d |
blocksToDefinitions' defAcc acc
|
|
Packit |
dda32d |
(Div (_, classes1, _) blks1 : Div (ident2, classes2, kvs2) blks2 : blks)
|
|
Packit |
dda32d |
| "DefinitionTerm" `elem` classes1 && "Definition" `elem` classes2 =
|
|
Packit |
dda32d |
let remainingAttr2 = (ident2, delete "Definition" classes2, kvs2)
|
|
Packit |
dda32d |
pair = if remainingAttr2 == ("", [], []) then (concatMap plainParaInlines blks1, [blks2]) else (concatMap plainParaInlines blks1, [[Div remainingAttr2 blks2]])
|
|
Packit |
dda32d |
in
|
|
Packit |
dda32d |
blocksToDefinitions' (pair : defAcc) acc blks
|
|
Packit |
dda32d |
blocksToDefinitions' defAcc acc
|
|
Packit |
dda32d |
(Div (ident2, classes2, kvs2) blks2 : blks)
|
|
Packit |
dda32d |
| (not . null) defAcc && "Definition" `elem` classes2 =
|
|
Packit |
dda32d |
let remainingAttr2 = (ident2, delete "Definition" classes2, kvs2)
|
|
Packit |
dda32d |
defItems2 = case remainingAttr2 == ("", [], []) of
|
|
Packit |
dda32d |
True -> blks2
|
|
Packit |
dda32d |
False -> [Div remainingAttr2 blks2]
|
|
Packit |
dda32d |
((defTerm, defItems):defs) = defAcc
|
|
Packit |
dda32d |
defAcc' = case null defItems of
|
|
Packit |
dda32d |
True -> (defTerm, [defItems2]) : defs
|
|
Packit |
dda32d |
False -> (defTerm, init defItems ++ [last defItems ++ defItems2]) : defs
|
|
Packit |
dda32d |
in
|
|
Packit |
dda32d |
blocksToDefinitions' defAcc' acc blks
|
|
Packit |
dda32d |
blocksToDefinitions' [] acc (b:blks) =
|
|
Packit |
dda32d |
blocksToDefinitions' [] (b:acc) blks
|
|
Packit |
dda32d |
blocksToDefinitions' defAcc acc (b:blks) =
|
|
Packit |
dda32d |
blocksToDefinitions' [] (b : DefinitionList (reverse defAcc) : acc) blks
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
removeListDivs' :: Block -> [Block]
|
|
Packit |
dda32d |
removeListDivs' (Div (ident, classes, kvs) blks)
|
|
Packit |
dda32d |
| "list-item" `elem` classes =
|
|
Packit |
dda32d |
case delete "list-item" classes of
|
|
Packit |
dda32d |
[] -> blks
|
|
Packit |
dda32d |
classes' -> [Div (ident, classes', kvs) blks]
|
|
Packit |
dda32d |
removeListDivs' (Div (ident, classes, kvs) blks)
|
|
Packit |
dda32d |
| not $ null $ listParagraphDivs `intersect` classes =
|
|
Packit |
dda32d |
case classes \\ listParagraphDivs of
|
|
Packit |
dda32d |
[] -> blks
|
|
Packit |
dda32d |
classes' -> [Div (ident, classes', kvs) blks]
|
|
Packit |
dda32d |
removeListDivs' blk = [blk]
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
removeListDivs :: [Block] -> [Block]
|
|
Packit |
dda32d |
removeListDivs = concatMap removeListDivs'
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
|
|
Packit |
dda32d |
blocksToDefinitions :: [Block] -> [Block]
|
|
Packit |
dda32d |
blocksToDefinitions = blocksToDefinitions' [] []
|