{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Readers.Docx.Lists
   Copyright   : Copyright (C) 2014-2020 Jesse Rosenthal
   License     : GNU GPL, version 2 or above

   Maintainer  : Jesse Rosenthal <jrosenthal@jhu.edu>
   Stability   : alpha
   Portability : portable

Functions for converting flat docx paragraphs into nested lists.
-}

module Text.Pandoc.Readers.Docx.Lists ( blocksToBullets
                                      , blocksToDefinitions
                                      , listParagraphDivs
                                      , listParagraphStyles
                                      ) where

import Data.List
import Data.Maybe
import Data.String (fromString)
import qualified Data.Text as T
import Text.Pandoc.Generic (bottomUp)
import Text.Pandoc.JSON
import Text.Pandoc.Readers.Docx.Parse (ParaStyleName)
import Text.Pandoc.Shared (trim, safeRead)

isListItem :: Block -> Bool
isListItem :: Block -> Bool
isListItem (Div (Text
_, [Text]
classes, [(Text, Text)]
_) [Block]
_) | Text
"list-item" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes = Bool
True
isListItem Block
_                       = Bool
False

getLevel :: Block -> Maybe Integer
getLevel :: Block -> Maybe Integer
getLevel (Div (Text
_, [Text]
_, [(Text, Text)]
kvs) [Block]
_) =  forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"level" [(Text, Text)]
kvs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
getLevel Block
_                   = forall a. Maybe a
Nothing

getLevelN :: Block -> Integer
getLevelN :: Block -> Integer
getLevelN Block
b = forall a. a -> Maybe a -> a
fromMaybe (-Integer
1) (Block -> Maybe Integer
getLevel Block
b)

getNumId :: Block -> Maybe Integer
getNumId :: Block -> Maybe Integer
getNumId (Div (Text
_, [Text]
_, [(Text, Text)]
kvs) [Block]
_) =  forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"num-id" [(Text, Text)]
kvs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
getNumId Block
_                   = forall a. Maybe a
Nothing

getNumIdN :: Block -> Integer
getNumIdN :: Block -> Integer
getNumIdN Block
b = forall a. a -> Maybe a -> a
fromMaybe (-Integer
1) (Block -> Maybe Integer
getNumId Block
b)

getText :: Block -> Maybe T.Text
getText :: Block -> Maybe Text
getText (Div (Text
_, [Text]
_, [(Text, Text)]
kvs) [Block]
_) = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"text" [(Text, Text)]
kvs
getText Block
_                   = forall a. Maybe a
Nothing

data ListType = Itemized | Enumerated ListAttributes

listStyleMap :: [(T.Text, ListNumberStyle)]
listStyleMap :: [(Text, ListNumberStyle)]
listStyleMap = [(Text
"upperLetter", ListNumberStyle
UpperAlpha),
                (Text
"lowerLetter", ListNumberStyle
LowerAlpha),
                (Text
"upperRoman", ListNumberStyle
UpperRoman),
                (Text
"lowerRoman", ListNumberStyle
LowerRoman),
                (Text
"decimal", ListNumberStyle
Decimal)]

listDelimMap :: [(T.Text, ListNumberDelim)]
listDelimMap :: [(Text, ListNumberDelim)]
listDelimMap = [(Text
"%1)", ListNumberDelim
OneParen),
                (Text
"(%1)", ListNumberDelim
TwoParens),
                (Text
"%1.", ListNumberDelim
Period)]

getListType :: Block -> Maybe ListType
getListType :: Block -> Maybe ListType
getListType b :: Block
b@(Div (Text
_, [Text]
_, [(Text, Text)]
kvs) [Block]
_) | Block -> Bool
isListItem Block
b =
  let
    start :: Maybe Text
start = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"start" [(Text, Text)]
kvs
    frmt :: Maybe Text
frmt = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"format" [(Text, Text)]
kvs
    txt :: Maybe Text
txt  = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"text" [(Text, Text)]
kvs
  in
   case Maybe Text
frmt of
     Just Text
"bullet" -> forall a. a -> Maybe a
Just ListType
Itemized
     Just Text
f        ->
       case Maybe Text
txt of
         Just Text
t -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ListAttributes -> ListType
Enumerated (
                  forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Text
start forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead) :: Int,
                  forall a. a -> Maybe a -> a
fromMaybe ListNumberStyle
DefaultStyle (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
f [(Text, ListNumberStyle)]
listStyleMap),
                  forall a. a -> Maybe a -> a
fromMaybe ListNumberDelim
DefaultDelim (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
t [(Text, ListNumberDelim)]
listDelimMap))
         Maybe Text
Nothing -> forall a. Maybe a
Nothing
     Maybe Text
_ -> forall a. Maybe a
Nothing
getListType Block
_ = forall a. Maybe a
Nothing

listParagraphDivs :: [T.Text]
listParagraphDivs :: [Text]
listParagraphDivs = [Text
"list-paragraph"]

listParagraphStyles :: [ParaStyleName]
listParagraphStyles :: [ParaStyleName]
listParagraphStyles = forall a b. (a -> b) -> [a] -> [b]
map (forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) [Text]
listParagraphDivs

-- This is a first stab at going through and attaching meaning to list
-- paragraphs, without an item marker, following a list item. We
-- assume that these are paragraphs in the same item.

handleListParagraphs :: [Block] -> [Block]
handleListParagraphs :: [Block] -> [Block]
handleListParagraphs [] = []
handleListParagraphs (
  Div attr1 :: (Text, [Text], [(Text, Text)])
attr1@(Text
_, [Text]
classes1, [(Text, Text)]
_) [Block]
blks1 :
  Div (Text
ident2, [Text]
classes2, [(Text, Text)]
kvs2) [Block]
blks2 :
  [Block]
blks
  ) | Text
"list-item" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes1 Bool -> Bool -> Bool
&&
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Text
"list-item" [Text]
classes2 Bool -> Bool -> Bool
&&
    (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([Text]
listParagraphDivs forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Text]
classes2) =
      -- We don't want to keep this indent.
      let newDiv2 :: Block
newDiv2 =
            (Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
ident2, [Text]
classes2, forall a. (a -> Bool) -> [a] -> [a]
filter (\(Text, Text)
kv -> forall a b. (a, b) -> a
fst (Text, Text)
kv forall a. Eq a => a -> a -> Bool
/= Text
"indent") [(Text, Text)]
kvs2) [Block]
blks2
      in
       [Block] -> [Block]
handleListParagraphs ((Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text, [Text], [(Text, Text)])
attr1 ([Block]
blks1 forall a. [a] -> [a] -> [a]
++ [Block
newDiv2]) forall a. a -> [a] -> [a]
: [Block]
blks)
handleListParagraphs (Block
blk:[Block]
blks) = Block
blk forall a. a -> [a] -> [a]
: [Block] -> [Block]
handleListParagraphs [Block]
blks

separateBlocks' :: Block -> [[Block]] -> [[Block]]
separateBlocks' :: Block -> [[Block]] -> [[Block]]
separateBlocks' Block
blk [[]] = [[Block
blk]]
separateBlocks' b :: Block
b@(BulletList [[Block]]
_) [[Block]]
acc = forall a. [a] -> [a]
init [[Block]]
acc forall a. [a] -> [a] -> [a]
++ [forall a. [a] -> a
last [[Block]]
acc forall a. [a] -> [a] -> [a]
++ [Block
b]]
separateBlocks' b :: Block
b@(OrderedList ListAttributes
_ [[Block]]
_) [[Block]]
acc = forall a. [a] -> [a]
init [[Block]]
acc forall a. [a] -> [a] -> [a]
++ [forall a. [a] -> a
last [[Block]]
acc forall a. [a] -> [a] -> [a]
++ [Block
b]]
-- The following is for the invisible bullet lists. This is how
-- pandoc-generated ooxml does multiparagraph item lists.
separateBlocks' Block
b [[Block]]
acc | forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
trim (Block -> Maybe Text
getText Block
b) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Text
"" =
  forall a. [a] -> [a]
init [[Block]]
acc forall a. [a] -> [a] -> [a]
++ [forall a. [a] -> a
last [[Block]]
acc forall a. [a] -> [a] -> [a]
++ [Block
b]]
separateBlocks' Block
b [[Block]]
acc = [[Block]]
acc forall a. [a] -> [a] -> [a]
++ [[Block
b]]

separateBlocks :: [Block] -> [[Block]]
separateBlocks :: [Block] -> [[Block]]
separateBlocks [Block]
blks = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Block -> [[Block]] -> [[Block]]
separateBlocks' [[]] (forall a. [a] -> [a]
reverse [Block]
blks)

flatToBullets' :: Integer -> [Block] -> [Block]
flatToBullets' :: Integer -> [Block] -> [Block]
flatToBullets' Integer
_ [] = []
flatToBullets' Integer
num xs :: [Block]
xs@(Block
b : [Block]
elems)
  | Block -> Integer
getLevelN Block
b forall a. Eq a => a -> a -> Bool
== Integer
num = Block
b forall a. a -> [a] -> [a]
: Integer -> [Block] -> [Block]
flatToBullets' Integer
num [Block]
elems
  | Bool
otherwise =
    let bNumId :: Integer
bNumId = Block -> Integer
getNumIdN Block
b
        bLevel :: Integer
bLevel = Block -> Integer
getLevelN Block
b
        ([Block]
children, [Block]
remaining) =
          forall a. (a -> Bool) -> [a] -> ([a], [a])
span
          (\Block
b' ->
            Block -> Integer
getLevelN Block
b' forall a. Ord a => a -> a -> Bool
> Integer
bLevel Bool -> Bool -> Bool
||
             (Block -> Integer
getLevelN Block
b' forall a. Eq a => a -> a -> Bool
== Integer
bLevel Bool -> Bool -> Bool
&& Block -> Integer
getNumIdN Block
b' forall a. Eq a => a -> a -> Bool
== Integer
bNumId))
          [Block]
xs
    in
     case Block -> Maybe ListType
getListType Block
b of
       Just (Enumerated ListAttributes
attr) ->
         ListAttributes -> [[Block]] -> Block
OrderedList ListAttributes
attr ([Block] -> [[Block]]
separateBlocks forall a b. (a -> b) -> a -> b
$ Integer -> [Block] -> [Block]
flatToBullets' Integer
bLevel [Block]
children) forall a. a -> [a] -> [a]
:
         Integer -> [Block] -> [Block]
flatToBullets' Integer
num [Block]
remaining
       Maybe ListType
_ ->
         [[Block]] -> Block
BulletList ([Block] -> [[Block]]
separateBlocks forall a b. (a -> b) -> a -> b
$ Integer -> [Block] -> [Block]
flatToBullets' Integer
bLevel [Block]
children) forall a. a -> [a] -> [a]
:
         Integer -> [Block] -> [Block]
flatToBullets' Integer
num [Block]
remaining

flatToBullets :: [Block] -> [Block]
flatToBullets :: [Block] -> [Block]
flatToBullets [Block]
elems = Integer -> [Block] -> [Block]
flatToBullets' (-Integer
1) [Block]
elems

singleItemHeaderToHeader :: Block -> Block
singleItemHeaderToHeader :: Block -> Block
singleItemHeaderToHeader (OrderedList ListAttributes
_ [[h :: Block
h@Header{}]]) = Block
h
singleItemHeaderToHeader Block
blk                            = Block
blk


blocksToBullets :: [Block] -> [Block]
blocksToBullets :: [Block] -> [Block]
blocksToBullets [Block]
blks =
  forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
singleItemHeaderToHeader forall a b. (a -> b) -> a -> b
$
  forall a b. (Data a, Data b) => (a -> a) -> b -> b
bottomUp [Block] -> [Block]
removeListDivs forall a b. (a -> b) -> a -> b
$ [Block] -> [Block]
flatToBullets ([Block] -> [Block]
handleListParagraphs [Block]
blks)

plainParaInlines :: Block -> [Inline]
plainParaInlines :: Block -> [Inline]
plainParaInlines (Plain [Inline]
ils) = [Inline]
ils
plainParaInlines (Para [Inline]
ils)  = [Inline]
ils
plainParaInlines Block
_           = []

blocksToDefinitions' :: [([Inline], [[Block]])] -> [Block] -> [Block] -> [Block]
blocksToDefinitions' :: [([Inline], [[Block]])] -> [Block] -> [Block] -> [Block]
blocksToDefinitions' []     [Block]
acc [] = forall a. [a] -> [a]
reverse [Block]
acc
blocksToDefinitions' [([Inline], [[Block]])]
defAcc [Block]
acc [] =
  forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ [([Inline], [[Block]])] -> Block
DefinitionList (forall a. [a] -> [a]
reverse [([Inline], [[Block]])]
defAcc) forall a. a -> [a] -> [a]
: [Block]
acc
blocksToDefinitions' [([Inline], [[Block]])]
defAcc [Block]
acc
  (Div (Text
_, [Text]
classes1, [(Text, Text)]
_) [Block]
blks1 : Div (Text
ident2, [Text]
classes2, [(Text, Text)]
kvs2) [Block]
blks2 : [Block]
blks)
  | Text
"Definition-Term" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes1 Bool -> Bool -> Bool
&& Text
"Definition"  forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes2 =
    let remainingAttr2 :: (Text, [Text], [(Text, Text)])
remainingAttr2 = (Text
ident2, forall a. Eq a => a -> [a] -> [a]
delete Text
"Definition" [Text]
classes2, [(Text, Text)]
kvs2)
        pair :: ([Inline], [[Block]])
pair = if (Text, [Text], [(Text, Text)])
remainingAttr2 forall a. Eq a => a -> a -> Bool
== (Text
"", [], []) then (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Block -> [Inline]
plainParaInlines [Block]
blks1, [[Block]
blks2]) else (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Block -> [Inline]
plainParaInlines [Block]
blks1, [[(Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text, [Text], [(Text, Text)])
remainingAttr2 [Block]
blks2]])
    in
     [([Inline], [[Block]])] -> [Block] -> [Block] -> [Block]
blocksToDefinitions' (([Inline], [[Block]])
pair forall a. a -> [a] -> [a]
: [([Inline], [[Block]])]
defAcc) [Block]
acc [Block]
blks
blocksToDefinitions' (([Inline]
defTerm, [[Block]]
defItems):[([Inline], [[Block]])]
defs) [Block]
acc
  (Div (Text
ident2, [Text]
classes2, [(Text, Text)]
kvs2) [Block]
blks2 : [Block]
blks)
  | Text
"Definition"  forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes2 =
    let remainingAttr2 :: (Text, [Text], [(Text, Text)])
remainingAttr2 = (Text
ident2, forall a. Eq a => a -> [a] -> [a]
delete Text
"Definition" [Text]
classes2, [(Text, Text)]
kvs2)
        defItems2 :: [Block]
defItems2 = if (Text, [Text], [(Text, Text)])
remainingAttr2 forall a. Eq a => a -> a -> Bool
== (Text
"", [], [])
          then [Block]
blks2
          else [(Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text, [Text], [(Text, Text)])
remainingAttr2 [Block]
blks2]
        defAcc' :: [([Inline], [[Block]])]
defAcc' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
defItems
          then ([Inline]
defTerm, [[Block]
defItems2]) forall a. a -> [a] -> [a]
: [([Inline], [[Block]])]
defs
          else ([Inline]
defTerm, forall a. [a] -> [a]
init [[Block]]
defItems forall a. [a] -> [a] -> [a]
++ [forall a. [a] -> a
last [[Block]]
defItems forall a. [a] -> [a] -> [a]
++ [Block]
defItems2]) forall a. a -> [a] -> [a]
: [([Inline], [[Block]])]
defs
    in
     [([Inline], [[Block]])] -> [Block] -> [Block] -> [Block]
blocksToDefinitions' [([Inline], [[Block]])]
defAcc' [Block]
acc [Block]
blks
blocksToDefinitions' [] [Block]
acc (Block
b:[Block]
blks) =
  [([Inline], [[Block]])] -> [Block] -> [Block] -> [Block]
blocksToDefinitions' [] (Block
bforall a. a -> [a] -> [a]
:[Block]
acc) [Block]
blks
blocksToDefinitions' [([Inline], [[Block]])]
defAcc [Block]
acc (Block
b:[Block]
blks) =
  [([Inline], [[Block]])] -> [Block] -> [Block] -> [Block]
blocksToDefinitions' [] (Block
b forall a. a -> [a] -> [a]
: [([Inline], [[Block]])] -> Block
DefinitionList (forall a. [a] -> [a]
reverse [([Inline], [[Block]])]
defAcc) forall a. a -> [a] -> [a]
: [Block]
acc) [Block]
blks

removeListDivs' :: Block -> [Block]
removeListDivs' :: Block -> [Block]
removeListDivs' (Div (Text
ident, [Text]
classes, [(Text, Text)]
kvs) [Block]
blks)
  | Text
"list-item" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
classes =
    case forall a. Eq a => a -> [a] -> [a]
delete Text
"list-item" [Text]
classes of
      []       -> [Block]
blks
      [Text]
classes' -> [(Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
ident, [Text]
classes', [(Text, Text)]
kvs) [Block]
blks]
removeListDivs' (Div (Text
ident, [Text]
classes, [(Text, Text)]
kvs) [Block]
blks)
  | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ [Text]
listParagraphDivs forall a. Eq a => [a] -> [a] -> [a]
`intersect` [Text]
classes =
    case [Text]
classes forall a. Eq a => [a] -> [a] -> [a]
\\ [Text]
listParagraphDivs of
      []       -> [Block]
blks
      [Text]
classes' -> [(Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
ident, [Text]
classes', [(Text, Text)]
kvs) [Block]
blks]
removeListDivs' Block
blk = [Block
blk]

removeListDivs :: [Block] -> [Block]
removeListDivs :: [Block] -> [Block]
removeListDivs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Block -> [Block]
removeListDivs'

blocksToDefinitions :: [Block] -> [Block]
blocksToDefinitions :: [Block] -> [Block]
blocksToDefinitions = [([Inline], [[Block]])] -> [Block] -> [Block] -> [Block]
blocksToDefinitions' [] []