{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE TypeFamilies      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
 Module : Text.Pandoc.Readers.Docx.Parse.Styles
 Copyright : Copyright (C) 2014-2020 Jesse Rosenthal
                           2019 Nikolay Yakimov <root@livid.pp.ru>
 License : GNU GPL, version 2 or above

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

Type machinery and code for extraction and manipulation of docx styles
-}

module Text.Pandoc.Readers.Docx.Parse.Styles (
    CharStyleId(..)
  , CharStyle
  , ParaStyleId(..)
  , ParStyle(..)
  , ParIndentation(..)
  , RunStyle(..)
  , HasStyleName
  , StyleName
  , ParaStyleName
  , CharStyleName
  , FromStyleName
  , VertAlign(..)
  , StyleId
  , HasStyleId
  , archiveToStyles'
  , getStyleId
  , getStyleName
  , cStyleData
  , fromStyleName
  , fromStyleId
  , stringToInteger
  , getIndentation
  , getNumInfo
  , elemToRunStyle
  , defaultRunStyle
  , checkOnOff
  ) where
import Codec.Archive.Zip
import Control.Applicative ((<|>))
import Data.Function (on)
import Data.String (IsString(..))
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Text.Read
import Data.Text (Text)
import Data.Maybe
import Data.Coerce
import Text.Pandoc.Readers.Docx.Util
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.XML.Light

newtype CharStyleId   = CharStyleId T.Text
  deriving (Int -> CharStyleId -> ShowS
[CharStyleId] -> ShowS
CharStyleId -> String
(Int -> CharStyleId -> ShowS)
-> (CharStyleId -> String)
-> ([CharStyleId] -> ShowS)
-> Show CharStyleId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CharStyleId] -> ShowS
$cshowList :: [CharStyleId] -> ShowS
show :: CharStyleId -> String
$cshow :: CharStyleId -> String
showsPrec :: Int -> CharStyleId -> ShowS
$cshowsPrec :: Int -> CharStyleId -> ShowS
Show, CharStyleId -> CharStyleId -> Bool
(CharStyleId -> CharStyleId -> Bool)
-> (CharStyleId -> CharStyleId -> Bool) -> Eq CharStyleId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CharStyleId -> CharStyleId -> Bool
$c/= :: CharStyleId -> CharStyleId -> Bool
== :: CharStyleId -> CharStyleId -> Bool
$c== :: CharStyleId -> CharStyleId -> Bool
Eq, Eq CharStyleId
Eq CharStyleId
-> (CharStyleId -> CharStyleId -> Ordering)
-> (CharStyleId -> CharStyleId -> Bool)
-> (CharStyleId -> CharStyleId -> Bool)
-> (CharStyleId -> CharStyleId -> Bool)
-> (CharStyleId -> CharStyleId -> Bool)
-> (CharStyleId -> CharStyleId -> CharStyleId)
-> (CharStyleId -> CharStyleId -> CharStyleId)
-> Ord CharStyleId
CharStyleId -> CharStyleId -> Bool
CharStyleId -> CharStyleId -> Ordering
CharStyleId -> CharStyleId -> CharStyleId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CharStyleId -> CharStyleId -> CharStyleId
$cmin :: CharStyleId -> CharStyleId -> CharStyleId
max :: CharStyleId -> CharStyleId -> CharStyleId
$cmax :: CharStyleId -> CharStyleId -> CharStyleId
>= :: CharStyleId -> CharStyleId -> Bool
$c>= :: CharStyleId -> CharStyleId -> Bool
> :: CharStyleId -> CharStyleId -> Bool
$c> :: CharStyleId -> CharStyleId -> Bool
<= :: CharStyleId -> CharStyleId -> Bool
$c<= :: CharStyleId -> CharStyleId -> Bool
< :: CharStyleId -> CharStyleId -> Bool
$c< :: CharStyleId -> CharStyleId -> Bool
compare :: CharStyleId -> CharStyleId -> Ordering
$ccompare :: CharStyleId -> CharStyleId -> Ordering
$cp1Ord :: Eq CharStyleId
Ord, String -> CharStyleId
(String -> CharStyleId) -> IsString CharStyleId
forall a. (String -> a) -> IsString a
fromString :: String -> CharStyleId
$cfromString :: String -> CharStyleId
IsString, CharStyleId -> Text
(CharStyleId -> Text) -> FromStyleId CharStyleId
forall a. (a -> Text) -> FromStyleId a
fromStyleId :: CharStyleId -> Text
$cfromStyleId :: CharStyleId -> Text
FromStyleId)
newtype ParaStyleId   = ParaStyleId T.Text
  deriving (Int -> ParaStyleId -> ShowS
[ParaStyleId] -> ShowS
ParaStyleId -> String
(Int -> ParaStyleId -> ShowS)
-> (ParaStyleId -> String)
-> ([ParaStyleId] -> ShowS)
-> Show ParaStyleId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParaStyleId] -> ShowS
$cshowList :: [ParaStyleId] -> ShowS
show :: ParaStyleId -> String
$cshow :: ParaStyleId -> String
showsPrec :: Int -> ParaStyleId -> ShowS
$cshowsPrec :: Int -> ParaStyleId -> ShowS
Show, ParaStyleId -> ParaStyleId -> Bool
(ParaStyleId -> ParaStyleId -> Bool)
-> (ParaStyleId -> ParaStyleId -> Bool) -> Eq ParaStyleId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParaStyleId -> ParaStyleId -> Bool
$c/= :: ParaStyleId -> ParaStyleId -> Bool
== :: ParaStyleId -> ParaStyleId -> Bool
$c== :: ParaStyleId -> ParaStyleId -> Bool
Eq, Eq ParaStyleId
Eq ParaStyleId
-> (ParaStyleId -> ParaStyleId -> Ordering)
-> (ParaStyleId -> ParaStyleId -> Bool)
-> (ParaStyleId -> ParaStyleId -> Bool)
-> (ParaStyleId -> ParaStyleId -> Bool)
-> (ParaStyleId -> ParaStyleId -> Bool)
-> (ParaStyleId -> ParaStyleId -> ParaStyleId)
-> (ParaStyleId -> ParaStyleId -> ParaStyleId)
-> Ord ParaStyleId
ParaStyleId -> ParaStyleId -> Bool
ParaStyleId -> ParaStyleId -> Ordering
ParaStyleId -> ParaStyleId -> ParaStyleId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ParaStyleId -> ParaStyleId -> ParaStyleId
$cmin :: ParaStyleId -> ParaStyleId -> ParaStyleId
max :: ParaStyleId -> ParaStyleId -> ParaStyleId
$cmax :: ParaStyleId -> ParaStyleId -> ParaStyleId
>= :: ParaStyleId -> ParaStyleId -> Bool
$c>= :: ParaStyleId -> ParaStyleId -> Bool
> :: ParaStyleId -> ParaStyleId -> Bool
$c> :: ParaStyleId -> ParaStyleId -> Bool
<= :: ParaStyleId -> ParaStyleId -> Bool
$c<= :: ParaStyleId -> ParaStyleId -> Bool
< :: ParaStyleId -> ParaStyleId -> Bool
$c< :: ParaStyleId -> ParaStyleId -> Bool
compare :: ParaStyleId -> ParaStyleId -> Ordering
$ccompare :: ParaStyleId -> ParaStyleId -> Ordering
$cp1Ord :: Eq ParaStyleId
Ord, String -> ParaStyleId
(String -> ParaStyleId) -> IsString ParaStyleId
forall a. (String -> a) -> IsString a
fromString :: String -> ParaStyleId
$cfromString :: String -> ParaStyleId
IsString, ParaStyleId -> Text
(ParaStyleId -> Text) -> FromStyleId ParaStyleId
forall a. (a -> Text) -> FromStyleId a
fromStyleId :: ParaStyleId -> Text
$cfromStyleId :: ParaStyleId -> Text
FromStyleId)

newtype CharStyleName = CharStyleName CIString
  deriving (Int -> CharStyleName -> ShowS
[CharStyleName] -> ShowS
CharStyleName -> String
(Int -> CharStyleName -> ShowS)
-> (CharStyleName -> String)
-> ([CharStyleName] -> ShowS)
-> Show CharStyleName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CharStyleName] -> ShowS
$cshowList :: [CharStyleName] -> ShowS
show :: CharStyleName -> String
$cshow :: CharStyleName -> String
showsPrec :: Int -> CharStyleName -> ShowS
$cshowsPrec :: Int -> CharStyleName -> ShowS
Show, CharStyleName -> CharStyleName -> Bool
(CharStyleName -> CharStyleName -> Bool)
-> (CharStyleName -> CharStyleName -> Bool) -> Eq CharStyleName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CharStyleName -> CharStyleName -> Bool
$c/= :: CharStyleName -> CharStyleName -> Bool
== :: CharStyleName -> CharStyleName -> Bool
$c== :: CharStyleName -> CharStyleName -> Bool
Eq, Eq CharStyleName
Eq CharStyleName
-> (CharStyleName -> CharStyleName -> Ordering)
-> (CharStyleName -> CharStyleName -> Bool)
-> (CharStyleName -> CharStyleName -> Bool)
-> (CharStyleName -> CharStyleName -> Bool)
-> (CharStyleName -> CharStyleName -> Bool)
-> (CharStyleName -> CharStyleName -> CharStyleName)
-> (CharStyleName -> CharStyleName -> CharStyleName)
-> Ord CharStyleName
CharStyleName -> CharStyleName -> Bool
CharStyleName -> CharStyleName -> Ordering
CharStyleName -> CharStyleName -> CharStyleName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CharStyleName -> CharStyleName -> CharStyleName
$cmin :: CharStyleName -> CharStyleName -> CharStyleName
max :: CharStyleName -> CharStyleName -> CharStyleName
$cmax :: CharStyleName -> CharStyleName -> CharStyleName
>= :: CharStyleName -> CharStyleName -> Bool
$c>= :: CharStyleName -> CharStyleName -> Bool
> :: CharStyleName -> CharStyleName -> Bool
$c> :: CharStyleName -> CharStyleName -> Bool
<= :: CharStyleName -> CharStyleName -> Bool
$c<= :: CharStyleName -> CharStyleName -> Bool
< :: CharStyleName -> CharStyleName -> Bool
$c< :: CharStyleName -> CharStyleName -> Bool
compare :: CharStyleName -> CharStyleName -> Ordering
$ccompare :: CharStyleName -> CharStyleName -> Ordering
$cp1Ord :: Eq CharStyleName
Ord, String -> CharStyleName
(String -> CharStyleName) -> IsString CharStyleName
forall a. (String -> a) -> IsString a
fromString :: String -> CharStyleName
$cfromString :: String -> CharStyleName
IsString, CharStyleName -> Text
(CharStyleName -> Text) -> FromStyleName CharStyleName
forall a. (a -> Text) -> FromStyleName a
fromStyleName :: CharStyleName -> Text
$cfromStyleName :: CharStyleName -> Text
FromStyleName)
newtype ParaStyleName = ParaStyleName CIString
  deriving (Int -> ParaStyleName -> ShowS
[ParaStyleName] -> ShowS
ParaStyleName -> String
(Int -> ParaStyleName -> ShowS)
-> (ParaStyleName -> String)
-> ([ParaStyleName] -> ShowS)
-> Show ParaStyleName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParaStyleName] -> ShowS
$cshowList :: [ParaStyleName] -> ShowS
show :: ParaStyleName -> String
$cshow :: ParaStyleName -> String
showsPrec :: Int -> ParaStyleName -> ShowS
$cshowsPrec :: Int -> ParaStyleName -> ShowS
Show, ParaStyleName -> ParaStyleName -> Bool
(ParaStyleName -> ParaStyleName -> Bool)
-> (ParaStyleName -> ParaStyleName -> Bool) -> Eq ParaStyleName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParaStyleName -> ParaStyleName -> Bool
$c/= :: ParaStyleName -> ParaStyleName -> Bool
== :: ParaStyleName -> ParaStyleName -> Bool
$c== :: ParaStyleName -> ParaStyleName -> Bool
Eq, Eq ParaStyleName
Eq ParaStyleName
-> (ParaStyleName -> ParaStyleName -> Ordering)
-> (ParaStyleName -> ParaStyleName -> Bool)
-> (ParaStyleName -> ParaStyleName -> Bool)
-> (ParaStyleName -> ParaStyleName -> Bool)
-> (ParaStyleName -> ParaStyleName -> Bool)
-> (ParaStyleName -> ParaStyleName -> ParaStyleName)
-> (ParaStyleName -> ParaStyleName -> ParaStyleName)
-> Ord ParaStyleName
ParaStyleName -> ParaStyleName -> Bool
ParaStyleName -> ParaStyleName -> Ordering
ParaStyleName -> ParaStyleName -> ParaStyleName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ParaStyleName -> ParaStyleName -> ParaStyleName
$cmin :: ParaStyleName -> ParaStyleName -> ParaStyleName
max :: ParaStyleName -> ParaStyleName -> ParaStyleName
$cmax :: ParaStyleName -> ParaStyleName -> ParaStyleName
>= :: ParaStyleName -> ParaStyleName -> Bool
$c>= :: ParaStyleName -> ParaStyleName -> Bool
> :: ParaStyleName -> ParaStyleName -> Bool
$c> :: ParaStyleName -> ParaStyleName -> Bool
<= :: ParaStyleName -> ParaStyleName -> Bool
$c<= :: ParaStyleName -> ParaStyleName -> Bool
< :: ParaStyleName -> ParaStyleName -> Bool
$c< :: ParaStyleName -> ParaStyleName -> Bool
compare :: ParaStyleName -> ParaStyleName -> Ordering
$ccompare :: ParaStyleName -> ParaStyleName -> Ordering
$cp1Ord :: Eq ParaStyleName
Ord, String -> ParaStyleName
(String -> ParaStyleName) -> IsString ParaStyleName
forall a. (String -> a) -> IsString a
fromString :: String -> ParaStyleName
$cfromString :: String -> ParaStyleName
IsString, ParaStyleName -> Text
(ParaStyleName -> Text) -> FromStyleName ParaStyleName
forall a. (a -> Text) -> FromStyleName a
fromStyleName :: ParaStyleName -> Text
$cfromStyleName :: ParaStyleName -> Text
FromStyleName)

-- Case-insensitive comparisons
newtype CIString = CIString T.Text deriving (Int -> CIString -> ShowS
[CIString] -> ShowS
CIString -> String
(Int -> CIString -> ShowS)
-> (CIString -> String) -> ([CIString] -> ShowS) -> Show CIString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CIString] -> ShowS
$cshowList :: [CIString] -> ShowS
show :: CIString -> String
$cshow :: CIString -> String
showsPrec :: Int -> CIString -> ShowS
$cshowsPrec :: Int -> CIString -> ShowS
Show, String -> CIString
(String -> CIString) -> IsString CIString
forall a. (String -> a) -> IsString a
fromString :: String -> CIString
$cfromString :: String -> CIString
IsString, CIString -> Text
(CIString -> Text) -> FromStyleName CIString
forall a. (a -> Text) -> FromStyleName a
fromStyleName :: CIString -> Text
$cfromStyleName :: CIString -> Text
FromStyleName)

class FromStyleName a where
  fromStyleName :: a -> T.Text

instance FromStyleName String where
  fromStyleName :: String -> Text
fromStyleName = String -> Text
T.pack

instance FromStyleName T.Text where
  fromStyleName :: Text -> Text
fromStyleName = Text -> Text
forall a. a -> a
id

class FromStyleId a where
  fromStyleId :: a -> T.Text

instance FromStyleId String where
  fromStyleId :: String -> Text
fromStyleId = String -> Text
T.pack

instance FromStyleId T.Text where
  fromStyleId :: Text -> Text
fromStyleId = Text -> Text
forall a. a -> a
id

instance Eq CIString where
   == :: CIString -> CIString -> Bool
(==) = Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Text -> Text -> Bool)
-> (CIString -> Text) -> CIString -> CIString -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Text -> Text
T.toCaseFold (Text -> Text) -> (CIString -> Text) -> CIString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIString -> Text
coerce

instance Ord CIString where
  compare :: CIString -> CIString -> Ordering
compare = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Text -> Text -> Ordering)
-> (CIString -> Text) -> CIString -> CIString -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Text -> Text
T.toCaseFold (Text -> Text) -> (CIString -> Text) -> CIString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIString -> Text
coerce

data VertAlign = BaseLn | SupScrpt | SubScrpt
               deriving Int -> VertAlign -> ShowS
[VertAlign] -> ShowS
VertAlign -> String
(Int -> VertAlign -> ShowS)
-> (VertAlign -> String)
-> ([VertAlign] -> ShowS)
-> Show VertAlign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VertAlign] -> ShowS
$cshowList :: [VertAlign] -> ShowS
show :: VertAlign -> String
$cshow :: VertAlign -> String
showsPrec :: Int -> VertAlign -> ShowS
$cshowsPrec :: Int -> VertAlign -> ShowS
Show

data CharStyle = CharStyle { CharStyle -> CharStyleId
cStyleId   :: CharStyleId
                           , CharStyle -> CharStyleName
cStyleName :: CharStyleName
                           , CharStyle -> RunStyle
cStyleData :: RunStyle
                           } deriving (Int -> CharStyle -> ShowS
[CharStyle] -> ShowS
CharStyle -> String
(Int -> CharStyle -> ShowS)
-> (CharStyle -> String)
-> ([CharStyle] -> ShowS)
-> Show CharStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CharStyle] -> ShowS
$cshowList :: [CharStyle] -> ShowS
show :: CharStyle -> String
$cshow :: CharStyle -> String
showsPrec :: Int -> CharStyle -> ShowS
$cshowsPrec :: Int -> CharStyle -> ShowS
Show)

data RunStyle = RunStyle { RunStyle -> Maybe Bool
isBold       :: Maybe Bool
                         , RunStyle -> Maybe Bool
isBoldCTL    :: Maybe Bool
                         , RunStyle -> Maybe Bool
isItalic     :: Maybe Bool
                         , RunStyle -> Maybe Bool
isItalicCTL  :: Maybe Bool
                         , RunStyle -> Maybe Bool
isSmallCaps  :: Maybe Bool
                         , RunStyle -> Maybe Bool
isStrike     :: Maybe Bool
                         , RunStyle -> Maybe Bool
isRTL        :: Maybe Bool
                         , RunStyle -> Maybe Bool
isForceCTL   :: Maybe Bool
                         , RunStyle -> Maybe VertAlign
rVertAlign   :: Maybe VertAlign
                         , RunStyle -> Maybe Text
rUnderline   :: Maybe Text
                         , RunStyle -> Maybe CharStyle
rParentStyle :: Maybe CharStyle
                         }
                deriving Int -> RunStyle -> ShowS
[RunStyle] -> ShowS
RunStyle -> String
(Int -> RunStyle -> ShowS)
-> (RunStyle -> String) -> ([RunStyle] -> ShowS) -> Show RunStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunStyle] -> ShowS
$cshowList :: [RunStyle] -> ShowS
show :: RunStyle -> String
$cshow :: RunStyle -> String
showsPrec :: Int -> RunStyle -> ShowS
$cshowsPrec :: Int -> RunStyle -> ShowS
Show

data ParIndentation = ParIndentation { ParIndentation -> Maybe Integer
leftParIndent    :: Maybe Integer
                                     , ParIndentation -> Maybe Integer
rightParIndent   :: Maybe Integer
                                     , ParIndentation -> Maybe Integer
hangingParIndent :: Maybe Integer}
                      deriving Int -> ParIndentation -> ShowS
[ParIndentation] -> ShowS
ParIndentation -> String
(Int -> ParIndentation -> ShowS)
-> (ParIndentation -> String)
-> ([ParIndentation] -> ShowS)
-> Show ParIndentation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParIndentation] -> ShowS
$cshowList :: [ParIndentation] -> ShowS
show :: ParIndentation -> String
$cshow :: ParIndentation -> String
showsPrec :: Int -> ParIndentation -> ShowS
$cshowsPrec :: Int -> ParIndentation -> ShowS
Show

data ParStyle = ParStyle { ParStyle -> Maybe (ParaStyleName, Int)
headingLev    :: Maybe (ParaStyleName, Int)
                         , ParStyle -> Maybe ParIndentation
indent        :: Maybe ParIndentation
                         , ParStyle -> Maybe (Text, Text)
numInfo       :: Maybe (T.Text, T.Text)
                         , ParStyle -> Maybe ParStyle
psParentStyle :: Maybe ParStyle
                         , ParStyle -> ParaStyleName
pStyleName    :: ParaStyleName
                         , ParStyle -> ParaStyleId
pStyleId      :: ParaStyleId
                         }
                    deriving Int -> ParStyle -> ShowS
[ParStyle] -> ShowS
ParStyle -> String
(Int -> ParStyle -> ShowS)
-> (ParStyle -> String) -> ([ParStyle] -> ShowS) -> Show ParStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParStyle] -> ShowS
$cshowList :: [ParStyle] -> ShowS
show :: ParStyle -> String
$cshow :: ParStyle -> String
showsPrec :: Int -> ParStyle -> ShowS
$cshowsPrec :: Int -> ParStyle -> ShowS
Show

defaultRunStyle :: RunStyle
defaultRunStyle :: RunStyle
defaultRunStyle = RunStyle :: Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe VertAlign
-> Maybe Text
-> Maybe CharStyle
-> RunStyle
RunStyle { isBold :: Maybe Bool
isBold = Maybe Bool
forall a. Maybe a
Nothing
                           , isBoldCTL :: Maybe Bool
isBoldCTL = Maybe Bool
forall a. Maybe a
Nothing
                           , isItalic :: Maybe Bool
isItalic = Maybe Bool
forall a. Maybe a
Nothing
                           , isItalicCTL :: Maybe Bool
isItalicCTL = Maybe Bool
forall a. Maybe a
Nothing
                           , isSmallCaps :: Maybe Bool
isSmallCaps = Maybe Bool
forall a. Maybe a
Nothing
                           , isStrike :: Maybe Bool
isStrike = Maybe Bool
forall a. Maybe a
Nothing
                           , isRTL :: Maybe Bool
isRTL = Maybe Bool
forall a. Maybe a
Nothing
                           , isForceCTL :: Maybe Bool
isForceCTL = Maybe Bool
forall a. Maybe a
Nothing
                           , rVertAlign :: Maybe VertAlign
rVertAlign = Maybe VertAlign
forall a. Maybe a
Nothing
                           , rUnderline :: Maybe Text
rUnderline = Maybe Text
forall a. Maybe a
Nothing
                           , rParentStyle :: Maybe CharStyle
rParentStyle = Maybe CharStyle
forall a. Maybe a
Nothing
                           }

archiveToStyles'
  :: (Ord k1, Ord k2, ElemToStyle a1, ElemToStyle a2)
  => (a1 -> k1) -> (a2 -> k2) -> Archive -> (M.Map k1 a1, M.Map k2 a2)
archiveToStyles' :: (a1 -> k1) -> (a2 -> k2) -> Archive -> (Map k1 a1, Map k2 a2)
archiveToStyles' a1 -> k1
conv1 a2 -> k2
conv2 Archive
zf =
  case String -> Archive -> Maybe Entry
findEntryByPath String
"word/styles.xml" Archive
zf of
    Maybe Entry
Nothing -> (Map k1 a1
forall k a. Map k a
M.empty, Map k2 a2
forall k a. Map k a
M.empty)
    Just Entry
entry ->
      case Text -> Either Text Element
parseXMLElement (Text -> Either Text Element)
-> (Entry -> Text) -> Entry -> Either Text Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
UTF8.toTextLazy (ByteString -> Text) -> (Entry -> ByteString) -> Entry -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> ByteString
fromEntry (Entry -> Either Text Element) -> Entry -> Either Text Element
forall a b. (a -> b) -> a -> b
$ Entry
entry of
        Left Text
_ -> (Map k1 a1
forall k a. Map k a
M.empty, Map k2 a2
forall k a. Map k a
M.empty)
        Right Element
styElem ->
          let namespaces :: NameSpaces
namespaces = Element -> NameSpaces
elemToNameSpaces Element
styElem
          in
           ( [(k1, a1)] -> Map k1 a1
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(k1, a1)] -> Map k1 a1) -> [(k1, a1)] -> Map k1 a1
forall a b. (a -> b) -> a -> b
$ (a1 -> (k1, a1)) -> [a1] -> [(k1, a1)]
forall a b. (a -> b) -> [a] -> [b]
map (\a1
r -> (a1 -> k1
conv1 a1
r, a1
r)) ([a1] -> [(k1, a1)]) -> [a1] -> [(k1, a1)]
forall a b. (a -> b) -> a -> b
$
               NameSpaces -> Element -> Maybe a1 -> [a1]
forall a. ElemToStyle a => NameSpaces -> Element -> Maybe a -> [a]
buildBasedOnList NameSpaces
namespaces Element
styElem Maybe a1
forall a. Maybe a
Nothing,
             [(k2, a2)] -> Map k2 a2
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(k2, a2)] -> Map k2 a2) -> [(k2, a2)] -> Map k2 a2
forall a b. (a -> b) -> a -> b
$ (a2 -> (k2, a2)) -> [a2] -> [(k2, a2)]
forall a b. (a -> b) -> [a] -> [b]
map (\a2
p -> (a2 -> k2
conv2 a2
p, a2
p)) ([a2] -> [(k2, a2)]) -> [a2] -> [(k2, a2)]
forall a b. (a -> b) -> a -> b
$
               NameSpaces -> Element -> Maybe a2 -> [a2]
forall a. ElemToStyle a => NameSpaces -> Element -> Maybe a -> [a]
buildBasedOnList NameSpaces
namespaces Element
styElem Maybe a2
forall a. Maybe a
Nothing)

isBasedOnStyle :: (ElemToStyle a, FromStyleId (StyleId a)) => NameSpaces -> Element -> Maybe a -> Bool
isBasedOnStyle :: NameSpaces -> Element -> Maybe a -> Bool
isBasedOnStyle NameSpaces
ns Element
element Maybe a
parentStyle
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"style" Element
element
  , Just Text
styleType <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"type" Element
element
  , Text
styleType Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe a -> Text
forall a. ElemToStyle a => Maybe a -> Text
cStyleType Maybe a
parentStyle
  , Just Text
basedOnVal <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"basedOn" Element
element Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                       NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"val"
  , Just a
ps <- Maybe a
parentStyle = Text
basedOnVal Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== StyleId a -> Text
forall a. FromStyleId a => a -> Text
fromStyleId (a -> StyleId a
forall a. HasStyleId a => a -> StyleId a
getStyleId a
ps)
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"style" Element
element
  , Just Text
styleType <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"type" Element
element
  , Text
styleType Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe a -> Text
forall a. ElemToStyle a => Maybe a -> Text
cStyleType Maybe a
parentStyle
  , Maybe Element
Nothing <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"basedOn" Element
element
  , Maybe a
Nothing <- Maybe a
parentStyle = Bool
True
  | Bool
otherwise = Bool
False

class HasStyleId a => ElemToStyle a where
  cStyleType  :: Maybe a -> Text
  elemToStyle :: NameSpaces -> Element -> Maybe a -> Maybe a

class FromStyleId (StyleId a) => HasStyleId a where
  type StyleId a
  getStyleId :: a -> StyleId a

class FromStyleName (StyleName a) => HasStyleName a where
  type StyleName a
  getStyleName :: a -> StyleName a

instance ElemToStyle CharStyle where
  cStyleType :: Maybe CharStyle -> Text
cStyleType Maybe CharStyle
_ = Text
"character"
  elemToStyle :: NameSpaces -> Element -> Maybe CharStyle -> Maybe CharStyle
elemToStyle NameSpaces
ns Element
element Maybe CharStyle
parentStyle
    | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"style" Element
element
    , Just Text
"character" <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"type" Element
element =
      NameSpaces -> Element -> Maybe CharStyle -> Maybe CharStyle
elemToCharStyle NameSpaces
ns Element
element Maybe CharStyle
parentStyle
    | Bool
otherwise = Maybe CharStyle
forall a. Maybe a
Nothing

instance HasStyleId CharStyle where
  type StyleId CharStyle = CharStyleId
  getStyleId :: CharStyle -> StyleId CharStyle
getStyleId = CharStyle -> StyleId CharStyle
CharStyle -> CharStyleId
cStyleId

instance HasStyleName CharStyle where
  type StyleName CharStyle = CharStyleName
  getStyleName :: CharStyle -> StyleName CharStyle
getStyleName = CharStyle -> StyleName CharStyle
CharStyle -> CharStyleName
cStyleName

instance ElemToStyle ParStyle where
  cStyleType :: Maybe ParStyle -> Text
cStyleType Maybe ParStyle
_ = Text
"paragraph"
  elemToStyle :: NameSpaces -> Element -> Maybe ParStyle -> Maybe ParStyle
elemToStyle NameSpaces
ns Element
element Maybe ParStyle
parentStyle
    | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"style" Element
element
    , Just Text
"paragraph" <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"type" Element
element
    = NameSpaces -> Element -> Maybe ParStyle -> Maybe ParStyle
elemToParStyleData NameSpaces
ns Element
element Maybe ParStyle
parentStyle
    | Bool
otherwise = Maybe ParStyle
forall a. Maybe a
Nothing

instance HasStyleId ParStyle where
  type StyleId ParStyle = ParaStyleId
  getStyleId :: ParStyle -> StyleId ParStyle
getStyleId = ParStyle -> StyleId ParStyle
ParStyle -> ParaStyleId
pStyleId

instance HasStyleName ParStyle where
  type StyleName ParStyle = ParaStyleName
  getStyleName :: ParStyle -> StyleName ParStyle
getStyleName = ParStyle -> StyleName ParStyle
ParStyle -> ParaStyleName
pStyleName

getStyleChildren :: (ElemToStyle a) => NameSpaces -> Element -> Maybe a -> [a]
getStyleChildren :: NameSpaces -> Element -> Maybe a -> [a]
getStyleChildren NameSpaces
ns Element
element Maybe a
parentStyle
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"styles" Element
element =
    (Element -> Maybe a) -> [Element] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\Element
e -> NameSpaces -> Element -> Maybe a -> Maybe a
forall a.
ElemToStyle a =>
NameSpaces -> Element -> Maybe a -> Maybe a
elemToStyle NameSpaces
ns Element
e Maybe a
parentStyle) ([Element] -> [a]) -> [Element] -> [a]
forall a b. (a -> b) -> a -> b
$
    (Element -> Bool) -> Element -> [Element]
filterChildren (\Element
e' -> NameSpaces -> Element -> Maybe a -> Bool
forall a.
(ElemToStyle a, FromStyleId (StyleId a)) =>
NameSpaces -> Element -> Maybe a -> Bool
isBasedOnStyle NameSpaces
ns Element
e' Maybe a
parentStyle) Element
element
  | Bool
otherwise = []

buildBasedOnList :: (ElemToStyle a) => NameSpaces -> Element -> Maybe a -> [a]
buildBasedOnList :: NameSpaces -> Element -> Maybe a -> [a]
buildBasedOnList NameSpaces
ns Element
element Maybe a
rootStyle =
  case NameSpaces -> Element -> Maybe a -> [a]
forall a. ElemToStyle a => NameSpaces -> Element -> Maybe a -> [a]
getStyleChildren NameSpaces
ns Element
element Maybe a
rootStyle of
    [] -> []
    [a]
stys -> [a]
stys [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++
            (a -> [a]) -> [a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NameSpaces -> Element -> Maybe a -> [a]
forall a. ElemToStyle a => NameSpaces -> Element -> Maybe a -> [a]
buildBasedOnList NameSpaces
ns Element
element (Maybe a -> [a]) -> (a -> Maybe a) -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just) [a]
stys

stringToInteger :: Text -> Maybe Integer
stringToInteger :: Text -> Maybe Integer
stringToInteger Text
s = case Reader Integer
forall a. Integral a => Reader a
Data.Text.Read.decimal Text
s of
                      Right (Integer
x,Text
_) -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
x
                      Left String
_      -> Maybe Integer
forall a. Maybe a
Nothing

checkOnOff :: NameSpaces -> Element -> QName -> Maybe Bool
checkOnOff :: NameSpaces -> Element -> QName -> Maybe Bool
checkOnOff NameSpaces
ns Element
rPr QName
tag
  | Just Element
t <-  QName -> Element -> Maybe Element
findChild QName
tag Element
rPr
  , Just Text
val <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"val" Element
t =
    Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ case Text
val of
      Text
"true"  -> Bool
True
      Text
"false" -> Bool
False
      Text
"on"    -> Bool
True
      Text
"off"   -> Bool
False
      Text
"1"     -> Bool
True
      Text
"0"     -> Bool
False
      Text
_       -> Bool
False
  | Just Element
_ <- QName -> Element -> Maybe Element
findChild QName
tag Element
rPr = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
checkOnOff NameSpaces
_ Element
_ QName
_ = Maybe Bool
forall a. Maybe a
Nothing

elemToCharStyle :: NameSpaces
                -> Element -> Maybe CharStyle -> Maybe CharStyle
elemToCharStyle :: NameSpaces -> Element -> Maybe CharStyle -> Maybe CharStyle
elemToCharStyle NameSpaces
ns Element
element Maybe CharStyle
parentStyle
  = CharStyleId -> CharStyleName -> RunStyle -> CharStyle
CharStyle (CharStyleId -> CharStyleName -> RunStyle -> CharStyle)
-> Maybe CharStyleId
-> Maybe (CharStyleName -> RunStyle -> CharStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> CharStyleId
CharStyleId (Text -> CharStyleId) -> Maybe Text -> Maybe CharStyleId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"styleId" Element
element)
              Maybe (CharStyleName -> RunStyle -> CharStyle)
-> Maybe CharStyleName -> Maybe (RunStyle -> CharStyle)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NameSpaces -> Element -> Maybe CharStyleName
forall a. Coercible Text a => NameSpaces -> Element -> Maybe a
getElementStyleName NameSpaces
ns Element
element
              Maybe (RunStyle -> CharStyle) -> Maybe RunStyle -> Maybe CharStyle
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RunStyle -> Maybe RunStyle
forall a. a -> Maybe a
Just (NameSpaces -> Element -> Maybe CharStyle -> RunStyle
elemToRunStyle NameSpaces
ns Element
element Maybe CharStyle
parentStyle)

elemToRunStyle :: NameSpaces -> Element -> Maybe CharStyle -> RunStyle
elemToRunStyle :: NameSpaces -> Element -> Maybe CharStyle -> RunStyle
elemToRunStyle NameSpaces
ns Element
element Maybe CharStyle
parentStyle
  | Just Element
rPr <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"rPr" Element
element =
    RunStyle :: Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe VertAlign
-> Maybe Text
-> Maybe CharStyle
-> RunStyle
RunStyle
      {
        isBold :: Maybe Bool
isBold = NameSpaces -> Element -> QName -> Maybe Bool
checkOnOff NameSpaces
ns Element
rPr (NameSpaces -> Text -> Text -> QName
elemName NameSpaces
ns Text
"w" Text
"b")
      , isBoldCTL :: Maybe Bool
isBoldCTL = NameSpaces -> Element -> QName -> Maybe Bool
checkOnOff NameSpaces
ns Element
rPr (NameSpaces -> Text -> Text -> QName
elemName NameSpaces
ns Text
"w" Text
"bCs")
      , isItalic :: Maybe Bool
isItalic = NameSpaces -> Element -> QName -> Maybe Bool
checkOnOff NameSpaces
ns Element
rPr (NameSpaces -> Text -> Text -> QName
elemName NameSpaces
ns Text
"w" Text
"i")
      , isItalicCTL :: Maybe Bool
isItalicCTL = NameSpaces -> Element -> QName -> Maybe Bool
checkOnOff NameSpaces
ns Element
rPr (NameSpaces -> Text -> Text -> QName
elemName NameSpaces
ns Text
"w" Text
"iCs")
      , isSmallCaps :: Maybe Bool
isSmallCaps = NameSpaces -> Element -> QName -> Maybe Bool
checkOnOff NameSpaces
ns Element
rPr (NameSpaces -> Text -> Text -> QName
elemName NameSpaces
ns Text
"w" Text
"smallCaps")
      , isStrike :: Maybe Bool
isStrike = NameSpaces -> Element -> QName -> Maybe Bool
checkOnOff NameSpaces
ns Element
rPr (NameSpaces -> Text -> Text -> QName
elemName NameSpaces
ns Text
"w" Text
"strike")
      , isRTL :: Maybe Bool
isRTL = NameSpaces -> Element -> QName -> Maybe Bool
checkOnOff NameSpaces
ns Element
rPr (NameSpaces -> Text -> Text -> QName
elemName NameSpaces
ns Text
"w" Text
"rtl")
      , isForceCTL :: Maybe Bool
isForceCTL = NameSpaces -> Element -> QName -> Maybe Bool
checkOnOff NameSpaces
ns Element
rPr (NameSpaces -> Text -> Text -> QName
elemName NameSpaces
ns Text
"w" Text
"cs")
      , rVertAlign :: Maybe VertAlign
rVertAlign =
           NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"vertAlign" Element
rPr Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
           NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"val" Maybe Text -> (Text -> Maybe VertAlign) -> Maybe VertAlign
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
           \Text
v -> VertAlign -> Maybe VertAlign
forall a. a -> Maybe a
Just (VertAlign -> Maybe VertAlign) -> VertAlign -> Maybe VertAlign
forall a b. (a -> b) -> a -> b
$ case Text
v of
             Text
"superscript" -> VertAlign
SupScrpt
             Text
"subscript"   -> VertAlign
SubScrpt
             Text
_             -> VertAlign
BaseLn
      , rUnderline :: Maybe Text
rUnderline =
          NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"u" Element
rPr Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
          NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"val"
      , rParentStyle :: Maybe CharStyle
rParentStyle = Maybe CharStyle
parentStyle
      }
elemToRunStyle NameSpaces
_ Element
_ Maybe CharStyle
_ = RunStyle
defaultRunStyle

getHeaderLevel :: NameSpaces -> Element -> Maybe (ParaStyleName, Int)
getHeaderLevel :: NameSpaces -> Element -> Maybe (ParaStyleName, Int)
getHeaderLevel NameSpaces
ns Element
element
  | Just ParaStyleName
styleName <- NameSpaces -> Element -> Maybe ParaStyleName
forall a. Coercible Text a => NameSpaces -> Element -> Maybe a
getElementStyleName NameSpaces
ns Element
element
  , Just Integer
n <- Text -> Maybe Integer
stringToInteger (Text -> Maybe Integer) -> Maybe Text -> Maybe Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
              (Text -> Text -> Maybe Text
T.stripPrefix Text
"heading " (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$
                ParaStyleName -> Text
forall a. FromStyleName a => a -> Text
fromStyleName ParaStyleName
styleName)
  , Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 = (ParaStyleName, Int) -> Maybe (ParaStyleName, Int)
forall a. a -> Maybe a
Just (ParaStyleName
styleName, Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n)
getHeaderLevel NameSpaces
_ Element
_ = Maybe (ParaStyleName, Int)
forall a. Maybe a
Nothing

getIndentation :: NameSpaces -> Element -> Maybe ParIndentation
getIndentation :: NameSpaces -> Element -> Maybe ParIndentation
getIndentation NameSpaces
ns Element
el = do
  Element
indElement <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"pPr" Element
el Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"ind"
  ParIndentation -> Maybe ParIndentation
forall (m :: * -> *) a. Monad m => a -> m a
return (ParIndentation -> Maybe ParIndentation)
-> ParIndentation -> Maybe ParIndentation
forall a b. (a -> b) -> a -> b
$ ParIndentation :: Maybe Integer -> Maybe Integer -> Maybe Integer -> ParIndentation
ParIndentation
    {
      leftParIndent :: Maybe Integer
leftParIndent = NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"left" Element
indElement Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                      NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"start" Element
indElement Maybe Text -> (Text -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                      Text -> Maybe Integer
stringToInteger
    , rightParIndent :: Maybe Integer
rightParIndent = NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"right" Element
indElement Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                       NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"end" Element
indElement Maybe Text -> (Text -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                       Text -> Maybe Integer
stringToInteger
    , hangingParIndent :: Maybe Integer
hangingParIndent = (NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"hanging" Element
indElement Maybe Text -> (Text -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Integer
stringToInteger) Maybe Integer -> Maybe Integer -> Maybe Integer
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                         (Integer -> Integer) -> Maybe Integer -> Maybe Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Integer
forall a. Num a => a -> a
negate
                           (NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"firstLine" Element
indElement Maybe Text -> (Text -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Integer
stringToInteger)
    }

getElementStyleName :: Coercible T.Text a => NameSpaces -> Element -> Maybe a
getElementStyleName :: NameSpaces -> Element -> Maybe a
getElementStyleName NameSpaces
ns Element
el = Text -> a
coerce (Text -> a) -> Maybe Text -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ((NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"name" Element
el Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"val")
  Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"styleId" Element
el)

getNumInfo :: NameSpaces -> Element -> Maybe (T.Text, T.Text)
getNumInfo :: NameSpaces -> Element -> Maybe (Text, Text)
getNumInfo NameSpaces
ns Element
element = do
  let numPr :: Maybe Element
numPr = NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"pPr" Element
element Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
              NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"numPr"
      lvl :: Text
lvl = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"0" (Maybe Element
numPr Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                           NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"ilvl" Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                           NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"val")
  Text
numId <- Maybe Element
numPr Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
           NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"numId" Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
           NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"val"
  (Text, Text) -> Maybe (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
numId, Text
lvl)

elemToParStyleData :: NameSpaces -> Element -> Maybe ParStyle -> Maybe ParStyle
elemToParStyleData :: NameSpaces -> Element -> Maybe ParStyle -> Maybe ParStyle
elemToParStyleData NameSpaces
ns Element
element Maybe ParStyle
parentStyle
  | Just Text
styleId <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"styleId" Element
element
  , Just ParaStyleName
styleName <- NameSpaces -> Element -> Maybe ParaStyleName
forall a. Coercible Text a => NameSpaces -> Element -> Maybe a
getElementStyleName NameSpaces
ns Element
element
  = ParStyle -> Maybe ParStyle
forall a. a -> Maybe a
Just (ParStyle -> Maybe ParStyle) -> ParStyle -> Maybe ParStyle
forall a b. (a -> b) -> a -> b
$ ParStyle :: Maybe (ParaStyleName, Int)
-> Maybe ParIndentation
-> Maybe (Text, Text)
-> Maybe ParStyle
-> ParaStyleName
-> ParaStyleId
-> ParStyle
ParStyle
      {
        headingLev :: Maybe (ParaStyleName, Int)
headingLev = NameSpaces -> Element -> Maybe (ParaStyleName, Int)
getHeaderLevel NameSpaces
ns Element
element
      , indent :: Maybe ParIndentation
indent = NameSpaces -> Element -> Maybe ParIndentation
getIndentation NameSpaces
ns Element
element
      , numInfo :: Maybe (Text, Text)
numInfo = NameSpaces -> Element -> Maybe (Text, Text)
getNumInfo NameSpaces
ns Element
element
      , psParentStyle :: Maybe ParStyle
psParentStyle = Maybe ParStyle
parentStyle
      , pStyleName :: ParaStyleName
pStyleName = ParaStyleName
styleName
      , pStyleId :: ParaStyleId
pStyleId = Text -> ParaStyleId
ParaStyleId Text
styleId
      }
elemToParStyleData NameSpaces
_ Element
_ Maybe ParStyle
_ = Maybe ParStyle
forall a. Maybe a
Nothing