{-# LANGUAGE ViewPatterns      #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
 Module : Text.Pandoc.Readers.Docx.Parse
 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

Conversion of docx archive into Docx haskell type
-}

module Text.Pandoc.Readers.Docx.Parse ( Docx(..)
                                      , Document(..)
                                      , Body(..)
                                      , BodyPart(..)
                                      , TblLook(..)
                                      , Extent
                                      , ParPart(..)
                                      , Run(..)
                                      , RunElem(..)
                                      , Notes
                                      , Numbering
                                      , Relationship
                                      , Media
                                      , RunStyle(..)
                                      , VertAlign(..)
                                      , ParIndentation(..)
                                      , ParagraphStyle(..)
                                      , ParStyle
                                      , CharStyle(cStyleData)
                                      , Row(..)
                                      , TblHeader(..)
                                      , Cell(..)
                                      , VMerge(..)
                                      , TrackedChange(..)
                                      , ChangeType(..)
                                      , ChangeInfo(..)
                                      , FieldInfo(..)
                                      , Level(..)
                                      , ParaStyleName
                                      , CharStyleName
                                      , FromStyleName(..)
                                      , HasStyleName(..)
                                      , HasParentStyle(..)
                                      , archiveToDocx
                                      , archiveToDocxWithWarnings
                                      , getStyleNames
                                      , pHeading
                                      , pStyleIndentation
                                      , constructBogusParStyleData
                                      , leftBiasedMergeRunStyle
                                      , rowsToRowspans
                                      ) where
import Text.Pandoc.Readers.Docx.Parse.Styles
import Codec.Archive.Zip
import Control.Applicative ((<|>))
import Control.Monad
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.State.Strict
import Data.Bits ((.|.))
import qualified Data.ByteString.Lazy as B
import Data.Char (chr, ord, readLitChar)
import Data.List
import qualified Data.Map as M
import qualified Data.Text as T
import Data.Text (Text)
import Data.Maybe
import System.FilePath
import Text.Pandoc.Readers.Docx.Util
import Text.Pandoc.Readers.Docx.Fields
import Text.Pandoc.Shared (filteredFilesFromArchive, safeRead)
import qualified Text.Pandoc.UTF8 as UTF8
import Text.TeXMath (Exp)
import Text.TeXMath.Readers.OMML (readOMML)
import Text.TeXMath.Unicode.Fonts (Font (..), getUnicode, textToFont)
import Text.Pandoc.XML.Light
    ( filterChild,
      findElement,
      strContent,
      showElement,
      findAttr,
      filterChildrenName,
      filterElementName,
      parseXMLElement,
      elChildren,
      QName(QName, qName),
      Content(Elem),
      Element(elContent, elName),
      findElements )

data ReaderEnv = ReaderEnv { ReaderEnv -> Notes
envNotes         :: Notes
                           , ReaderEnv -> Comments
envComments      :: Comments
                           , ReaderEnv -> Numbering
envNumbering     :: Numbering
                           , ReaderEnv -> [Relationship]
envRelationships :: [Relationship]
                           , ReaderEnv -> Media
envMedia         :: Media
                           , ReaderEnv -> Maybe Font
envFont          :: Maybe Font
                           , ReaderEnv -> CharStyleMap
envCharStyles    :: CharStyleMap
                           , ReaderEnv -> ParStyleMap
envParStyles     :: ParStyleMap
                           , ReaderEnv -> DocumentLocation
envLocation      :: DocumentLocation
                           , ReaderEnv -> [Char]
envDocXmlPath    :: FilePath
                           }
               deriving Int -> ReaderEnv -> ShowS
[ReaderEnv] -> ShowS
ReaderEnv -> [Char]
(Int -> ReaderEnv -> ShowS)
-> (ReaderEnv -> [Char])
-> ([ReaderEnv] -> ShowS)
-> Show ReaderEnv
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReaderEnv -> ShowS
showsPrec :: Int -> ReaderEnv -> ShowS
$cshow :: ReaderEnv -> [Char]
show :: ReaderEnv -> [Char]
$cshowList :: [ReaderEnv] -> ShowS
showList :: [ReaderEnv] -> ShowS
Show

data ReaderState = ReaderState { ReaderState -> [Text]
stateWarnings :: [T.Text]
                               , ReaderState -> [FldCharState]
stateFldCharState :: [FldCharState]
                               }
                 deriving Int -> ReaderState -> ShowS
[ReaderState] -> ShowS
ReaderState -> [Char]
(Int -> ReaderState -> ShowS)
-> (ReaderState -> [Char])
-> ([ReaderState] -> ShowS)
-> Show ReaderState
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReaderState -> ShowS
showsPrec :: Int -> ReaderState -> ShowS
$cshow :: ReaderState -> [Char]
show :: ReaderState -> [Char]
$cshowList :: [ReaderState] -> ShowS
showList :: [ReaderState] -> ShowS
Show

data FldCharState = FldCharOpen
                  | FldCharFieldInfo FieldInfo
                  | FldCharContent FieldInfo [ParPart]
                  deriving (Int -> FldCharState -> ShowS
[FldCharState] -> ShowS
FldCharState -> [Char]
(Int -> FldCharState -> ShowS)
-> (FldCharState -> [Char])
-> ([FldCharState] -> ShowS)
-> Show FldCharState
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FldCharState -> ShowS
showsPrec :: Int -> FldCharState -> ShowS
$cshow :: FldCharState -> [Char]
show :: FldCharState -> [Char]
$cshowList :: [FldCharState] -> ShowS
showList :: [FldCharState] -> ShowS
Show)

data DocxError = DocxError
               | WrongElem
               deriving Int -> DocxError -> ShowS
[DocxError] -> ShowS
DocxError -> [Char]
(Int -> DocxError -> ShowS)
-> (DocxError -> [Char])
-> ([DocxError] -> ShowS)
-> Show DocxError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DocxError -> ShowS
showsPrec :: Int -> DocxError -> ShowS
$cshow :: DocxError -> [Char]
show :: DocxError -> [Char]
$cshowList :: [DocxError] -> ShowS
showList :: [DocxError] -> ShowS
Show

type D = ExceptT DocxError (ReaderT ReaderEnv (State ReaderState))

runD :: D a -> ReaderEnv -> ReaderState -> (Either DocxError a, ReaderState)
runD :: forall a.
D a
-> ReaderEnv -> ReaderState -> (Either DocxError a, ReaderState)
runD D a
dx ReaderEnv
re ReaderState
rs = State ReaderState (Either DocxError a)
-> ReaderState -> (Either DocxError a, ReaderState)
forall s a. State s a -> s -> (a, s)
runState (ReaderT ReaderEnv (State ReaderState) (Either DocxError a)
-> ReaderEnv -> State ReaderState (Either DocxError a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (D a -> ReaderT ReaderEnv (State ReaderState) (Either DocxError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT D a
dx) ReaderEnv
re) ReaderState
rs

maybeToD :: Maybe a -> D a
maybeToD :: forall a. Maybe a -> D a
maybeToD (Just a
a) = a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
maybeToD Maybe a
Nothing  = DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
DocxError

eitherToD :: Either a b -> D b
eitherToD :: forall a b. Either a b -> D b
eitherToD (Right b
b) = b -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) b
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
eitherToD (Left a
_)  = DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) b
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
DocxError

concatMapM        :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
concatMapM :: forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM a -> m [b]
f [a]
xs   =  ([[b]] -> [b]) -> m [[b]] -> m [b]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [[b]] -> [b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((a -> m [b]) -> [a] -> m [[b]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM a -> m [b]
f [a]
xs)

-- This is similar to `mapMaybe`: it maps a function returning the D
-- monad over a list, and only keeps the non-erroring return values.
mapD :: (a -> D b) -> [a] -> D [b]
mapD :: forall a b. (a -> D b) -> [a] -> D [b]
mapD a -> D b
f [a]
xs =
  let handler :: a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) [b]
handler a
x = (a -> D b
f a
x D b
-> (b
    -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) [b])
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) [b]
forall a b.
ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
-> (a
    -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) b)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\b
y-> [b]
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) [b]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [b
y])) ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) [b]
-> (DocxError
    -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) [b])
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) [b]
forall a.
ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
-> (DocxError
    -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (\DocxError
_ -> [b]
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) [b]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
  in
   (a
 -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) [b])
-> [a]
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) [b]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) [b]
handler [a]
xs

unwrapElement :: NameSpaces -> Element -> [Element]
unwrapElement :: NameSpaces -> Element -> [Element]
unwrapElement NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"sdt" Element
element
  , Just Element
sdtContent <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"sdtContent" Element
element
  = (Element -> [Element]) -> [Element] -> [Element]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NameSpaces -> Element -> [Element]
unwrapElement NameSpaces
ns) (Element -> [Element]
elChildren Element
sdtContent)
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"smartTag" Element
element
  = (Element -> [Element]) -> [Element] -> [Element]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NameSpaces -> Element -> [Element]
unwrapElement NameSpaces
ns) (Element -> [Element]
elChildren Element
element)
  | Bool
otherwise
  = [Element
element{ elContent :: [Content]
elContent = (Content -> [Content]) -> [Content] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NameSpaces -> Content -> [Content]
unwrapContent NameSpaces
ns) (Element -> [Content]
elContent Element
element) }]

unwrapContent :: NameSpaces -> Content -> [Content]
unwrapContent :: NameSpaces -> Content -> [Content]
unwrapContent NameSpaces
ns (Elem Element
element) = (Element -> Content) -> [Element] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Content
Elem ([Element] -> [Content]) -> [Element] -> [Content]
forall a b. (a -> b) -> a -> b
$ NameSpaces -> Element -> [Element]
unwrapElement NameSpaces
ns Element
element
unwrapContent NameSpaces
_ Content
content = [Content
content]

walkDocument :: NameSpaces -> Element -> Element
walkDocument :: NameSpaces -> Element -> Element
walkDocument NameSpaces
ns Element
element =
  Element
element{ elContent :: [Content]
elContent = (Content -> [Content]) -> [Content] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NameSpaces -> Content -> [Content]
unwrapContent NameSpaces
ns) (Element -> [Content]
elContent Element
element) }

newtype Docx = Docx Document
          deriving Int -> Docx -> ShowS
[Docx] -> ShowS
Docx -> [Char]
(Int -> Docx -> ShowS)
-> (Docx -> [Char]) -> ([Docx] -> ShowS) -> Show Docx
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Docx -> ShowS
showsPrec :: Int -> Docx -> ShowS
$cshow :: Docx -> [Char]
show :: Docx -> [Char]
$cshowList :: [Docx] -> ShowS
showList :: [Docx] -> ShowS
Show

data Document = Document NameSpaces Body
          deriving Int -> Document -> ShowS
[Document] -> ShowS
Document -> [Char]
(Int -> Document -> ShowS)
-> (Document -> [Char]) -> ([Document] -> ShowS) -> Show Document
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Document -> ShowS
showsPrec :: Int -> Document -> ShowS
$cshow :: Document -> [Char]
show :: Document -> [Char]
$cshowList :: [Document] -> ShowS
showList :: [Document] -> ShowS
Show

newtype Body = Body [BodyPart]
          deriving Int -> Body -> ShowS
[Body] -> ShowS
Body -> [Char]
(Int -> Body -> ShowS)
-> (Body -> [Char]) -> ([Body] -> ShowS) -> Show Body
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Body -> ShowS
showsPrec :: Int -> Body -> ShowS
$cshow :: Body -> [Char]
show :: Body -> [Char]
$cshowList :: [Body] -> ShowS
showList :: [Body] -> ShowS
Show

type Media = [(FilePath, B.ByteString)]

type CharStyleMap = M.Map CharStyleId CharStyle

type ParStyleMap = M.Map ParaStyleId ParStyle

data Numbering = Numbering NameSpaces [Numb] [AbstractNumb]
                 deriving Int -> Numbering -> ShowS
[Numbering] -> ShowS
Numbering -> [Char]
(Int -> Numbering -> ShowS)
-> (Numbering -> [Char])
-> ([Numbering] -> ShowS)
-> Show Numbering
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Numbering -> ShowS
showsPrec :: Int -> Numbering -> ShowS
$cshow :: Numbering -> [Char]
show :: Numbering -> [Char]
$cshowList :: [Numbering] -> ShowS
showList :: [Numbering] -> ShowS
Show

data Numb = Numb T.Text T.Text [LevelOverride]
            deriving Int -> Numb -> ShowS
[Numb] -> ShowS
Numb -> [Char]
(Int -> Numb -> ShowS)
-> (Numb -> [Char]) -> ([Numb] -> ShowS) -> Show Numb
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Numb -> ShowS
showsPrec :: Int -> Numb -> ShowS
$cshow :: Numb -> [Char]
show :: Numb -> [Char]
$cshowList :: [Numb] -> ShowS
showList :: [Numb] -> ShowS
Show

--                                 ilvl    startOverride   lvl
data LevelOverride = LevelOverride T.Text (Maybe Integer) (Maybe Level)
  deriving Int -> LevelOverride -> ShowS
[LevelOverride] -> ShowS
LevelOverride -> [Char]
(Int -> LevelOverride -> ShowS)
-> (LevelOverride -> [Char])
-> ([LevelOverride] -> ShowS)
-> Show LevelOverride
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LevelOverride -> ShowS
showsPrec :: Int -> LevelOverride -> ShowS
$cshow :: LevelOverride -> [Char]
show :: LevelOverride -> [Char]
$cshowList :: [LevelOverride] -> ShowS
showList :: [LevelOverride] -> ShowS
Show

data AbstractNumb = AbstractNumb T.Text [Level]
                    deriving Int -> AbstractNumb -> ShowS
[AbstractNumb] -> ShowS
AbstractNumb -> [Char]
(Int -> AbstractNumb -> ShowS)
-> (AbstractNumb -> [Char])
-> ([AbstractNumb] -> ShowS)
-> Show AbstractNumb
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AbstractNumb -> ShowS
showsPrec :: Int -> AbstractNumb -> ShowS
$cshow :: AbstractNumb -> [Char]
show :: AbstractNumb -> [Char]
$cshowList :: [AbstractNumb] -> ShowS
showList :: [AbstractNumb] -> ShowS
Show

--                 ilvl   format string  start
data Level = Level T.Text T.Text T.Text (Maybe Integer)
  deriving Int -> Level -> ShowS
[Level] -> ShowS
Level -> [Char]
(Int -> Level -> ShowS)
-> (Level -> [Char]) -> ([Level] -> ShowS) -> Show Level
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Level -> ShowS
showsPrec :: Int -> Level -> ShowS
$cshow :: Level -> [Char]
show :: Level -> [Char]
$cshowList :: [Level] -> ShowS
showList :: [Level] -> ShowS
Show

data DocumentLocation = InDocument | InFootnote | InEndnote
                      deriving (DocumentLocation -> DocumentLocation -> Bool
(DocumentLocation -> DocumentLocation -> Bool)
-> (DocumentLocation -> DocumentLocation -> Bool)
-> Eq DocumentLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DocumentLocation -> DocumentLocation -> Bool
== :: DocumentLocation -> DocumentLocation -> Bool
$c/= :: DocumentLocation -> DocumentLocation -> Bool
/= :: DocumentLocation -> DocumentLocation -> Bool
Eq,Int -> DocumentLocation -> ShowS
[DocumentLocation] -> ShowS
DocumentLocation -> [Char]
(Int -> DocumentLocation -> ShowS)
-> (DocumentLocation -> [Char])
-> ([DocumentLocation] -> ShowS)
-> Show DocumentLocation
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DocumentLocation -> ShowS
showsPrec :: Int -> DocumentLocation -> ShowS
$cshow :: DocumentLocation -> [Char]
show :: DocumentLocation -> [Char]
$cshowList :: [DocumentLocation] -> ShowS
showList :: [DocumentLocation] -> ShowS
Show)

data Relationship = Relationship DocumentLocation RelId Target
                  deriving Int -> Relationship -> ShowS
[Relationship] -> ShowS
Relationship -> [Char]
(Int -> Relationship -> ShowS)
-> (Relationship -> [Char])
-> ([Relationship] -> ShowS)
-> Show Relationship
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Relationship -> ShowS
showsPrec :: Int -> Relationship -> ShowS
$cshow :: Relationship -> [Char]
show :: Relationship -> [Char]
$cshowList :: [Relationship] -> ShowS
showList :: [Relationship] -> ShowS
Show

data Notes = Notes NameSpaces
             (Maybe (M.Map T.Text Element))
             (Maybe (M.Map T.Text Element))
           deriving Int -> Notes -> ShowS
[Notes] -> ShowS
Notes -> [Char]
(Int -> Notes -> ShowS)
-> (Notes -> [Char]) -> ([Notes] -> ShowS) -> Show Notes
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Notes -> ShowS
showsPrec :: Int -> Notes -> ShowS
$cshow :: Notes -> [Char]
show :: Notes -> [Char]
$cshowList :: [Notes] -> ShowS
showList :: [Notes] -> ShowS
Show

data Comments = Comments NameSpaces (M.Map T.Text Element)
              deriving Int -> Comments -> ShowS
[Comments] -> ShowS
Comments -> [Char]
(Int -> Comments -> ShowS)
-> (Comments -> [Char]) -> ([Comments] -> ShowS) -> Show Comments
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Comments -> ShowS
showsPrec :: Int -> Comments -> ShowS
$cshow :: Comments -> [Char]
show :: Comments -> [Char]
$cshowList :: [Comments] -> ShowS
showList :: [Comments] -> ShowS
Show

data ChangeType = Insertion | Deletion
                deriving Int -> ChangeType -> ShowS
[ChangeType] -> ShowS
ChangeType -> [Char]
(Int -> ChangeType -> ShowS)
-> (ChangeType -> [Char])
-> ([ChangeType] -> ShowS)
-> Show ChangeType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChangeType -> ShowS
showsPrec :: Int -> ChangeType -> ShowS
$cshow :: ChangeType -> [Char]
show :: ChangeType -> [Char]
$cshowList :: [ChangeType] -> ShowS
showList :: [ChangeType] -> ShowS
Show

data ChangeInfo = ChangeInfo ChangeId Author (Maybe ChangeDate)
                deriving Int -> ChangeInfo -> ShowS
[ChangeInfo] -> ShowS
ChangeInfo -> [Char]
(Int -> ChangeInfo -> ShowS)
-> (ChangeInfo -> [Char])
-> ([ChangeInfo] -> ShowS)
-> Show ChangeInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChangeInfo -> ShowS
showsPrec :: Int -> ChangeInfo -> ShowS
$cshow :: ChangeInfo -> [Char]
show :: ChangeInfo -> [Char]
$cshowList :: [ChangeInfo] -> ShowS
showList :: [ChangeInfo] -> ShowS
Show

data TrackedChange = TrackedChange ChangeType ChangeInfo
                   deriving Int -> TrackedChange -> ShowS
[TrackedChange] -> ShowS
TrackedChange -> [Char]
(Int -> TrackedChange -> ShowS)
-> (TrackedChange -> [Char])
-> ([TrackedChange] -> ShowS)
-> Show TrackedChange
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TrackedChange -> ShowS
showsPrec :: Int -> TrackedChange -> ShowS
$cshow :: TrackedChange -> [Char]
show :: TrackedChange -> [Char]
$cshowList :: [TrackedChange] -> ShowS
showList :: [TrackedChange] -> ShowS
Show

data ParagraphStyle = ParagraphStyle { ParagraphStyle -> [ParStyle]
pStyle      :: [ParStyle]
                                     , ParagraphStyle -> Maybe ParIndentation
indentation :: Maybe ParIndentation
                                     , ParagraphStyle -> Bool
numbered    :: Bool
                                     , ParagraphStyle -> Bool
dropCap     :: Bool
                                     , ParagraphStyle -> Maybe TrackedChange
pChange     :: Maybe TrackedChange
                                     , ParagraphStyle -> Maybe Bool
pBidi       :: Maybe Bool
                                     }
                      deriving Int -> ParagraphStyle -> ShowS
[ParagraphStyle] -> ShowS
ParagraphStyle -> [Char]
(Int -> ParagraphStyle -> ShowS)
-> (ParagraphStyle -> [Char])
-> ([ParagraphStyle] -> ShowS)
-> Show ParagraphStyle
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParagraphStyle -> ShowS
showsPrec :: Int -> ParagraphStyle -> ShowS
$cshow :: ParagraphStyle -> [Char]
show :: ParagraphStyle -> [Char]
$cshowList :: [ParagraphStyle] -> ShowS
showList :: [ParagraphStyle] -> ShowS
Show

defaultParagraphStyle :: ParagraphStyle
defaultParagraphStyle :: ParagraphStyle
defaultParagraphStyle = ParagraphStyle { pStyle :: [ParStyle]
pStyle = []
                                       , indentation :: Maybe ParIndentation
indentation = Maybe ParIndentation
forall a. Maybe a
Nothing
                                       , numbered :: Bool
numbered    = Bool
False
                                       , dropCap :: Bool
dropCap     = Bool
False
                                       , pChange :: Maybe TrackedChange
pChange     = Maybe TrackedChange
forall a. Maybe a
Nothing
                                       , pBidi :: Maybe Bool
pBidi       = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
                                       }


data BodyPart = Paragraph ParagraphStyle [ParPart]
              | ListItem ParagraphStyle T.Text T.Text (Maybe Level) [ParPart]
              | Tbl T.Text TblGrid TblLook [Row]
              | TblCaption ParagraphStyle [ParPart]
              deriving Int -> BodyPart -> ShowS
[BodyPart] -> ShowS
BodyPart -> [Char]
(Int -> BodyPart -> ShowS)
-> (BodyPart -> [Char]) -> ([BodyPart] -> ShowS) -> Show BodyPart
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BodyPart -> ShowS
showsPrec :: Int -> BodyPart -> ShowS
$cshow :: BodyPart -> [Char]
show :: BodyPart -> [Char]
$cshowList :: [BodyPart] -> ShowS
showList :: [BodyPart] -> ShowS
Show

type TblGrid = [Integer]

newtype TblLook = TblLook {TblLook -> Bool
firstRowFormatting::Bool}
              deriving Int -> TblLook -> ShowS
[TblLook] -> ShowS
TblLook -> [Char]
(Int -> TblLook -> ShowS)
-> (TblLook -> [Char]) -> ([TblLook] -> ShowS) -> Show TblLook
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TblLook -> ShowS
showsPrec :: Int -> TblLook -> ShowS
$cshow :: TblLook -> [Char]
show :: TblLook -> [Char]
$cshowList :: [TblLook] -> ShowS
showList :: [TblLook] -> ShowS
Show

defaultTblLook :: TblLook
defaultTblLook :: TblLook
defaultTblLook = TblLook{firstRowFormatting :: Bool
firstRowFormatting = Bool
False}

data Row = Row TblHeader [Cell] deriving Int -> Row -> ShowS
[Row] -> ShowS
Row -> [Char]
(Int -> Row -> ShowS)
-> (Row -> [Char]) -> ([Row] -> ShowS) -> Show Row
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Row -> ShowS
showsPrec :: Int -> Row -> ShowS
$cshow :: Row -> [Char]
show :: Row -> [Char]
$cshowList :: [Row] -> ShowS
showList :: [Row] -> ShowS
Show

data TblHeader = HasTblHeader | NoTblHeader deriving (Int -> TblHeader -> ShowS
[TblHeader] -> ShowS
TblHeader -> [Char]
(Int -> TblHeader -> ShowS)
-> (TblHeader -> [Char])
-> ([TblHeader] -> ShowS)
-> Show TblHeader
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TblHeader -> ShowS
showsPrec :: Int -> TblHeader -> ShowS
$cshow :: TblHeader -> [Char]
show :: TblHeader -> [Char]
$cshowList :: [TblHeader] -> ShowS
showList :: [TblHeader] -> ShowS
Show, TblHeader -> TblHeader -> Bool
(TblHeader -> TblHeader -> Bool)
-> (TblHeader -> TblHeader -> Bool) -> Eq TblHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TblHeader -> TblHeader -> Bool
== :: TblHeader -> TblHeader -> Bool
$c/= :: TblHeader -> TblHeader -> Bool
/= :: TblHeader -> TblHeader -> Bool
Eq)

data Cell = Cell GridSpan VMerge [BodyPart]
            deriving Int -> Cell -> ShowS
[Cell] -> ShowS
Cell -> [Char]
(Int -> Cell -> ShowS)
-> (Cell -> [Char]) -> ([Cell] -> ShowS) -> Show Cell
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cell -> ShowS
showsPrec :: Int -> Cell -> ShowS
$cshow :: Cell -> [Char]
show :: Cell -> [Char]
$cshowList :: [Cell] -> ShowS
showList :: [Cell] -> ShowS
Show

type GridSpan = Integer

data VMerge = Continue
            -- ^ This cell should be merged with the one above it
            | Restart
            -- ^ This cell should not be merged with the one above it
            deriving (Int -> VMerge -> ShowS
[VMerge] -> ShowS
VMerge -> [Char]
(Int -> VMerge -> ShowS)
-> (VMerge -> [Char]) -> ([VMerge] -> ShowS) -> Show VMerge
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VMerge -> ShowS
showsPrec :: Int -> VMerge -> ShowS
$cshow :: VMerge -> [Char]
show :: VMerge -> [Char]
$cshowList :: [VMerge] -> ShowS
showList :: [VMerge] -> ShowS
Show, VMerge -> VMerge -> Bool
(VMerge -> VMerge -> Bool)
-> (VMerge -> VMerge -> Bool) -> Eq VMerge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VMerge -> VMerge -> Bool
== :: VMerge -> VMerge -> Bool
$c/= :: VMerge -> VMerge -> Bool
/= :: VMerge -> VMerge -> Bool
Eq)

rowsToRowspans :: [Row] -> [[(Int, Cell)]]
rowsToRowspans :: [Row] -> [[(Int, Cell)]]
rowsToRowspans [Row]
rows = let
  removeMergedCells :: [[(a, Cell)]] -> [[(a, Cell)]]
removeMergedCells = ([(a, Cell)] -> [(a, Cell)]) -> [[(a, Cell)]] -> [[(a, Cell)]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((a, Cell) -> Bool) -> [(a, Cell)] -> [(a, Cell)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(a
_, Cell GridSpan
_ VMerge
vmerge [BodyPart]
_) -> VMerge
vmerge VMerge -> VMerge -> Bool
forall a. Eq a => a -> a -> Bool
== VMerge
Restart))
  in [[(Int, Cell)]] -> [[(Int, Cell)]]
forall {a}. [[(a, Cell)]] -> [[(a, Cell)]]
removeMergedCells ((Row -> [[(Int, Cell)]] -> [[(Int, Cell)]])
-> [[(Int, Cell)]] -> [Row] -> [[(Int, Cell)]]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Row -> [[(Int, Cell)]] -> [[(Int, Cell)]]
f [] [Row]
rows)
  where
    f :: Row -> [[(Int, Cell)]] -> [[(Int, Cell)]]
    f :: Row -> [[(Int, Cell)]] -> [[(Int, Cell)]]
f (Row TblHeader
_ [Cell]
cells) [[(Int, Cell)]]
acc = let
      spans :: [(Int, Cell)]
spans = [Cell] -> Maybe GridSpan -> Maybe [(Int, Cell)] -> [(Int, Cell)]
g [Cell]
cells Maybe GridSpan
forall a. Maybe a
Nothing ([[(Int, Cell)]] -> Maybe [(Int, Cell)]
forall a. [a] -> Maybe a
listToMaybe [[(Int, Cell)]]
acc)
      in [(Int, Cell)]
spans [(Int, Cell)] -> [[(Int, Cell)]] -> [[(Int, Cell)]]
forall a. a -> [a] -> [a]
: [[(Int, Cell)]]
acc

    g :: [Cell] -- the current row
      -> Maybe Integer -- Number of columns left below
      -> Maybe [(Int, Cell)] -- (rowspan so far, cell) for the row below this one
      -> [(Int, Cell)] -- (rowspan so far, cell) for this row
    g :: [Cell] -> Maybe GridSpan -> Maybe [(Int, Cell)] -> [(Int, Cell)]
g [Cell]
cells Maybe GridSpan
_ Maybe [(Int, Cell)]
Nothing = (Cell -> (Int, Cell)) -> [Cell] -> [(Int, Cell)]
forall a b. (a -> b) -> [a] -> [b]
map (Int
1,) [Cell]
cells
    g [Cell]
cells Maybe GridSpan
columnsLeftBelow (Just [(Int, Cell)]
rowBelow) =
        case [Cell]
cells of
          [] -> []
          thisCell :: Cell
thisCell@(Cell GridSpan
thisGridSpan VMerge
_ [BodyPart]
_) : [Cell]
restOfRow -> case [(Int, Cell)]
rowBelow of
            [] -> (Cell -> (Int, Cell)) -> [Cell] -> [(Int, Cell)]
forall a b. (a -> b) -> [a] -> [b]
map (Int
1,) [Cell]
cells
            (Int
spanSoFarBelow, Cell GridSpan
gridSpanBelow VMerge
vmerge [BodyPart]
_) : [(Int, Cell)]
_ ->
              let spanSoFar :: Int
spanSoFar = case VMerge
vmerge of
                    VMerge
Restart -> Int
1
                    VMerge
Continue -> Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
spanSoFarBelow
                  columnsToDrop :: GridSpan
columnsToDrop = GridSpan
thisGridSpan GridSpan -> GridSpan -> GridSpan
forall a. Num a => a -> a -> a
+ (GridSpan
gridSpanBelow GridSpan -> GridSpan -> GridSpan
forall a. Num a => a -> a -> a
- GridSpan -> Maybe GridSpan -> GridSpan
forall a. a -> Maybe a -> a
fromMaybe GridSpan
gridSpanBelow Maybe GridSpan
columnsLeftBelow)
                  (GridSpan
newColumnsLeftBelow, [(Int, Cell)]
restOfRowBelow) = GridSpan -> [(Int, Cell)] -> (GridSpan, [(Int, Cell)])
forall a. GridSpan -> [(a, Cell)] -> (GridSpan, [(a, Cell)])
dropColumns GridSpan
columnsToDrop [(Int, Cell)]
rowBelow
              in (Int
spanSoFar, Cell
thisCell) (Int, Cell) -> [(Int, Cell)] -> [(Int, Cell)]
forall a. a -> [a] -> [a]
: [Cell] -> Maybe GridSpan -> Maybe [(Int, Cell)] -> [(Int, Cell)]
g [Cell]
restOfRow (GridSpan -> Maybe GridSpan
forall a. a -> Maybe a
Just GridSpan
newColumnsLeftBelow) ([(Int, Cell)] -> Maybe [(Int, Cell)]
forall a. a -> Maybe a
Just [(Int, Cell)]
restOfRowBelow)

    dropColumns :: Integer -> [(a, Cell)] -> (Integer, [(a, Cell)])
    dropColumns :: forall a. GridSpan -> [(a, Cell)] -> (GridSpan, [(a, Cell)])
dropColumns GridSpan
n [] = (GridSpan
n, [])
    dropColumns GridSpan
n cells :: [(a, Cell)]
cells@((a
_, Cell GridSpan
gridSpan VMerge
_ [BodyPart]
_) : [(a, Cell)]
otherCells) =
      if GridSpan
n GridSpan -> GridSpan -> Bool
forall a. Ord a => a -> a -> Bool
< GridSpan
gridSpan
      then (GridSpan
gridSpan GridSpan -> GridSpan -> GridSpan
forall a. Num a => a -> a -> a
- GridSpan
n, [(a, Cell)]
cells)
      else GridSpan -> [(a, Cell)] -> (GridSpan, [(a, Cell)])
forall a. GridSpan -> [(a, Cell)] -> (GridSpan, [(a, Cell)])
dropColumns (GridSpan
n GridSpan -> GridSpan -> GridSpan
forall a. Num a => a -> a -> a
- GridSpan
gridSpan) [(a, Cell)]
otherCells

leftBiasedMergeRunStyle :: RunStyle -> RunStyle -> RunStyle
leftBiasedMergeRunStyle :: RunStyle -> RunStyle -> RunStyle
leftBiasedMergeRunStyle RunStyle
a RunStyle
b = RunStyle
    { isBold :: Maybe Bool
isBold = RunStyle -> Maybe Bool
isBold RunStyle
a Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RunStyle -> Maybe Bool
isBold RunStyle
b
    , isBoldCTL :: Maybe Bool
isBoldCTL = RunStyle -> Maybe Bool
isBoldCTL RunStyle
a Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RunStyle -> Maybe Bool
isBoldCTL RunStyle
b
    , isItalic :: Maybe Bool
isItalic = RunStyle -> Maybe Bool
isItalic RunStyle
a Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RunStyle -> Maybe Bool
isItalic RunStyle
b
    , isItalicCTL :: Maybe Bool
isItalicCTL = RunStyle -> Maybe Bool
isItalicCTL RunStyle
a Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RunStyle -> Maybe Bool
isItalicCTL RunStyle
b
    , isSmallCaps :: Maybe Bool
isSmallCaps = RunStyle -> Maybe Bool
isSmallCaps RunStyle
a Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RunStyle -> Maybe Bool
isSmallCaps RunStyle
b
    , isStrike :: Maybe Bool
isStrike = RunStyle -> Maybe Bool
isStrike RunStyle
a Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RunStyle -> Maybe Bool
isStrike RunStyle
b
    , isRTL :: Maybe Bool
isRTL = RunStyle -> Maybe Bool
isRTL RunStyle
a Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RunStyle -> Maybe Bool
isRTL RunStyle
b
    , isForceCTL :: Maybe Bool
isForceCTL = RunStyle -> Maybe Bool
isForceCTL RunStyle
a Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RunStyle -> Maybe Bool
isForceCTL RunStyle
b
    , rHighlight :: Maybe Text
rHighlight = RunStyle -> Maybe Text
rHighlight RunStyle
a Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RunStyle -> Maybe Text
rHighlight RunStyle
b
    , rVertAlign :: Maybe VertAlign
rVertAlign = RunStyle -> Maybe VertAlign
rVertAlign RunStyle
a Maybe VertAlign -> Maybe VertAlign -> Maybe VertAlign
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RunStyle -> Maybe VertAlign
rVertAlign RunStyle
b
    , rUnderline :: Maybe Text
rUnderline = RunStyle -> Maybe Text
rUnderline RunStyle
a Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RunStyle -> Maybe Text
rUnderline RunStyle
b
    , rParentStyle :: Maybe CharStyle
rParentStyle = RunStyle -> Maybe CharStyle
rParentStyle RunStyle
a
    }

-- (width, height) in EMUs
type Extent = Maybe (Double, Double)

data ParPart = PlainRun Run
             | ChangedRuns TrackedChange [Run]
             | CommentStart CommentId Author (Maybe CommentDate) [BodyPart]
             | CommentEnd CommentId
             | BookMark BookMarkId Anchor
             | InternalHyperLink Anchor [ParPart]
             | ExternalHyperLink URL [ParPart]
             | Drawing FilePath T.Text T.Text B.ByteString Extent -- title, alt
             | Chart                                              -- placeholder for now
             | Diagram                                            -- placeholder for now
             | PlainOMath [Exp]
             | OMathPara [Exp]
             | Field FieldInfo [ParPart]
             deriving Int -> ParPart -> ShowS
[ParPart] -> ShowS
ParPart -> [Char]
(Int -> ParPart -> ShowS)
-> (ParPart -> [Char]) -> ([ParPart] -> ShowS) -> Show ParPart
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParPart -> ShowS
showsPrec :: Int -> ParPart -> ShowS
$cshow :: ParPart -> [Char]
show :: ParPart -> [Char]
$cshowList :: [ParPart] -> ShowS
showList :: [ParPart] -> ShowS
Show

data Run = Run RunStyle [RunElem]
         | Footnote [BodyPart]
         | Endnote [BodyPart]
         | InlineDrawing FilePath T.Text T.Text B.ByteString Extent -- title, alt
         | InlineChart          -- placeholder
         | InlineDiagram        -- placeholder
           deriving Int -> Run -> ShowS
[Run] -> ShowS
Run -> [Char]
(Int -> Run -> ShowS)
-> (Run -> [Char]) -> ([Run] -> ShowS) -> Show Run
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Run -> ShowS
showsPrec :: Int -> Run -> ShowS
$cshow :: Run -> [Char]
show :: Run -> [Char]
$cshowList :: [Run] -> ShowS
showList :: [Run] -> ShowS
Show

data RunElem = TextRun T.Text | LnBrk | Tab | SoftHyphen | NoBreakHyphen
             deriving Int -> RunElem -> ShowS
[RunElem] -> ShowS
RunElem -> [Char]
(Int -> RunElem -> ShowS)
-> (RunElem -> [Char]) -> ([RunElem] -> ShowS) -> Show RunElem
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunElem -> ShowS
showsPrec :: Int -> RunElem -> ShowS
$cshow :: RunElem -> [Char]
show :: RunElem -> [Char]
$cshowList :: [RunElem] -> ShowS
showList :: [RunElem] -> ShowS
Show

type Target = T.Text
type Anchor = T.Text
type URL = T.Text
type BookMarkId = T.Text
type RelId = T.Text
type ChangeId = T.Text
type CommentId = T.Text
type Author = T.Text
type ChangeDate = T.Text
type CommentDate = T.Text

archiveToDocx :: Archive -> Either DocxError Docx
archiveToDocx :: Archive -> Either DocxError Docx
archiveToDocx Archive
archive = (Docx, [Text]) -> Docx
forall a b. (a, b) -> a
fst ((Docx, [Text]) -> Docx)
-> Either DocxError (Docx, [Text]) -> Either DocxError Docx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Archive -> Either DocxError (Docx, [Text])
archiveToDocxWithWarnings Archive
archive

archiveToDocxWithWarnings :: Archive -> Either DocxError (Docx, [T.Text])
archiveToDocxWithWarnings :: Archive -> Either DocxError (Docx, [Text])
archiveToDocxWithWarnings Archive
archive = do
  [Char]
docXmlPath <- case Archive -> Maybe [Char]
getDocumentXmlPath Archive
archive of
    Just [Char]
fp -> [Char] -> Either DocxError [Char]
forall a b. b -> Either a b
Right [Char]
fp
    Maybe [Char]
Nothing -> DocxError -> Either DocxError [Char]
forall a b. a -> Either a b
Left DocxError
DocxError
  let notes :: Notes
notes     = Archive -> Notes
archiveToNotes Archive
archive
      comments :: Comments
comments  = Archive -> Comments
archiveToComments Archive
archive
      numbering :: Numbering
numbering = Archive -> Numbering
archiveToNumbering Archive
archive
      rels :: [Relationship]
rels      = Archive -> [Char] -> [Relationship]
archiveToRelationships Archive
archive [Char]
docXmlPath
      media :: Media
media     = Archive -> ([Char] -> Bool) -> Media
filteredFilesFromArchive Archive
archive [Char] -> Bool
filePathIsMedia
      (CharStyleMap
styles, ParStyleMap
parstyles) = Archive -> (CharStyleMap, ParStyleMap)
archiveToStyles Archive
archive
      rEnv :: ReaderEnv
rEnv = ReaderEnv { envNotes :: Notes
envNotes = Notes
notes
                       , envComments :: Comments
envComments = Comments
comments
                       , envNumbering :: Numbering
envNumbering = Numbering
numbering
                       , envRelationships :: [Relationship]
envRelationships = [Relationship]
rels
                       , envMedia :: Media
envMedia = Media
media
                       , envFont :: Maybe Font
envFont = Maybe Font
forall a. Maybe a
Nothing
                       , envCharStyles :: CharStyleMap
envCharStyles = CharStyleMap
styles
                       , envParStyles :: ParStyleMap
envParStyles = ParStyleMap
parstyles
                       , envLocation :: DocumentLocation
envLocation = DocumentLocation
InDocument
                       , envDocXmlPath :: [Char]
envDocXmlPath = [Char]
docXmlPath
                       }
      rState :: ReaderState
rState = ReaderState { stateWarnings :: [Text]
stateWarnings = []
                           , stateFldCharState :: [FldCharState]
stateFldCharState = []
                           }
      (Either DocxError Document
eitherDoc, ReaderState
st) = D Document
-> ReaderEnv
-> ReaderState
-> (Either DocxError Document, ReaderState)
forall a.
D a
-> ReaderEnv -> ReaderState -> (Either DocxError a, ReaderState)
runD (Archive -> D Document
archiveToDocument Archive
archive) ReaderEnv
rEnv ReaderState
rState
  case Either DocxError Document
eitherDoc of
    Right Document
doc -> (Docx, [Text]) -> Either DocxError (Docx, [Text])
forall a b. b -> Either a b
Right (Document -> Docx
Docx Document
doc, ReaderState -> [Text]
stateWarnings ReaderState
st)
    Left DocxError
e    -> DocxError -> Either DocxError (Docx, [Text])
forall a b. a -> Either a b
Left DocxError
e

parseXMLFromEntry :: Entry -> Maybe Element
parseXMLFromEntry :: Entry -> Maybe Element
parseXMLFromEntry Entry
entry =
  case Text -> Either Text Element
parseXMLElement (ByteString -> Text
UTF8.toTextLazy (Entry -> ByteString
fromEntry Entry
entry)) of
    Left Text
_   -> Maybe Element
forall a. Maybe a
Nothing
    Right Element
el -> Element -> Maybe Element
forall a. a -> Maybe a
Just Element
el

getDocumentXmlPath :: Archive -> Maybe FilePath
getDocumentXmlPath :: Archive -> Maybe [Char]
getDocumentXmlPath Archive
zf = do
  Entry
entry <- [Char] -> Archive -> Maybe Entry
findEntryByPath [Char]
"_rels/.rels" Archive
zf
  Element
relsElem <- Entry -> Maybe Element
parseXMLFromEntry Entry
entry
  let rels :: [Element]
rels = (QName -> Bool) -> Element -> [Element]
filterChildrenName (\QName
n -> QName -> Text
qName QName
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Relationship") Element
relsElem
  Element
rel <- (Element -> Bool) -> [Element] -> Maybe Element
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Element
e -> QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"Type" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Element
e Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
==
                       Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument")
         [Element]
rels
  Text
fp <- QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"Target" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Element
rel
  -- sometimes there will be a leading slash, which windows seems to
  -- have trouble with.
  [Char] -> Maybe [Char]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ case Text -> [Char]
T.unpack Text
fp of
    Char
'/' : [Char]
fp' -> [Char]
fp'
    [Char]
fp'       -> [Char]
fp'

archiveToDocument :: Archive -> D Document
archiveToDocument :: Archive -> D Document
archiveToDocument Archive
zf = do
  [Char]
docPath <- (ReaderEnv -> [Char])
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) [Char]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderEnv -> [Char]
envDocXmlPath
  Entry
entry <- Maybe Entry -> D Entry
forall a. Maybe a -> D a
maybeToD (Maybe Entry -> D Entry) -> Maybe Entry -> D Entry
forall a b. (a -> b) -> a -> b
$ [Char] -> Archive -> Maybe Entry
findEntryByPath [Char]
docPath Archive
zf
  Element
docElem <- Maybe Element -> D Element
forall a. Maybe a -> D a
maybeToD (Maybe Element -> D Element) -> Maybe Element -> D Element
forall a b. (a -> b) -> a -> b
$ Entry -> Maybe Element
parseXMLFromEntry Entry
entry
  let namespaces :: NameSpaces
namespaces = Element -> NameSpaces
elemToNameSpaces Element
docElem
  Element
bodyElem <- Maybe Element -> D Element
forall a. Maybe a -> D a
maybeToD (Maybe Element -> D Element) -> Maybe Element -> D Element
forall a b. (a -> b) -> a -> b
$ NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
namespaces Text
"w" Text
"body" Element
docElem
  let bodyElem' :: Element
bodyElem' = NameSpaces -> Element -> Element
walkDocument NameSpaces
namespaces Element
bodyElem
  Body
body <- NameSpaces -> Element -> D Body
elemToBody NameSpaces
namespaces Element
bodyElem'
  Document -> D Document
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Document -> D Document) -> Document -> D Document
forall a b. (a -> b) -> a -> b
$ NameSpaces -> Body -> Document
Document NameSpaces
namespaces Body
body

elemToBody :: NameSpaces -> Element -> D Body
elemToBody :: NameSpaces -> Element -> D Body
elemToBody NameSpaces
ns Element
element | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"body" Element
element =
  ([BodyPart] -> Body)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart]
-> D Body
forall a b.
(a -> b)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [BodyPart] -> Body
Body ((Element -> D BodyPart)
-> [Element]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart]
forall a b. (a -> D b) -> [a] -> D [b]
mapD (NameSpaces -> Element -> D BodyPart
elemToBodyPart NameSpaces
ns) (Element -> [Element]
elChildren Element
element))
elemToBody NameSpaces
_ Element
_ = DocxError -> D Body
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem

archiveToStyles :: Archive -> (CharStyleMap, ParStyleMap)
archiveToStyles :: Archive -> (CharStyleMap, ParStyleMap)
archiveToStyles = (CharStyle -> CharStyleId)
-> (ParStyle -> ParaStyleId)
-> Archive
-> (CharStyleMap, ParStyleMap)
forall k1 k2 a1 a2.
(Ord k1, Ord k2, ElemToStyle a1, ElemToStyle a2) =>
(a1 -> k1) -> (a2 -> k2) -> Archive -> (Map k1 a1, Map k2 a2)
archiveToStyles' CharStyle -> StyleId CharStyle
CharStyle -> CharStyleId
forall a. HasStyleId a => a -> StyleId a
getStyleId ParStyle -> StyleId ParStyle
ParStyle -> ParaStyleId
forall a. HasStyleId a => a -> StyleId a
getStyleId

class HasParentStyle a where
  getParentStyle :: a -> Maybe a

instance HasParentStyle CharStyle where
  getParentStyle :: CharStyle -> Maybe CharStyle
getParentStyle = RunStyle -> Maybe CharStyle
rParentStyle (RunStyle -> Maybe CharStyle)
-> (CharStyle -> RunStyle) -> CharStyle -> Maybe CharStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharStyle -> RunStyle
cStyleData

instance HasParentStyle ParStyle where
  getParentStyle :: ParStyle -> Maybe ParStyle
getParentStyle = ParStyle -> Maybe ParStyle
psParentStyle

getStyleNames :: (Functor t, HasStyleName a) => t a -> t (StyleName a)
getStyleNames :: forall (t :: * -> *) a.
(Functor t, HasStyleName a) =>
t a -> t (StyleName a)
getStyleNames = (a -> StyleName a) -> t a -> t (StyleName a)
forall a b. (a -> b) -> t a -> t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> StyleName a
forall a. HasStyleName a => a -> StyleName a
getStyleName

constructBogusParStyleData :: ParaStyleName -> ParStyle
constructBogusParStyleData :: ParaStyleName -> ParStyle
constructBogusParStyleData ParaStyleName
stName = ParStyle
  { headingLev :: Maybe (ParaStyleName, Int)
headingLev = Maybe (ParaStyleName, Int)
forall a. Maybe a
Nothing
  , indent :: Maybe ParIndentation
indent = Maybe ParIndentation
forall a. Maybe a
Nothing
  , numInfo :: Maybe (Text, Text)
numInfo = Maybe (Text, Text)
forall a. Maybe a
Nothing
  , psParentStyle :: Maybe ParStyle
psParentStyle = Maybe ParStyle
forall a. Maybe a
Nothing
  , pStyleName :: ParaStyleName
pStyleName = ParaStyleName
stName
  , pStyleId :: ParaStyleId
pStyleId = Text -> ParaStyleId
ParaStyleId (Text -> ParaStyleId)
-> (ParaStyleName -> Text) -> ParaStyleName -> ParaStyleId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
' ') (Text -> Text) -> (ParaStyleName -> Text) -> ParaStyleName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParaStyleName -> Text
forall a. FromStyleName a => a -> Text
fromStyleName (ParaStyleName -> ParaStyleId) -> ParaStyleName -> ParaStyleId
forall a b. (a -> b) -> a -> b
$ ParaStyleName
stName
  }

archiveToNotes :: Archive -> Notes
archiveToNotes :: Archive -> Notes
archiveToNotes Archive
zf =
  let fnElem :: Maybe Element
fnElem = [Char] -> Archive -> Maybe Entry
findEntryByPath [Char]
"word/footnotes.xml" Archive
zf
               Maybe Entry -> (Entry -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Entry -> Maybe Element
parseXMLFromEntry
      enElem :: Maybe Element
enElem = [Char] -> Archive -> Maybe Entry
findEntryByPath [Char]
"word/endnotes.xml" Archive
zf
               Maybe Entry -> (Entry -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Entry -> Maybe Element
parseXMLFromEntry
      fn_namespaces :: NameSpaces
fn_namespaces = NameSpaces
-> (Element -> NameSpaces) -> Maybe Element -> NameSpaces
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NameSpaces
forall a. Monoid a => a
mempty Element -> NameSpaces
elemToNameSpaces Maybe Element
fnElem
      en_namespaces :: NameSpaces
en_namespaces = NameSpaces
-> (Element -> NameSpaces) -> Maybe Element -> NameSpaces
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NameSpaces
forall a. Monoid a => a
mempty Element -> NameSpaces
elemToNameSpaces Maybe Element
enElem
      ns :: NameSpaces
ns = NameSpaces -> NameSpaces -> NameSpaces
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union NameSpaces
fn_namespaces NameSpaces
en_namespaces
      fn :: Maybe (Map Text Element)
fn = Maybe Element
fnElem Maybe Element
-> (Element -> Maybe (Map Text Element))
-> Maybe (Map Text Element)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> Text -> Element -> Maybe (Map Text Element)
elemToNotes NameSpaces
ns Text
"footnote" (Element -> Maybe (Map Text Element))
-> (Element -> Element) -> Element -> Maybe (Map Text Element)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSpaces -> Element -> Element
walkDocument NameSpaces
ns
      en :: Maybe (Map Text Element)
en = Maybe Element
enElem Maybe Element
-> (Element -> Maybe (Map Text Element))
-> Maybe (Map Text Element)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> Text -> Element -> Maybe (Map Text Element)
elemToNotes NameSpaces
ns Text
"endnote" (Element -> Maybe (Map Text Element))
-> (Element -> Element) -> Element -> Maybe (Map Text Element)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSpaces -> Element -> Element
walkDocument NameSpaces
ns
  in
   NameSpaces
-> Maybe (Map Text Element) -> Maybe (Map Text Element) -> Notes
Notes NameSpaces
ns Maybe (Map Text Element)
fn Maybe (Map Text Element)
en

archiveToComments :: Archive -> Comments
archiveToComments :: Archive -> Comments
archiveToComments Archive
zf =
  let cmtsElem :: Maybe Element
cmtsElem = [Char] -> Archive -> Maybe Entry
findEntryByPath [Char]
"word/comments.xml" Archive
zf
               Maybe Entry -> (Entry -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Entry -> Maybe Element
parseXMLFromEntry
      cmts_namespaces :: NameSpaces
cmts_namespaces = NameSpaces
-> (Element -> NameSpaces) -> Maybe Element -> NameSpaces
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NameSpaces
forall a. Monoid a => a
mempty Element -> NameSpaces
elemToNameSpaces Maybe Element
cmtsElem
      cmts :: Maybe (Map Text Element)
cmts = NameSpaces -> Element -> Map Text Element
elemToComments NameSpaces
cmts_namespaces (Element -> Map Text Element)
-> (Element -> Element) -> Element -> Map Text Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSpaces -> Element -> Element
walkDocument NameSpaces
cmts_namespaces (Element -> Map Text Element)
-> Maybe Element -> Maybe (Map Text Element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
               Maybe Element
cmtsElem
  in
    case Maybe (Map Text Element)
cmts of
      Just Map Text Element
c  -> NameSpaces -> Map Text Element -> Comments
Comments NameSpaces
cmts_namespaces Map Text Element
c
      Maybe (Map Text Element)
Nothing -> NameSpaces -> Map Text Element -> Comments
Comments NameSpaces
cmts_namespaces Map Text Element
forall k a. Map k a
M.empty

filePathToRelType :: FilePath -> FilePath -> Maybe DocumentLocation
filePathToRelType :: [Char] -> [Char] -> Maybe DocumentLocation
filePathToRelType [Char]
"word/_rels/footnotes.xml.rels" [Char]
_ = DocumentLocation -> Maybe DocumentLocation
forall a. a -> Maybe a
Just DocumentLocation
InFootnote
filePathToRelType [Char]
"word/_rels/endnotes.xml.rels" [Char]
_ = DocumentLocation -> Maybe DocumentLocation
forall a. a -> Maybe a
Just DocumentLocation
InEndnote
-- -- to see if it's a documentPath, we have to check against the dynamic
-- -- docPath specified in "_rels/.rels"
filePathToRelType [Char]
path [Char]
docXmlPath =
  if [Char]
path [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"word/_rels/" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
takeFileName [Char]
docXmlPath [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".rels"
  then DocumentLocation -> Maybe DocumentLocation
forall a. a -> Maybe a
Just DocumentLocation
InDocument
  else Maybe DocumentLocation
forall a. Maybe a
Nothing

relElemToRelationship :: FilePath -> DocumentLocation -> Element
                      -> Maybe Relationship
relElemToRelationship :: [Char] -> DocumentLocation -> Element -> Maybe Relationship
relElemToRelationship [Char]
fp DocumentLocation
relType Element
element | QName -> Text
qName (Element -> QName
elName Element
element) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Relationship" =
  do
    Text
relId <- QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"Id" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Element
element
    Text
target <- QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"Target" Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Element
element
    -- target may be relative (media/image1.jpeg) or absolute
    -- (/word/media/image1.jpeg); we need to relativize it (see #7374)
    let frontOfFp :: Text
frontOfFp = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'_') [Char]
fp
    let target' :: Text
target' = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
target (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$
           Text -> Text -> Maybe Text
T.stripPrefix Text
frontOfFp (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
target
    Relationship -> Maybe Relationship
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Relationship -> Maybe Relationship)
-> Relationship -> Maybe Relationship
forall a b. (a -> b) -> a -> b
$ DocumentLocation -> Text -> Text -> Relationship
Relationship DocumentLocation
relType Text
relId Text
target'
relElemToRelationship [Char]
_ DocumentLocation
_ Element
_ = Maybe Relationship
forall a. Maybe a
Nothing

filePathToRelationships :: Archive -> FilePath -> FilePath ->  [Relationship]
filePathToRelationships :: Archive -> [Char] -> [Char] -> [Relationship]
filePathToRelationships Archive
ar [Char]
docXmlPath [Char]
fp
  | Just DocumentLocation
relType <- [Char] -> [Char] -> Maybe DocumentLocation
filePathToRelType [Char]
fp [Char]
docXmlPath
  , Just Entry
entry <- [Char] -> Archive -> Maybe Entry
findEntryByPath [Char]
fp Archive
ar
  , Just Element
relElems <- Entry -> Maybe Element
parseXMLFromEntry Entry
entry =
  (Element -> Maybe Relationship) -> [Element] -> [Relationship]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Char] -> DocumentLocation -> Element -> Maybe Relationship
relElemToRelationship [Char]
fp DocumentLocation
relType) ([Element] -> [Relationship]) -> [Element] -> [Relationship]
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
relElems
filePathToRelationships Archive
_ [Char]
_ [Char]
_ = []

archiveToRelationships :: Archive -> FilePath -> [Relationship]
archiveToRelationships :: Archive -> [Char] -> [Relationship]
archiveToRelationships Archive
archive [Char]
docXmlPath =
  ([Char] -> [Relationship]) -> [[Char]] -> [Relationship]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Archive -> [Char] -> [Char] -> [Relationship]
filePathToRelationships Archive
archive [Char]
docXmlPath) ([[Char]] -> [Relationship]) -> [[Char]] -> [Relationship]
forall a b. (a -> b) -> a -> b
$ Archive -> [[Char]]
filesInArchive Archive
archive

filePathIsMedia :: FilePath -> Bool
filePathIsMedia :: [Char] -> Bool
filePathIsMedia [Char]
fp =
  [Char]
"media" [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char] -> [[Char]]
splitDirectories (ShowS
takeDirectory [Char]
fp)

lookupLevel :: T.Text -> T.Text -> Numbering -> Maybe Level
lookupLevel :: Text -> Text -> Numbering -> Maybe Level
lookupLevel Text
numId Text
ilvl (Numbering NameSpaces
_ [Numb]
numbs [AbstractNumb]
absNumbs) = do
  (Text
absNumId, [LevelOverride]
ovrrides) <- Text
-> [(Text, (Text, [LevelOverride]))]
-> Maybe (Text, [LevelOverride])
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
numId ([(Text, (Text, [LevelOverride]))]
 -> Maybe (Text, [LevelOverride]))
-> [(Text, (Text, [LevelOverride]))]
-> Maybe (Text, [LevelOverride])
forall a b. (a -> b) -> a -> b
$
                          (Numb -> (Text, (Text, [LevelOverride])))
-> [Numb] -> [(Text, (Text, [LevelOverride]))]
forall a b. (a -> b) -> [a] -> [b]
map (\(Numb Text
nid Text
absnumid [LevelOverride]
ovrRides) -> (Text
nid, (Text
absnumid, [LevelOverride]
ovrRides))) [Numb]
numbs
  [Level]
lvls <- Text -> [(Text, [Level])] -> Maybe [Level]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
absNumId ([(Text, [Level])] -> Maybe [Level])
-> [(Text, [Level])] -> Maybe [Level]
forall a b. (a -> b) -> a -> b
$
    (AbstractNumb -> (Text, [Level]))
-> [AbstractNumb] -> [(Text, [Level])]
forall a b. (a -> b) -> [a] -> [b]
map (\(AbstractNumb Text
aid [Level]
ls) -> (Text
aid, [Level]
ls)) [AbstractNumb]
absNumbs
  -- this can be a maybe, so we do a let
  let lvlOverride :: Maybe LevelOverride
lvlOverride = Text -> [(Text, LevelOverride)] -> Maybe LevelOverride
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
ilvl ([(Text, LevelOverride)] -> Maybe LevelOverride)
-> [(Text, LevelOverride)] -> Maybe LevelOverride
forall a b. (a -> b) -> a -> b
$
                    (LevelOverride -> (Text, LevelOverride))
-> [LevelOverride] -> [(Text, LevelOverride)]
forall a b. (a -> b) -> [a] -> [b]
map (\lo :: LevelOverride
lo@(LevelOverride Text
ilvl' Maybe GridSpan
_ Maybe Level
_) -> (Text
ilvl', LevelOverride
lo)) [LevelOverride]
ovrrides
  case Maybe LevelOverride
lvlOverride of
    Just (LevelOverride Text
_ Maybe GridSpan
_ (Just Level
lvl')) -> Level -> Maybe Level
forall a. a -> Maybe a
Just Level
lvl'
    Just (LevelOverride Text
_ (Just GridSpan
strt) Maybe Level
_) ->
      Text -> [(Text, Level)] -> Maybe Level
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
ilvl ([(Text, Level)] -> Maybe Level) -> [(Text, Level)] -> Maybe Level
forall a b. (a -> b) -> a -> b
$ (Level -> (Text, Level)) -> [Level] -> [(Text, Level)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Level Text
i Text
fmt Text
s Maybe GridSpan
_) -> (Text
i, Text -> Text -> Text -> Maybe GridSpan -> Level
Level Text
i Text
fmt Text
s (GridSpan -> Maybe GridSpan
forall a. a -> Maybe a
Just GridSpan
strt))) [Level]
lvls
    Maybe LevelOverride
_ ->
      Text -> [(Text, Level)] -> Maybe Level
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
ilvl ([(Text, Level)] -> Maybe Level) -> [(Text, Level)] -> Maybe Level
forall a b. (a -> b) -> a -> b
$ (Level -> (Text, Level)) -> [Level] -> [(Text, Level)]
forall a b. (a -> b) -> [a] -> [b]
map (\l :: Level
l@(Level Text
i Text
_ Text
_ Maybe GridSpan
_) -> (Text
i, Level
l)) [Level]
lvls

loElemToLevelOverride :: NameSpaces -> Element -> Maybe LevelOverride
loElemToLevelOverride :: NameSpaces -> Element -> Maybe LevelOverride
loElemToLevelOverride NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"lvlOverride" Element
element = do
      Text
ilvl <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"ilvl" Element
element
      let startOverride :: Maybe GridSpan
startOverride = NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"startOverride" Element
element
                          Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 GridSpan) -> Maybe GridSpan
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe GridSpan
stringToInteger
          lvl :: Maybe Level
lvl = NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"lvl" Element
element
                Maybe Element -> (Element -> Maybe Level) -> Maybe Level
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> Element -> Maybe Level
levelElemToLevel NameSpaces
ns
      LevelOverride -> Maybe LevelOverride
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (LevelOverride -> Maybe LevelOverride)
-> LevelOverride -> Maybe LevelOverride
forall a b. (a -> b) -> a -> b
$ Text -> Maybe GridSpan -> Maybe Level -> LevelOverride
LevelOverride Text
ilvl Maybe GridSpan
startOverride Maybe Level
lvl
loElemToLevelOverride NameSpaces
_ Element
_ = Maybe LevelOverride
forall a. Maybe a
Nothing

numElemToNum :: NameSpaces -> Element -> Maybe Numb
numElemToNum :: NameSpaces -> Element -> Maybe Numb
numElemToNum NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"num" Element
element = do
      Text
numId <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"numId" Element
element
      Text
absNumId <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"abstractNumId" Element
element
                  Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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"
      let lvlOverrides :: [LevelOverride]
lvlOverrides = (Element -> Maybe LevelOverride) -> [Element] -> [LevelOverride]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
                         (NameSpaces -> Element -> Maybe LevelOverride
loElemToLevelOverride NameSpaces
ns)
                         (NameSpaces -> Text -> Text -> Element -> [Element]
findChildrenByName NameSpaces
ns Text
"w" Text
"lvlOverride" Element
element)
      Numb -> Maybe Numb
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Numb -> Maybe Numb) -> Numb -> Maybe Numb
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [LevelOverride] -> Numb
Numb Text
numId Text
absNumId [LevelOverride]
lvlOverrides
numElemToNum NameSpaces
_ Element
_ = Maybe Numb
forall a. Maybe a
Nothing

absNumElemToAbsNum :: NameSpaces -> Element -> Maybe AbstractNumb
absNumElemToAbsNum :: NameSpaces -> Element -> Maybe AbstractNumb
absNumElemToAbsNum NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"abstractNum" Element
element = do
      Text
absNumId <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"abstractNumId" Element
element
      let levelElems :: [Element]
levelElems = NameSpaces -> Text -> Text -> Element -> [Element]
findChildrenByName NameSpaces
ns Text
"w" Text
"lvl" Element
element
          levels :: [Level]
levels = (Element -> Maybe Level) -> [Element] -> [Level]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (NameSpaces -> Element -> Maybe Level
levelElemToLevel NameSpaces
ns) [Element]
levelElems
      AbstractNumb -> Maybe AbstractNumb
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (AbstractNumb -> Maybe AbstractNumb)
-> AbstractNumb -> Maybe AbstractNumb
forall a b. (a -> b) -> a -> b
$ Text -> [Level] -> AbstractNumb
AbstractNumb Text
absNumId [Level]
levels
absNumElemToAbsNum NameSpaces
_ Element
_ = Maybe AbstractNumb
forall a. Maybe a
Nothing

levelElemToLevel :: NameSpaces -> Element -> Maybe Level
levelElemToLevel :: NameSpaces -> Element -> Maybe Level
levelElemToLevel NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"lvl" Element
element = do
      Text
ilvl <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"ilvl" Element
element
      Text
fmt <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"numFmt" Element
element
             Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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
txt <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"lvlText" Element
element
             Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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"
      let start :: Maybe GridSpan
start = NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"start" Element
element
                  Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 GridSpan) -> Maybe GridSpan
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe GridSpan
stringToInteger
      Level -> Maybe Level
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text -> Text -> Maybe GridSpan -> Level
Level Text
ilvl Text
fmt Text
txt Maybe GridSpan
start)
levelElemToLevel NameSpaces
_ Element
_ = Maybe Level
forall a. Maybe a
Nothing

archiveToNumbering' :: Archive -> Maybe Numbering
archiveToNumbering' :: Archive -> Maybe Numbering
archiveToNumbering' Archive
zf =
  case [Char] -> Archive -> Maybe Entry
findEntryByPath [Char]
"word/numbering.xml" Archive
zf of
    Maybe Entry
Nothing -> Numbering -> Maybe Numbering
forall a. a -> Maybe a
Just (Numbering -> Maybe Numbering) -> Numbering -> Maybe Numbering
forall a b. (a -> b) -> a -> b
$ NameSpaces -> [Numb] -> [AbstractNumb] -> Numbering
Numbering NameSpaces
forall a. Monoid a => a
mempty [] []
    Just Entry
entry -> do
      Element
numberingElem <- Entry -> Maybe Element
parseXMLFromEntry Entry
entry
      let namespaces :: NameSpaces
namespaces = Element -> NameSpaces
elemToNameSpaces Element
numberingElem
          numElems :: [Element]
numElems = NameSpaces -> Text -> Text -> Element -> [Element]
findChildrenByName NameSpaces
namespaces Text
"w" Text
"num" Element
numberingElem
          absNumElems :: [Element]
absNumElems = NameSpaces -> Text -> Text -> Element -> [Element]
findChildrenByName NameSpaces
namespaces Text
"w" Text
"abstractNum" Element
numberingElem
          nums :: [Numb]
nums = (Element -> Maybe Numb) -> [Element] -> [Numb]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (NameSpaces -> Element -> Maybe Numb
numElemToNum NameSpaces
namespaces) [Element]
numElems
          absNums :: [AbstractNumb]
absNums = (Element -> Maybe AbstractNumb) -> [Element] -> [AbstractNumb]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (NameSpaces -> Element -> Maybe AbstractNumb
absNumElemToAbsNum NameSpaces
namespaces) [Element]
absNumElems
      Numbering -> Maybe Numbering
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Numbering -> Maybe Numbering) -> Numbering -> Maybe Numbering
forall a b. (a -> b) -> a -> b
$ NameSpaces -> [Numb] -> [AbstractNumb] -> Numbering
Numbering NameSpaces
namespaces [Numb]
nums [AbstractNumb]
absNums

archiveToNumbering :: Archive -> Numbering
archiveToNumbering :: Archive -> Numbering
archiveToNumbering Archive
archive =
  Numbering -> Maybe Numbering -> Numbering
forall a. a -> Maybe a -> a
fromMaybe (NameSpaces -> [Numb] -> [AbstractNumb] -> Numbering
Numbering NameSpaces
forall a. Monoid a => a
mempty [] []) (Archive -> Maybe Numbering
archiveToNumbering' Archive
archive)

elemToNotes :: NameSpaces -> Text -> Element -> Maybe (M.Map T.Text Element)
elemToNotes :: NameSpaces -> Text -> Element -> Maybe (Map Text Element)
elemToNotes NameSpaces
ns Text
notetype Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" (Text
notetype Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"s") Element
element =
      let pairs :: [(Text, Element)]
pairs = (Element -> Maybe (Text, Element))
-> [Element] -> [(Text, Element)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
                  (\Element
e -> NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"id" Element
e Maybe Text
-> (Text -> Maybe (Text, Element)) -> Maybe (Text, Element)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                         (\Text
a -> (Text, Element) -> Maybe (Text, Element)
forall a. a -> Maybe a
Just (Text
a, Element
e)))
                  (NameSpaces -> Text -> Text -> Element -> [Element]
findChildrenByName NameSpaces
ns Text
"w" Text
notetype Element
element)
      in
       Map Text Element -> Maybe (Map Text Element)
forall a. a -> Maybe a
Just (Map Text Element -> Maybe (Map Text Element))
-> Map Text Element -> Maybe (Map Text Element)
forall a b. (a -> b) -> a -> b
$
       [(Text, Element)] -> Map Text Element
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text, Element)]
pairs
elemToNotes NameSpaces
_ Text
_ Element
_ = Maybe (Map Text Element)
forall a. Maybe a
Nothing

elemToComments :: NameSpaces -> Element -> M.Map T.Text Element
elemToComments :: NameSpaces -> Element -> Map Text Element
elemToComments NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"comments" Element
element =
      let pairs :: [(Text, Element)]
pairs = (Element -> Maybe (Text, Element))
-> [Element] -> [(Text, Element)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
                  (\Element
e -> NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"id" Element
e Maybe Text
-> (Text -> Maybe (Text, Element)) -> Maybe (Text, Element)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                         (\Text
a -> (Text, Element) -> Maybe (Text, Element)
forall a. a -> Maybe a
Just (Text
a, Element
e)))
                  (NameSpaces -> Text -> Text -> Element -> [Element]
findChildrenByName NameSpaces
ns Text
"w" Text
"comment" Element
element)
      in
       [(Text, Element)] -> Map Text Element
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text, Element)]
pairs
elemToComments NameSpaces
_ Element
_ = Map Text Element
forall k a. Map k a
M.empty


---------------------------------------------
---------------------------------------------

elemToTblGrid :: NameSpaces -> Element -> D TblGrid
elemToTblGrid :: NameSpaces -> Element -> D TblGrid
elemToTblGrid NameSpaces
ns Element
element | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"tblGrid" Element
element =
  let cols :: [Element]
cols = NameSpaces -> Text -> Text -> Element -> [Element]
findChildrenByName NameSpaces
ns Text
"w" Text
"gridCol" Element
element
  in
   (Element -> D GridSpan) -> [Element] -> D TblGrid
forall a b. (a -> D b) -> [a] -> D [b]
mapD (\Element
e -> Maybe GridSpan -> D GridSpan
forall a. Maybe a -> D a
maybeToD (NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"w" Element
e Maybe Text -> (Text -> Maybe GridSpan) -> Maybe GridSpan
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe GridSpan
stringToInteger))
   [Element]
cols
elemToTblGrid NameSpaces
_ Element
_ = DocxError -> D TblGrid
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem

elemToTblLook :: NameSpaces -> Element -> D TblLook
elemToTblLook :: NameSpaces -> Element -> D TblLook
elemToTblLook NameSpaces
ns Element
element | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"tblLook" Element
element =
  let firstRow :: Maybe Text
firstRow = NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"firstRow" Element
element
      val :: Maybe Text
val = NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"val" Element
element
      firstRowFmt :: Bool
firstRowFmt =
        case Maybe Text
firstRow of
          Just Text
"1" -> Bool
True
          Just  Text
_  -> Bool
False
          Maybe Text
Nothing -> case Maybe Text
val of
            Just Text
bitMask -> Text -> Int -> Bool
testBitMask Text
bitMask Int
0x020
            Maybe Text
Nothing      -> Bool
False
  in
   TblLook -> D TblLook
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return TblLook{firstRowFormatting :: Bool
firstRowFormatting = Bool
firstRowFmt}
elemToTblLook NameSpaces
_ Element
_ = DocxError -> D TblLook
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem

elemToRow :: NameSpaces -> Element -> D Row
elemToRow :: NameSpaces -> Element -> D Row
elemToRow NameSpaces
ns Element
element | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"tr" Element
element =
  do
    let cellElems :: [Element]
cellElems = NameSpaces -> Text -> Text -> Element -> [Element]
findChildrenByName NameSpaces
ns Text
"w" Text
"tc" Element
element
    [Cell]
cells <- (Element -> D Cell) -> [Element] -> D [Cell]
forall a b. (a -> D b) -> [a] -> D [b]
mapD (NameSpaces -> Element -> D Cell
elemToCell NameSpaces
ns) [Element]
cellElems
    let hasTblHeader :: TblHeader
hasTblHeader = TblHeader -> (Element -> TblHeader) -> Maybe Element -> TblHeader
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TblHeader
NoTblHeader (TblHeader -> Element -> TblHeader
forall a b. a -> b -> a
const TblHeader
HasTblHeader)
          (NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"trPr" Element
element
           Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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
"tblHeader")
    Row -> D Row
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Row -> D Row) -> Row -> D Row
forall a b. (a -> b) -> a -> b
$ TblHeader -> [Cell] -> Row
Row TblHeader
hasTblHeader [Cell]
cells
elemToRow NameSpaces
_ Element
_ = DocxError -> D Row
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem

elemToCell :: NameSpaces -> Element -> D Cell
elemToCell :: NameSpaces -> Element -> D Cell
elemToCell NameSpaces
ns Element
element | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"tc" Element
element =
  do
    let properties :: Maybe Element
properties = NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"tcPr" Element
element
    let gridSpan :: Maybe GridSpan
gridSpan = Maybe Element
properties
                     Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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
"gridSpan"
                     Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 GridSpan) -> Maybe GridSpan
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe GridSpan
stringToInteger
    let vMerge :: VMerge
vMerge = case Maybe Element
properties Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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
"vMerge" of
                   Maybe Element
Nothing -> VMerge
Restart
                   Just Element
e ->
                     VMerge -> Maybe VMerge -> VMerge
forall a. a -> Maybe a -> a
fromMaybe VMerge
Continue (Maybe VMerge -> VMerge) -> Maybe VMerge -> VMerge
forall a b. (a -> b) -> a -> b
$ do
                       Text
s <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"val" Element
e
                       case Text
s of
                         Text
"continue" -> VMerge -> Maybe VMerge
forall a. a -> Maybe a
Just VMerge
Continue
                         Text
"restart" -> VMerge -> Maybe VMerge
forall a. a -> Maybe a
Just VMerge
Restart
                         Text
_ -> Maybe VMerge
forall a. Maybe a
Nothing
    [BodyPart]
cellContents <- (Element -> D BodyPart)
-> [Element]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart]
forall a b. (a -> D b) -> [a] -> D [b]
mapD (NameSpaces -> Element -> D BodyPart
elemToBodyPart NameSpaces
ns) (Element -> [Element]
elChildren Element
element)
    Cell -> D Cell
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Cell -> D Cell) -> Cell -> D Cell
forall a b. (a -> b) -> a -> b
$ GridSpan -> VMerge -> [BodyPart] -> Cell
Cell (GridSpan -> Maybe GridSpan -> GridSpan
forall a. a -> Maybe a -> a
fromMaybe GridSpan
1 Maybe GridSpan
gridSpan) VMerge
vMerge [BodyPart]
cellContents
elemToCell NameSpaces
_ Element
_ = DocxError -> D Cell
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem

testBitMask :: Text -> Int -> Bool
testBitMask :: Text -> Int -> Bool
testBitMask Text
bitMaskS Int
n =
  case (ReadS Int
forall a. Read a => ReadS a
reads ([Char]
"0x" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
bitMaskS) :: [(Int, String)]) of
    []            -> Bool
False
    ((Int
n', [Char]
_) : [(Int, [Char])]
_) -> (Int
n' Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
n) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0

pHeading :: ParagraphStyle -> Maybe (ParaStyleName, Int)
pHeading :: ParagraphStyle -> Maybe (ParaStyleName, Int)
pHeading = (ParStyle -> Maybe (ParaStyleName, Int))
-> [ParStyle] -> Maybe (ParaStyleName, Int)
forall a. (ParStyle -> Maybe a) -> [ParStyle] -> Maybe a
getParStyleField ParStyle -> Maybe (ParaStyleName, Int)
headingLev ([ParStyle] -> Maybe (ParaStyleName, Int))
-> (ParagraphStyle -> [ParStyle])
-> ParagraphStyle
-> Maybe (ParaStyleName, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParagraphStyle -> [ParStyle]
pStyle

pNumInfo :: ParagraphStyle -> Maybe (T.Text, T.Text)
pNumInfo :: ParagraphStyle -> Maybe (Text, Text)
pNumInfo = (ParStyle -> Maybe (Text, Text))
-> [ParStyle] -> Maybe (Text, Text)
forall a. (ParStyle -> Maybe a) -> [ParStyle] -> Maybe a
getParStyleField ParStyle -> Maybe (Text, Text)
numInfo ([ParStyle] -> Maybe (Text, Text))
-> (ParagraphStyle -> [ParStyle])
-> ParagraphStyle
-> Maybe (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParagraphStyle -> [ParStyle]
pStyle

mkListItem :: ParagraphStyle -> Text -> Text -> [ParPart] -> D BodyPart
mkListItem :: ParagraphStyle -> Text -> Text -> [ParPart] -> D BodyPart
mkListItem ParagraphStyle
parstyle Text
numId Text
lvl [ParPart]
parparts = do
  Maybe Level
lvlInfo <- Text -> Text -> Numbering -> Maybe Level
lookupLevel Text
numId Text
lvl (Numbering -> Maybe Level)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) Numbering
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) (Maybe Level)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReaderEnv -> Numbering)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) Numbering
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderEnv -> Numbering
envNumbering
  BodyPart -> D BodyPart
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (BodyPart -> D BodyPart) -> BodyPart -> D BodyPart
forall a b. (a -> b) -> a -> b
$ ParagraphStyle
-> Text -> Text -> Maybe Level -> [ParPart] -> BodyPart
ListItem ParagraphStyle
parstyle Text
numId Text
lvl Maybe Level
lvlInfo [ParPart]
parparts

pStyleIndentation :: ParagraphStyle -> Maybe ParIndentation
pStyleIndentation :: ParagraphStyle -> Maybe ParIndentation
pStyleIndentation ParagraphStyle
style = ((ParStyle -> Maybe ParIndentation)
-> [ParStyle] -> Maybe ParIndentation
forall a. (ParStyle -> Maybe a) -> [ParStyle] -> Maybe a
getParStyleField ParStyle -> Maybe ParIndentation
indent ([ParStyle] -> Maybe ParIndentation)
-> (ParagraphStyle -> [ParStyle])
-> ParagraphStyle
-> Maybe ParIndentation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParagraphStyle -> [ParStyle]
pStyle) ParagraphStyle
style

elemToBodyPart :: NameSpaces -> Element -> D BodyPart
elemToBodyPart :: NameSpaces -> Element -> D BodyPart
elemToBodyPart NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"m" Text
"oMathPara" Element
element = do
      [Exp]
expsLst <- Either Text [Exp] -> D [Exp]
forall a b. Either a b -> D b
eitherToD (Either Text [Exp] -> D [Exp]) -> Either Text [Exp] -> D [Exp]
forall a b. (a -> b) -> a -> b
$ Text -> Either Text [Exp]
readOMML (Text -> Either Text [Exp]) -> Text -> Either Text [Exp]
forall a b. (a -> b) -> a -> b
$ Element -> Text
showElement Element
element
      ParagraphStyle
parstyle <- NameSpaces -> Element -> ParStyleMap -> Numbering -> ParagraphStyle
elemToParagraphStyle NameSpaces
ns Element
element
                  (ParStyleMap -> Numbering -> ParagraphStyle)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) ParStyleMap
-> ExceptT
     DocxError
     (ReaderT ReaderEnv (State ReaderState))
     (Numbering -> ParagraphStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReaderEnv -> ParStyleMap)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) ParStyleMap
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderEnv -> ParStyleMap
envParStyles
                  ExceptT
  DocxError
  (ReaderT ReaderEnv (State ReaderState))
  (Numbering -> ParagraphStyle)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) Numbering
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) ParagraphStyle
forall a b.
ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) (a -> b)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ReaderEnv -> Numbering)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) Numbering
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderEnv -> Numbering
envNumbering
      BodyPart -> D BodyPart
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (BodyPart -> D BodyPart) -> BodyPart -> D BodyPart
forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> [ParPart] -> BodyPart
Paragraph ParagraphStyle
parstyle [[Exp] -> ParPart
OMathPara [Exp]
expsLst]
elemToBodyPart NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"p" Element
element
  , Just (Text
numId, Text
lvl) <- NameSpaces -> Element -> Maybe (Text, Text)
getNumInfo NameSpaces
ns Element
element = do
    ParagraphStyle
parstyle <- NameSpaces -> Element -> ParStyleMap -> Numbering -> ParagraphStyle
elemToParagraphStyle NameSpaces
ns Element
element
                (ParStyleMap -> Numbering -> ParagraphStyle)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) ParStyleMap
-> ExceptT
     DocxError
     (ReaderT ReaderEnv (State ReaderState))
     (Numbering -> ParagraphStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReaderEnv -> ParStyleMap)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) ParStyleMap
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderEnv -> ParStyleMap
envParStyles
                ExceptT
  DocxError
  (ReaderT ReaderEnv (State ReaderState))
  (Numbering -> ParagraphStyle)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) Numbering
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) ParagraphStyle
forall a b.
ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) (a -> b)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ReaderEnv -> Numbering)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) Numbering
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderEnv -> Numbering
envNumbering
    [ParPart]
parparts <- [[ParPart]] -> [ParPart]
forall a. Monoid a => [a] -> a
mconcat ([[ParPart]] -> [ParPart])
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [[ParPart]]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element
 -> ExceptT
      DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart])
-> [Element]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [[ParPart]]
forall a b. (a -> D b) -> [a] -> D [b]
mapD (NameSpaces
-> Element
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
elemToParPart NameSpaces
ns) (Element -> [Element]
elChildren Element
element)
    case ParagraphStyle -> Maybe (ParaStyleName, Int)
pHeading ParagraphStyle
parstyle of
      Maybe (ParaStyleName, Int)
Nothing -> ParagraphStyle -> Text -> Text -> [ParPart] -> D BodyPart
mkListItem ParagraphStyle
parstyle Text
numId Text
lvl [ParPart]
parparts
      Just (ParaStyleName, Int)
_  -> do
        BodyPart -> D BodyPart
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (BodyPart -> D BodyPart) -> BodyPart -> D BodyPart
forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> [ParPart] -> BodyPart
Paragraph ParagraphStyle
parstyle [ParPart]
parparts
elemToBodyPart NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"p" Element
element = do
      ParagraphStyle
parstyle <- NameSpaces -> Element -> ParStyleMap -> Numbering -> ParagraphStyle
elemToParagraphStyle NameSpaces
ns Element
element
                  (ParStyleMap -> Numbering -> ParagraphStyle)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) ParStyleMap
-> ExceptT
     DocxError
     (ReaderT ReaderEnv (State ReaderState))
     (Numbering -> ParagraphStyle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReaderEnv -> ParStyleMap)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) ParStyleMap
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderEnv -> ParStyleMap
envParStyles
                  ExceptT
  DocxError
  (ReaderT ReaderEnv (State ReaderState))
  (Numbering -> ParagraphStyle)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) Numbering
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) ParagraphStyle
forall a b.
ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) (a -> b)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ReaderEnv -> Numbering)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) Numbering
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderEnv -> Numbering
envNumbering
      [ParPart]
parparts' <- [[ParPart]] -> [ParPart]
forall a. Monoid a => [a] -> a
mconcat ([[ParPart]] -> [ParPart])
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [[ParPart]]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element
 -> ExceptT
      DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart])
-> [Element]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [[ParPart]]
forall a b. (a -> D b) -> [a] -> D [b]
mapD (NameSpaces
-> Element
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
elemToParPart NameSpaces
ns) (Element -> [Element]
elChildren Element
element)
      [FldCharState]
fldCharState <- (ReaderState -> [FldCharState])
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [FldCharState]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ReaderState -> [FldCharState]
stateFldCharState
      (ReaderState -> ReaderState)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ReaderState -> ReaderState)
 -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ())
-> (ReaderState -> ReaderState)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ()
forall a b. (a -> b) -> a -> b
$ \ReaderState
st -> ReaderState
st {stateFldCharState :: [FldCharState]
stateFldCharState = [FldCharState] -> [FldCharState]
emptyFldCharContents [FldCharState]
fldCharState}
      -- Word uses list enumeration for numbered headings, so we only
      -- want to infer a list from the styles if it is NOT a heading.
      let parparts :: [ParPart]
parparts = [ParPart]
parparts' [ParPart] -> [ParPart] -> [ParPart]
forall a. [a] -> [a] -> [a]
++ ([FldCharState] -> [ParPart]
openFldCharsToParParts [FldCharState]
fldCharState)
      case ParagraphStyle -> Maybe (ParaStyleName, Int)
pHeading ParagraphStyle
parstyle of
        Maybe (ParaStyleName, Int)
Nothing | Just (Text
numId, Text
lvl) <- ParagraphStyle -> Maybe (Text, Text)
pNumInfo ParagraphStyle
parstyle -> do
                    ParagraphStyle -> Text -> Text -> [ParPart] -> D BodyPart
mkListItem ParagraphStyle
parstyle Text
numId Text
lvl [ParPart]
parparts
        Maybe (ParaStyleName, Int)
_ -> let
          hasCaptionStyle :: Bool
hasCaptionStyle = ParaStyleId -> [ParaStyleId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem ParaStyleId
"Caption" (ParStyle -> ParaStyleId
pStyleId (ParStyle -> ParaStyleId) -> [ParStyle] -> [ParaStyleId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParagraphStyle -> [ParStyle]
pStyle ParagraphStyle
parstyle)

          hasSimpleTableField :: Bool
hasSimpleTableField = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
            Element
fldSimple <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"fldSimple" Element
element
            Text
instr <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"instr" Element
fldSimple
            Bool -> Maybe Bool
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"Table" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Text -> [Text]
T.words Text
instr)

          hasComplexTableField :: Bool
hasComplexTableField = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
            Element
instrText <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findElementByName NameSpaces
ns Text
"w" Text
"instrText" Element
element
            Bool -> Maybe Bool
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
"Table" Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Text -> [Text]
T.words (Element -> Text
strContent Element
instrText))

          in if Bool
hasCaptionStyle Bool -> Bool -> Bool
&& (Bool
hasSimpleTableField Bool -> Bool -> Bool
|| Bool
hasComplexTableField)
            then BodyPart -> D BodyPart
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (BodyPart -> D BodyPart) -> BodyPart -> D BodyPart
forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> [ParPart] -> BodyPart
TblCaption ParagraphStyle
parstyle [ParPart]
parparts
            else BodyPart -> D BodyPart
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (BodyPart -> D BodyPart) -> BodyPart -> D BodyPart
forall a b. (a -> b) -> a -> b
$ ParagraphStyle -> [ParPart] -> BodyPart
Paragraph ParagraphStyle
parstyle [ParPart]
parparts

elemToBodyPart NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"tbl" Element
element = do
    let tblProperties :: Maybe Element
tblProperties = NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"tblPr" Element
element
        caption :: Text
caption = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Element
tblProperties
                   Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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
"tblCaption"
                   Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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"
        description :: Text
description = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Element
tblProperties
                       Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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
"tblDescription"
                       Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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"
        grid' :: D TblGrid
grid' = case NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"tblGrid" Element
element of
          Just Element
g  -> NameSpaces -> Element -> D TblGrid
elemToTblGrid NameSpaces
ns Element
g
          Maybe Element
Nothing -> TblGrid -> D TblGrid
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
        tblLook' :: D TblLook
tblLook' = case NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"tblPr" Element
element Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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
"tblLook"
                     of
                       Just Element
l  -> NameSpaces -> Element -> D TblLook
elemToTblLook NameSpaces
ns Element
l
                       Maybe Element
Nothing -> TblLook -> D TblLook
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return TblLook
defaultTblLook

    TblGrid
grid <- D TblGrid
grid'
    TblLook
tblLook <- D TblLook
tblLook'
    [Row]
rows <- (Element -> D Row) -> [Element] -> D [Row]
forall a b. (a -> D b) -> [a] -> D [b]
mapD (NameSpaces -> Element -> D Row
elemToRow NameSpaces
ns) (Element -> [Element]
elChildren Element
element)
    BodyPart -> D BodyPart
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (BodyPart -> D BodyPart) -> BodyPart -> D BodyPart
forall a b. (a -> b) -> a -> b
$ Text -> TblGrid -> TblLook -> [Row] -> BodyPart
Tbl (Text
caption Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
description) TblGrid
grid TblLook
tblLook [Row]
rows
elemToBodyPart NameSpaces
_ Element
_ = DocxError -> D BodyPart
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem

lookupRelationship :: DocumentLocation -> RelId -> [Relationship] -> Maybe Target
lookupRelationship :: DocumentLocation -> Text -> [Relationship] -> Maybe Text
lookupRelationship DocumentLocation
docLocation Text
relid [Relationship]
rels =
  (DocumentLocation, Text)
-> [((DocumentLocation, Text), Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (DocumentLocation
docLocation, Text
relid) [((DocumentLocation, Text), Text)]
pairs
  where
    pairs :: [((DocumentLocation, Text), Text)]
pairs = (Relationship -> ((DocumentLocation, Text), Text))
-> [Relationship] -> [((DocumentLocation, Text), Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Relationship DocumentLocation
loc Text
relid' Text
target) -> ((DocumentLocation
loc, Text
relid'), Text
target)) [Relationship]
rels

openFldCharsToParParts :: [FldCharState] -> [ParPart]
openFldCharsToParParts :: [FldCharState] -> [ParPart]
openFldCharsToParParts [] = []
openFldCharsToParParts (FldCharContent FieldInfo
info [ParPart]
children : [FldCharState]
ancestors) = case [FldCharState] -> [ParPart]
openFldCharsToParParts [FldCharState]
ancestors of
  Field FieldInfo
parentInfo [ParPart]
siblings : [ParPart]
_ -> [FieldInfo -> [ParPart] -> ParPart
Field FieldInfo
parentInfo ([ParPart] -> ParPart) -> [ParPart] -> ParPart
forall a b. (a -> b) -> a -> b
$ [ParPart]
siblings [ParPart] -> [ParPart] -> [ParPart]
forall a. [a] -> [a] -> [a]
++ [FieldInfo -> [ParPart] -> ParPart
Field FieldInfo
info ([ParPart] -> ParPart) -> [ParPart] -> ParPart
forall a b. (a -> b) -> a -> b
$ [ParPart] -> [ParPart]
forall a. [a] -> [a]
reverse [ParPart]
children]]
  [ParPart]
_ -> [FieldInfo -> [ParPart] -> ParPart
Field FieldInfo
info ([ParPart] -> ParPart) -> [ParPart] -> ParPart
forall a b. (a -> b) -> a -> b
$ [ParPart] -> [ParPart]
forall a. [a] -> [a]
reverse [ParPart]
children]
openFldCharsToParParts (FldCharState
_ : [FldCharState]
ancestors) = [FldCharState] -> [ParPart]
openFldCharsToParParts [FldCharState]
ancestors

emptyFldCharContents :: [FldCharState] -> [FldCharState]
emptyFldCharContents :: [FldCharState] -> [FldCharState]
emptyFldCharContents = (FldCharState -> FldCharState) -> [FldCharState] -> [FldCharState]
forall a b. (a -> b) -> [a] -> [b]
map
  (\FldCharState
x -> case FldCharState
x of
    FldCharContent FieldInfo
info [ParPart]
_ -> FieldInfo -> [ParPart] -> FldCharState
FldCharContent FieldInfo
info []
    FldCharState
_ -> FldCharState
x)

expandDrawingId :: T.Text -> D (FilePath, B.ByteString)
expandDrawingId :: Text -> D ([Char], ByteString)
expandDrawingId Text
s = do
  DocumentLocation
location <- (ReaderEnv -> DocumentLocation)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) DocumentLocation
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderEnv -> DocumentLocation
envLocation
  Maybe [Char]
target <- (ReaderEnv -> Maybe [Char])
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) (Maybe [Char])
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Text -> [Char]) -> Maybe Text -> Maybe [Char]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> [Char]
T.unpack (Maybe Text -> Maybe [Char])
-> (ReaderEnv -> Maybe Text) -> ReaderEnv -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocumentLocation -> Text -> [Relationship] -> Maybe Text
lookupRelationship DocumentLocation
location Text
s ([Relationship] -> Maybe Text)
-> (ReaderEnv -> [Relationship]) -> ReaderEnv -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderEnv -> [Relationship]
envRelationships)
  case Maybe [Char]
target of
    Just [Char]
filepath -> do
      Media
media <- (ReaderEnv -> Media)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) Media
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderEnv -> Media
envMedia
      let filepath' :: [Char]
filepath' = case [Char]
filepath of
                        (Char
'/':[Char]
rest) -> [Char]
rest
                        [Char]
_ -> [Char]
"word/" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
filepath
      case [Char] -> Media -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
filepath' Media
media of
        Just ByteString
bs -> ([Char], ByteString) -> D ([Char], ByteString)
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
filepath, ByteString
bs)
        Maybe ByteString
Nothing -> DocxError -> D ([Char], ByteString)
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
DocxError
    Maybe [Char]
Nothing -> DocxError -> D ([Char], ByteString)
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
DocxError

getTitleAndAlt :: NameSpaces -> Element -> (T.Text, T.Text)
getTitleAndAlt :: NameSpaces -> Element -> (Text, Text)
getTitleAndAlt NameSpaces
ns Element
element =
  let mbDocPr :: Maybe Element
mbDocPr = (NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"wp" Text
"inline" Element
element Maybe Element -> Maybe Element -> Maybe Element
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>   -- Word
                 NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"wp" Text
"anchor" Element
element) Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=  -- LibreOffice
                NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"wp" Text
"docPr"
      title :: Text
title = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Element
mbDocPr Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"" Text
"title")
      alt :: Text
alt = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Element
mbDocPr Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"" Text
"descr")
  in (Text
title, Text
alt)

elemToParPart :: NameSpaces -> Element -> D [ParPart]
{-
The next one is a bit complicated. fldChar fields work by first
having a <w:fldChar fldCharType="begin"> in a run, then a run with
<w:instrText>, then a <w:fldChar fldCharType="separate"> run, then the
content runs, and finally a <w:fldChar fldCharType="end"> run. For
example (omissions and my comments in brackets):

      <w:r>
        [...]
        <w:fldChar w:fldCharType="begin"/>
      </w:r>
      <w:r>
        [...]
        <w:instrText xml:space="preserve"> HYPERLINK [hyperlink url] </w:instrText>
      </w:r>
      <w:r>
        [...]
        <w:fldChar w:fldCharType="separate"/>
      </w:r>
      <w:r w:rsidRPr=[...]>
        [...]
        <w:t>Foundations of Analysis, 2nd Edition</w:t>
      </w:r>
      <w:r>
        [...]
        <w:fldChar w:fldCharType="end"/>
      </w:r>

So we do this in a number of steps. If we encounter the fldchar begin
tag, we start open a fldchar state variable (see state above). We add
the instrtext to it as FieldInfo. Then we close that and start adding
the children when we get to separate. Then when we get to end, we produce
the Field type with appropriate FieldInfo and ParParts.

Since there can be nested fields, the fldchar state needs to be a stack,
so we can have multiple fldchars open at the same time. When a fldchar is
closed, we either add the resulting field to its parent or we return it if
there is no parent.
-}
elemToParPart :: NameSpaces
-> Element
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
elemToParPart NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"r" Element
element
  , Just Element
fldChar <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"fldChar" Element
element
  , Just Text
fldCharType <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"fldCharType" Element
fldChar = do
      [FldCharState]
fldCharState <- (ReaderState -> [FldCharState])
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [FldCharState]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ReaderState -> [FldCharState]
stateFldCharState
      case [FldCharState]
fldCharState of
        [FldCharState]
_ | Text
fldCharType Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"begin" -> do
          (ReaderState -> ReaderState)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ReaderState -> ReaderState)
 -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ())
-> (ReaderState -> ReaderState)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ()
forall a b. (a -> b) -> a -> b
$ \ReaderState
st -> ReaderState
st {stateFldCharState :: [FldCharState]
stateFldCharState = FldCharState
FldCharOpen FldCharState -> [FldCharState] -> [FldCharState]
forall a. a -> [a] -> [a]
: [FldCharState]
fldCharState}
          [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
        FldCharFieldInfo FieldInfo
info : [FldCharState]
ancestors | Text
fldCharType Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"separate" -> do
          (ReaderState -> ReaderState)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ReaderState -> ReaderState)
 -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ())
-> (ReaderState -> ReaderState)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ()
forall a b. (a -> b) -> a -> b
$ \ReaderState
st -> ReaderState
st {stateFldCharState :: [FldCharState]
stateFldCharState = FieldInfo -> [ParPart] -> FldCharState
FldCharContent FieldInfo
info [] FldCharState -> [FldCharState] -> [FldCharState]
forall a. a -> [a] -> [a]
: [FldCharState]
ancestors}
          [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
        -- Some fields have no content, since Pandoc doesn't understand any of those fields, we can just close it.
        FldCharFieldInfo FieldInfo
_ : [FldCharState]
ancestors | Text
fldCharType Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"end" -> do
          (ReaderState -> ReaderState)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ReaderState -> ReaderState)
 -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ())
-> (ReaderState -> ReaderState)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ()
forall a b. (a -> b) -> a -> b
$ \ReaderState
st -> ReaderState
st {stateFldCharState :: [FldCharState]
stateFldCharState = [FldCharState]
ancestors}
          [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
        [FldCharContent FieldInfo
info [ParPart]
children] | Text
fldCharType Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"end" -> do
          (ReaderState -> ReaderState)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ReaderState -> ReaderState)
 -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ())
-> (ReaderState -> ReaderState)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ()
forall a b. (a -> b) -> a -> b
$ \ReaderState
st -> ReaderState
st {stateFldCharState :: [FldCharState]
stateFldCharState = []}
          [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [FieldInfo -> [ParPart] -> ParPart
Field FieldInfo
info ([ParPart] -> ParPart) -> [ParPart] -> ParPart
forall a b. (a -> b) -> a -> b
$ [ParPart] -> [ParPart]
forall a. [a] -> [a]
reverse [ParPart]
children]
        FldCharContent FieldInfo
info [ParPart]
children : FldCharContent FieldInfo
parentInfo [ParPart]
siblings : [FldCharState]
ancestors | Text
fldCharType Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"end" ->
          let parent :: FldCharState
parent = FieldInfo -> [ParPart] -> FldCharState
FldCharContent FieldInfo
parentInfo ([ParPart] -> FldCharState) -> [ParPart] -> FldCharState
forall a b. (a -> b) -> a -> b
$ (FieldInfo -> [ParPart] -> ParPart
Field FieldInfo
info ([ParPart] -> [ParPart]
forall a. [a] -> [a]
reverse [ParPart]
children)) ParPart -> [ParPart] -> [ParPart]
forall a. a -> [a] -> [a]
: [ParPart]
siblings in do
            (ReaderState -> ReaderState)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ReaderState -> ReaderState)
 -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ())
-> (ReaderState -> ReaderState)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ()
forall a b. (a -> b) -> a -> b
$ \ReaderState
st -> ReaderState
st {stateFldCharState :: [FldCharState]
stateFldCharState = FldCharState
parent FldCharState -> [FldCharState] -> [FldCharState]
forall a. a -> [a] -> [a]
: [FldCharState]
ancestors}
            [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
        [FldCharState]
_ -> DocxError
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem
elemToParPart NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"r" Element
element
  , Just Element
instrText <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"instrText" Element
element = do
      [FldCharState]
fldCharState <- (ReaderState -> [FldCharState])
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [FldCharState]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ReaderState -> [FldCharState]
stateFldCharState
      case [FldCharState]
fldCharState of
        FldCharState
FldCharOpen : [FldCharState]
ancestors -> do
          FieldInfo
info <- Either ParseError FieldInfo -> D FieldInfo
forall a b. Either a b -> D b
eitherToD (Either ParseError FieldInfo -> D FieldInfo)
-> Either ParseError FieldInfo -> D FieldInfo
forall a b. (a -> b) -> a -> b
$ Text -> Either ParseError FieldInfo
parseFieldInfo (Text -> Either ParseError FieldInfo)
-> Text -> Either ParseError FieldInfo
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
instrText
          (ReaderState -> ReaderState)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ReaderState -> ReaderState)
 -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ())
-> (ReaderState -> ReaderState)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ()
forall a b. (a -> b) -> a -> b
$ \ReaderState
st -> ReaderState
st {stateFldCharState :: [FldCharState]
stateFldCharState = FieldInfo -> FldCharState
FldCharFieldInfo FieldInfo
info FldCharState -> [FldCharState] -> [FldCharState]
forall a. a -> [a] -> [a]
: [FldCharState]
ancestors}
          [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
        [FldCharState]
_ -> [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
{-
There is an open fldchar, so we calculate the element and add it to the
children. For this we need to first change the fldchar state to an empty
stack to avoid descendants of children simply being added to the state instead
of to their direct parent element. This would happen in the case of a
w:hyperlink element for example.
-}
elemToParPart NameSpaces
ns Element
element = do
  [FldCharState]
fldCharState <- (ReaderState -> [FldCharState])
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [FldCharState]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ReaderState -> [FldCharState]
stateFldCharState
  case [FldCharState]
fldCharState of
    FldCharContent FieldInfo
info [ParPart]
children : [FldCharState]
ancestors -> do
      (ReaderState -> ReaderState)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ReaderState -> ReaderState)
 -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ())
-> (ReaderState -> ReaderState)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ()
forall a b. (a -> b) -> a -> b
$ \ReaderState
st -> ReaderState
st {stateFldCharState :: [FldCharState]
stateFldCharState = []}
      [ParPart]
parParts <- NameSpaces
-> Element
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
elemToParPart' NameSpaces
ns Element
element ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
-> (DocxError
    -> ExceptT
         DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart])
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
-> (DocxError
    -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \DocxError
_ -> [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      (ReaderState -> ReaderState)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ReaderState -> ReaderState)
 -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ())
-> (ReaderState -> ReaderState)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) ()
forall a b. (a -> b) -> a -> b
$ \ReaderState
st -> ReaderState
st{stateFldCharState :: [FldCharState]
stateFldCharState = FieldInfo -> [ParPart] -> FldCharState
FldCharContent FieldInfo
info ([ParPart]
parParts [ParPart] -> [ParPart] -> [ParPart]
forall a. [a] -> [a] -> [a]
++ [ParPart]
children) FldCharState -> [FldCharState] -> [FldCharState]
forall a. a -> [a] -> [a]
: [FldCharState]
ancestors}
      [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    [FldCharState]
_ -> NameSpaces
-> Element
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
elemToParPart' NameSpaces
ns Element
element

elemToParPart' :: NameSpaces -> Element -> D [ParPart]
elemToParPart' :: NameSpaces
-> Element
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
elemToParPart' NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"r" Element
element
  , Just Element
drawingElem <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"drawing" Element
element
  , Text
pic_ns <- Text
"http://schemas.openxmlformats.org/drawingml/2006/picture"
  , [Element]
picElems <- QName -> Element -> [Element]
findElements (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"pic" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
pic_ns) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"pic")) Element
drawingElem
  = let (Text
title, Text
alt) = NameSpaces -> Element -> (Text, Text)
getTitleAndAlt NameSpaces
ns Element
drawingElem
        a_ns :: Text
a_ns = Text
"http://schemas.openxmlformats.org/drawingml/2006/main"
        drawings :: [(Maybe Text, Element)]
drawings = (Element -> (Maybe Text, Element))
-> [Element] -> [(Maybe Text, Element)]
forall a b. (a -> b) -> [a] -> [b]
map (\Element
el ->
                        ((QName -> Element -> Maybe Element
findElement (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"blip" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
a_ns) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"a")) Element
el
                          Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"r" Text
"embed"), Element
el)) [Element]
picElems
    in ((Maybe Text, Element)
 -> ExceptT
      DocxError (ReaderT ReaderEnv (State ReaderState)) ParPart)
-> [(Maybe Text, Element)]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\case
                (Just Text
s, Element
el) -> do
                  ([Char]
fp, ByteString
bs) <- Text -> D ([Char], ByteString)
expandDrawingId Text
s
                  let extent :: Extent
extent = Element -> Extent
elemToExtent Element
el Extent -> Extent -> Extent
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Element -> Extent
elemToExtent Element
element
                  ParPart
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) ParPart
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParPart
 -> ExceptT
      DocxError (ReaderT ReaderEnv (State ReaderState)) ParPart)
-> ParPart
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) ParPart
forall a b. (a -> b) -> a -> b
$ [Char] -> Text -> Text -> ByteString -> Extent -> ParPart
Drawing [Char]
fp Text
title Text
alt ByteString
bs Extent
extent
                (Maybe Text
Nothing, Element
_) -> DocxError
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) ParPart
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem)
            [(Maybe Text, Element)]
drawings
-- The two cases below are an attempt to deal with images in deprecated vml format.
-- Todo: check out title and attr for deprecated format.
elemToParPart' NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"r" Element
element
  , Just Element
_ <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"pict" Element
element =
    let drawing :: Maybe Text
drawing = QName -> Element -> Maybe Element
findElement (NameSpaces -> Text -> Text -> QName
elemName NameSpaces
ns Text
"v" Text
"imagedata") Element
element
                  Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"r" Text
"id"
    in
     case Maybe Text
drawing of
       Just Text
s -> Text -> D ([Char], ByteString)
expandDrawingId Text
s D ([Char], ByteString)
-> (([Char], ByteString)
    -> ExceptT
         DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart])
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a b.
ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
-> (a
    -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) b)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\([Char]
fp, ByteString
bs) -> [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char] -> Text -> Text -> ByteString -> Extent -> ParPart
Drawing [Char]
fp Text
"" Text
"" ByteString
bs Extent
forall a. Maybe a
Nothing])
       Maybe Text
Nothing -> DocxError
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem
elemToParPart' NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"r" Element
element
  , Just Element
objectElem <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"object" Element
element
  , Just Element
shapeElem <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"v" Text
"shape" Element
objectElem
  , Just Element
imagedataElem <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"v" Text
"imagedata" Element
shapeElem
  , Just Text
drawingId <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"r" Text
"id" Element
imagedataElem
  = Text -> D ([Char], ByteString)
expandDrawingId Text
drawingId D ([Char], ByteString)
-> (([Char], ByteString)
    -> ExceptT
         DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart])
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a b.
ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
-> (a
    -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) b)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\([Char]
fp, ByteString
bs) -> [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [[Char] -> Text -> Text -> ByteString -> Extent -> ParPart
Drawing [Char]
fp Text
"" Text
"" ByteString
bs Extent
forall a. Maybe a
Nothing])
-- Diagram
elemToParPart' NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"r" Element
element
  , Just Element
drawingElem <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"drawing" Element
element
  , Text
d_ns <- Text
"http://schemas.openxmlformats.org/drawingml/2006/diagram"
  , Just Element
_ <- QName -> Element -> Maybe Element
findElement (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"relIds" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
d_ns) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"dgm")) Element
drawingElem
  = [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [ParPart
Diagram]
-- Chart
elemToParPart' NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"r" Element
element
  , Just Element
drawingElem <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"drawing" Element
element
  , Text
c_ns <- Text
"http://schemas.openxmlformats.org/drawingml/2006/chart"
  , Just Element
_ <- QName -> Element -> Maybe Element
findElement (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"chart" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
c_ns) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"c")) Element
drawingElem
  = [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [ParPart
Chart]
elemToParPart' NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"r" Element
element = do
    [Run]
runs <- NameSpaces -> Element -> D [Run]
elemToRun NameSpaces
ns Element
element
    [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return ([ParPart]
 -> ExceptT
      DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart])
-> [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a b. (a -> b) -> a -> b
$ (Run -> ParPart) -> [Run] -> [ParPart]
forall a b. (a -> b) -> [a] -> [b]
map Run -> ParPart
PlainRun [Run]
runs
elemToParPart' NameSpaces
ns Element
element
  | Just TrackedChange
change <- NameSpaces -> Element -> Maybe TrackedChange
getTrackedChange NameSpaces
ns Element
element = do
      [Run]
runs <- [[Run]] -> [Run]
forall a. Monoid a => [a] -> a
mconcat ([[Run]] -> [Run])
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [[Run]]
-> D [Run]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> D [Run])
-> [Element]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [[Run]]
forall a b. (a -> D b) -> [a] -> D [b]
mapD (NameSpaces -> Element -> D [Run]
elemToRun NameSpaces
ns) (Element -> [Element]
elChildren Element
element)
      [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [TrackedChange -> [Run] -> ParPart
ChangedRuns TrackedChange
change [Run]
runs]
elemToParPart' NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"bookmarkStart" Element
element
  , Just Text
bmId <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"id" Element
element
  , Just Text
bmName <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"name" Element
element =
    [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Text -> ParPart
BookMark Text
bmId Text
bmName]
elemToParPart' NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"hyperlink" Element
element
  , Just Text
relId <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"r" Text
"id" Element
element = do
    DocumentLocation
location <- (ReaderEnv -> DocumentLocation)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) DocumentLocation
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderEnv -> DocumentLocation
envLocation
    [ParPart]
children <- [[ParPart]] -> [ParPart]
forall a. Monoid a => [a] -> a
mconcat ([[ParPart]] -> [ParPart])
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [[ParPart]]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element
 -> ExceptT
      DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart])
-> [Element]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [[ParPart]]
forall a b. (a -> D b) -> [a] -> D [b]
mapD (NameSpaces
-> Element
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
elemToParPart NameSpaces
ns) (Element -> [Element]
elChildren Element
element)
    [Relationship]
rels <- (ReaderEnv -> [Relationship])
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [Relationship]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderEnv -> [Relationship]
envRelationships
    case DocumentLocation -> Text -> [Relationship] -> Maybe Text
lookupRelationship DocumentLocation
location Text
relId [Relationship]
rels of
      Just Text
target ->
         case NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"anchor" Element
element of
             Just Text
anchor -> [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return
               [Text -> [ParPart] -> ParPart
ExternalHyperLink (Text
target Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
anchor) [ParPart]
children]
             Maybe Text
Nothing -> [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> [ParPart] -> ParPart
ExternalHyperLink Text
target [ParPart]
children]
      Maybe Text
Nothing     -> [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> [ParPart] -> ParPart
ExternalHyperLink Text
"" [ParPart]
children]
elemToParPart' NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"hyperlink" Element
element
  , Just Text
anchor <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"anchor" Element
element = do
    [ParPart]
children <- [[ParPart]] -> [ParPart]
forall a. Monoid a => [a] -> a
mconcat ([[ParPart]] -> [ParPart])
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [[ParPart]]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element
 -> ExceptT
      DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart])
-> [Element]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [[ParPart]]
forall a b. (a -> D b) -> [a] -> D [b]
mapD (NameSpaces
-> Element
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
elemToParPart NameSpaces
ns) (Element -> [Element]
elChildren Element
element)
    [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> [ParPart] -> ParPart
InternalHyperLink Text
anchor [ParPart]
children]
elemToParPart' NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"commentRangeStart" Element
element
  , Just Text
cmtId <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"id" Element
element = do
      (Comments NameSpaces
_ Map Text Element
commentMap) <- (ReaderEnv -> Comments)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) Comments
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderEnv -> Comments
envComments
      case Text -> Map Text Element -> Maybe Element
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
cmtId Map Text Element
commentMap of
        Just Element
cmtElem -> NameSpaces
-> Element
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
elemToCommentStart NameSpaces
ns Element
cmtElem
        Maybe Element
Nothing      -> DocxError
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem
elemToParPart' NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"commentRangeEnd" Element
element
  , Just Text
cmtId <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"id" Element
element =
    [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> ParPart
CommentEnd Text
cmtId]
elemToParPart' NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"m" Text
"oMath" Element
element =
    ([Exp] -> [ParPart])
-> D [Exp]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a b.
(a -> b)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParPart -> [ParPart]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (ParPart -> [ParPart]) -> ([Exp] -> ParPart) -> [Exp] -> [ParPart]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Exp] -> ParPart
PlainOMath) (Either Text [Exp] -> D [Exp]
forall a b. Either a b -> D b
eitherToD (Either Text [Exp] -> D [Exp]) -> Either Text [Exp] -> D [Exp]
forall a b. (a -> b) -> a -> b
$ Text -> Either Text [Exp]
readOMML (Text -> Either Text [Exp]) -> Text -> Either Text [Exp]
forall a b. (a -> b) -> a -> b
$ Element -> Text
showElement Element
element)
elemToParPart' NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"m" Text
"oMathPara" Element
element =
    ([Exp] -> [ParPart])
-> D [Exp]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a b.
(a -> b)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParPart -> [ParPart]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (ParPart -> [ParPart]) -> ([Exp] -> ParPart) -> [Exp] -> [ParPart]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Exp] -> ParPart
OMathPara) (Either Text [Exp] -> D [Exp]
forall a b. Either a b -> D b
eitherToD (Either Text [Exp] -> D [Exp]) -> Either Text [Exp] -> D [Exp]
forall a b. (a -> b) -> a -> b
$ Text -> Either Text [Exp]
readOMML (Text -> Either Text [Exp]) -> Text -> Either Text [Exp]
forall a b. (a -> b) -> a -> b
$ Element -> Text
showElement Element
element)
elemToParPart' NameSpaces
_ Element
_ = DocxError
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem

elemToCommentStart :: NameSpaces -> Element -> D [ParPart]
elemToCommentStart :: NameSpaces
-> Element
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
elemToCommentStart NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"comment" Element
element
  , Just Text
cmtId <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"id" Element
element
  , Just Text
cmtAuthor <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"author" Element
element
  , Maybe Text
cmtDate <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"date" Element
element = do
      [BodyPart]
bps <- (Element -> D BodyPart)
-> [Element]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart]
forall a b. (a -> D b) -> [a] -> D [b]
mapD (NameSpaces -> Element -> D BodyPart
elemToBodyPart NameSpaces
ns) (Element -> [Element]
elChildren Element
element)
      [ParPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> Text -> Maybe Text -> [BodyPart] -> ParPart
CommentStart Text
cmtId Text
cmtAuthor Maybe Text
cmtDate [BodyPart]
bps]
elemToCommentStart NameSpaces
_ Element
_ = DocxError
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [ParPart]
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem

lookupFootnote :: T.Text -> Notes -> Maybe Element
lookupFootnote :: Text -> Notes -> Maybe Element
lookupFootnote Text
s (Notes NameSpaces
_ Maybe (Map Text Element)
fns Maybe (Map Text Element)
_) = Maybe (Map Text Element)
fns Maybe (Map Text Element)
-> (Map Text Element -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Map Text Element -> Maybe Element
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
s

lookupEndnote :: T.Text -> Notes -> Maybe Element
lookupEndnote :: Text -> Notes -> Maybe Element
lookupEndnote Text
s (Notes NameSpaces
_ Maybe (Map Text Element)
_ Maybe (Map Text Element)
ens) = Maybe (Map Text Element)
ens Maybe (Map Text Element)
-> (Map Text Element -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Map Text Element -> Maybe Element
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
s

elemToExtent :: Element -> Extent
elemToExtent :: Element -> Extent
elemToExtent Element
el =
  case (Text -> Maybe Double
forall {b}. Read b => Text -> Maybe b
getDim Text
"cx", Text -> Maybe Double
forall {b}. Read b => Text -> Maybe b
getDim Text
"cy") of
    (Just Double
w, Just Double
h) -> (Double, Double) -> Extent
forall a. a -> Maybe a
Just (Double
w, Double
h)
    (Maybe Double, Maybe Double)
_                -> Extent
forall a. Maybe a
Nothing
 where
  getDim :: Text -> Maybe b
getDim Text
at = (QName -> Bool) -> Element -> Maybe Element
filterElementName (\QName
n -> QName -> Text
qName QName
n Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"extent", Text
"ext"]) Element
el
              Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
at Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) Maybe Text -> (Text -> Maybe b) -> Maybe b
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe b
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead


childElemToRun :: NameSpaces -> Element -> D [Run]
childElemToRun :: NameSpaces -> Element -> D [Run]
childElemToRun NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"drawing" Element
element
  , Text
pic_ns <- Text
"http://schemas.openxmlformats.org/drawingml/2006/picture"
  , [Element]
picElems <- QName -> Element -> [Element]
findElements (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"pic" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
pic_ns) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"pic")) Element
element
  = let (Text
title, Text
alt) = NameSpaces -> Element -> (Text, Text)
getTitleAndAlt NameSpaces
ns Element
element
        a_ns :: Text
a_ns = Text
"http://schemas.openxmlformats.org/drawingml/2006/main"
        drawings :: [(Maybe Text, Element)]
drawings = (Element -> (Maybe Text, Element))
-> [Element] -> [(Maybe Text, Element)]
forall a b. (a -> b) -> [a] -> [b]
map (\Element
el ->
                         ((QName -> Element -> Maybe Element
findElement (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"blip" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
a_ns) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"a")) Element
el
                             Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"r" Text
"embed"), Element
el)) [Element]
picElems
    in ((Maybe Text, Element)
 -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) Run)
-> [(Maybe Text, Element)] -> D [Run]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\case
                (Just Text
s, Element
el) -> do
                  ([Char]
fp, ByteString
bs) <- Text -> D ([Char], ByteString)
expandDrawingId Text
s
                  let extent :: Extent
extent = Element -> Extent
elemToExtent Element
el Extent -> Extent -> Extent
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Element -> Extent
elemToExtent Element
element
                  Run
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) Run
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Run
 -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) Run)
-> Run
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) Run
forall a b. (a -> b) -> a -> b
$ [Char] -> Text -> Text -> ByteString -> Extent -> Run
InlineDrawing [Char]
fp Text
title Text
alt ByteString
bs Extent
extent
                (Maybe Text
Nothing, Element
_) -> DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) Run
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem)
       [(Maybe Text, Element)]
drawings
childElemToRun NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"drawing" Element
element
  , Text
c_ns <- Text
"http://schemas.openxmlformats.org/drawingml/2006/chart"
  , Just Element
_ <- QName -> Element -> Maybe Element
findElement (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"chart" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
c_ns) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"c")) Element
element
  = [Run] -> D [Run]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Run
InlineChart]
childElemToRun NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"drawing" Element
element
  , Text
c_ns <- Text
"http://schemas.openxmlformats.org/drawingml/2006/diagram"
  , Just Element
_ <- QName -> Element -> Maybe Element
findElement (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"relIds" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
c_ns) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"dgm")) Element
element
  = [Run] -> D [Run]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Run
InlineDiagram]
childElemToRun NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"footnoteReference" Element
element
  , Just Text
fnId <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"id" Element
element = do
    Notes
notes <- (ReaderEnv -> Notes)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) Notes
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderEnv -> Notes
envNotes
    case Text -> Notes -> Maybe Element
lookupFootnote Text
fnId Notes
notes of
      Just Element
e -> do [BodyPart]
bps <- (ReaderEnv -> ReaderEnv)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart]
forall a.
(ReaderEnv -> ReaderEnv)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ReaderEnv
r -> ReaderEnv
r {envLocation :: DocumentLocation
envLocation=DocumentLocation
InFootnote}) (ExceptT
   DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart]
 -> ExceptT
      DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart])
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart]
forall a b. (a -> b) -> a -> b
$ (Element -> D BodyPart)
-> [Element]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart]
forall a b. (a -> D b) -> [a] -> D [b]
mapD (NameSpaces -> Element -> D BodyPart
elemToBodyPart NameSpaces
ns) (Element -> [Element]
elChildren Element
e)
                   [Run] -> D [Run]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [[BodyPart] -> Run
Footnote [BodyPart]
bps]
      Maybe Element
Nothing  -> [Run] -> D [Run]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [[BodyPart] -> Run
Footnote []]
childElemToRun NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"endnoteReference" Element
element
  , Just Text
enId <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"id" Element
element = do
    Notes
notes <- (ReaderEnv -> Notes)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) Notes
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderEnv -> Notes
envNotes
    case Text -> Notes -> Maybe Element
lookupEndnote Text
enId Notes
notes of
      Just Element
e -> do [BodyPart]
bps <- (ReaderEnv -> ReaderEnv)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart]
forall a.
(ReaderEnv -> ReaderEnv)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\ReaderEnv
r -> ReaderEnv
r {envLocation :: DocumentLocation
envLocation=DocumentLocation
InEndnote}) (ExceptT
   DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart]
 -> ExceptT
      DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart])
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart]
forall a b. (a -> b) -> a -> b
$ (Element -> D BodyPart)
-> [Element]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart]
forall a b. (a -> D b) -> [a] -> D [b]
mapD (NameSpaces -> Element -> D BodyPart
elemToBodyPart NameSpaces
ns) (Element -> [Element]
elChildren Element
e)
                   [Run] -> D [Run]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [[BodyPart] -> Run
Endnote [BodyPart]
bps]
      Maybe Element
Nothing  -> [Run] -> D [Run]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [[BodyPart] -> Run
Endnote []]
childElemToRun NameSpaces
_ Element
_ = DocxError -> D [Run]
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem

elemToRun :: NameSpaces -> Element -> D [Run]
elemToRun :: NameSpaces -> Element -> D [Run]
elemToRun NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"r" Element
element
  , Just Element
altCont <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"mc" Text
"AlternateContent" Element
element =
    do let choices :: [Element]
choices = NameSpaces -> Text -> Text -> Element -> [Element]
findChildrenByName NameSpaces
ns Text
"mc" Text
"Choice" Element
altCont
           choiceChildren :: [Element]
choiceChildren = ([Element] -> Element) -> [[Element]] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map [Element] -> Element
forall a. HasCallStack => [a] -> a
head ([[Element]] -> [Element]) -> [[Element]] -> [Element]
forall a b. (a -> b) -> a -> b
$ ([Element] -> Bool) -> [[Element]] -> [[Element]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Element] -> Bool) -> [Element] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Element] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[Element]] -> [[Element]]) -> [[Element]] -> [[Element]]
forall a b. (a -> b) -> a -> b
$ (Element -> [Element]) -> [Element] -> [[Element]]
forall a b. (a -> b) -> [a] -> [b]
map Element -> [Element]
elChildren [Element]
choices
       [[Run]]
outputs <- (Element -> D [Run])
-> [Element]
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) [[Run]]
forall a b. (a -> D b) -> [a] -> D [b]
mapD (NameSpaces -> Element -> D [Run]
childElemToRun NameSpaces
ns) [Element]
choiceChildren
       case [[Run]]
outputs of
         [Run]
r : [[Run]]
_ -> [Run] -> D [Run]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Run]
r
         []    -> DocxError -> D [Run]
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem
elemToRun NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"r" Element
element
  , Just Element
drawingElem <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"drawing" Element
element =
    NameSpaces -> Element -> D [Run]
childElemToRun NameSpaces
ns Element
drawingElem
elemToRun NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"r" Element
element
  , Just Element
ref <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"footnoteReference" Element
element =
    NameSpaces -> Element -> D [Run]
childElemToRun NameSpaces
ns Element
ref
elemToRun NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"r" Element
element
  , Just Element
ref <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"endnoteReference" Element
element =
    NameSpaces -> Element -> D [Run]
childElemToRun NameSpaces
ns Element
ref
elemToRun NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"r" Element
element = do
    [RunElem]
runElems <- NameSpaces -> Element -> D [RunElem]
elemToRunElems NameSpaces
ns Element
element
    RunStyle
runStyle <- NameSpaces -> Element -> D RunStyle
elemToRunStyleD NameSpaces
ns Element
element
    [Run] -> D [Run]
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return [RunStyle -> [RunElem] -> Run
Run RunStyle
runStyle [RunElem]
runElems]
elemToRun NameSpaces
_ Element
_ = DocxError -> D [Run]
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem

getParentStyleValue :: (ParStyle -> Maybe a) -> ParStyle -> Maybe a
getParentStyleValue :: forall a. (ParStyle -> Maybe a) -> ParStyle -> Maybe a
getParentStyleValue ParStyle -> Maybe a
field ParStyle
style
  | Just a
value <- ParStyle -> Maybe a
field ParStyle
style = a -> Maybe a
forall a. a -> Maybe a
Just a
value
  | Just ParStyle
parentStyle <- ParStyle -> Maybe ParStyle
psParentStyle ParStyle
style
                      = (ParStyle -> Maybe a) -> ParStyle -> Maybe a
forall a. (ParStyle -> Maybe a) -> ParStyle -> Maybe a
getParentStyleValue ParStyle -> Maybe a
field ParStyle
parentStyle
getParentStyleValue ParStyle -> Maybe a
_ ParStyle
_ = Maybe a
forall a. Maybe a
Nothing

getParStyleField :: (ParStyle -> Maybe a) -> [ParStyle] -> Maybe a
getParStyleField :: forall a. (ParStyle -> Maybe a) -> [ParStyle] -> Maybe a
getParStyleField ParStyle -> Maybe a
field [ParStyle]
styles
  | (a
y:[a]
_) <- (ParStyle -> Maybe a) -> [ParStyle] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((ParStyle -> Maybe a) -> ParStyle -> Maybe a
forall a. (ParStyle -> Maybe a) -> ParStyle -> Maybe a
getParentStyleValue ParStyle -> Maybe a
field) [ParStyle]
styles
           = a -> Maybe a
forall a. a -> Maybe a
Just a
y
getParStyleField ParStyle -> Maybe a
_ [ParStyle]
_ = Maybe a
forall a. Maybe a
Nothing

getTrackedChange :: NameSpaces -> Element -> Maybe TrackedChange
getTrackedChange :: NameSpaces -> Element -> Maybe TrackedChange
getTrackedChange NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"ins" Element
element Bool -> Bool -> Bool
|| NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"moveTo" Element
element
  , Just Text
cId <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"id" Element
element
  , Just Text
cAuthor <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"author" Element
element
  , Maybe Text
mcDate <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"date" Element
element =
      TrackedChange -> Maybe TrackedChange
forall a. a -> Maybe a
Just (TrackedChange -> Maybe TrackedChange)
-> TrackedChange -> Maybe TrackedChange
forall a b. (a -> b) -> a -> b
$ ChangeType -> ChangeInfo -> TrackedChange
TrackedChange ChangeType
Insertion (Text -> Text -> Maybe Text -> ChangeInfo
ChangeInfo Text
cId Text
cAuthor Maybe Text
mcDate)
getTrackedChange NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"del" Element
element Bool -> Bool -> Bool
|| NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"moveFrom" Element
element
  , Just Text
cId <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"id" Element
element
  , Just Text
cAuthor <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"author" Element
element
  , Maybe Text
mcDate <- NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"date" Element
element =
      TrackedChange -> Maybe TrackedChange
forall a. a -> Maybe a
Just (TrackedChange -> Maybe TrackedChange)
-> TrackedChange -> Maybe TrackedChange
forall a b. (a -> b) -> a -> b
$ ChangeType -> ChangeInfo -> TrackedChange
TrackedChange ChangeType
Deletion (Text -> Text -> Maybe Text -> ChangeInfo
ChangeInfo Text
cId Text
cAuthor Maybe Text
mcDate)
getTrackedChange NameSpaces
_ Element
_ = Maybe TrackedChange
forall a. Maybe a
Nothing

elemToParagraphStyle :: NameSpaces -> Element
                     -> ParStyleMap
                     -> Numbering
                     -> ParagraphStyle
elemToParagraphStyle :: NameSpaces -> Element -> ParStyleMap -> Numbering -> ParagraphStyle
elemToParagraphStyle NameSpaces
ns Element
element ParStyleMap
sty Numbering
numbering
  | Just Element
pPr <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"pPr" Element
element =
    let style :: [ParaStyleId]
style =
          (Element -> Maybe ParaStyleId) -> [Element] -> [ParaStyleId]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
          ((Text -> ParaStyleId) -> Maybe Text -> Maybe ParaStyleId
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ParaStyleId
ParaStyleId (Maybe Text -> Maybe ParaStyleId)
-> (Element -> Maybe Text) -> Element -> Maybe ParaStyleId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"val")
          (NameSpaces -> Text -> Text -> Element -> [Element]
findChildrenByName NameSpaces
ns Text
"w" Text
"pStyle" Element
pPr)
        pStyle' :: [ParStyle]
pStyle' = (ParaStyleId -> Maybe ParStyle) -> [ParaStyleId] -> [ParStyle]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ParaStyleId -> ParStyleMap -> Maybe ParStyle
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` ParStyleMap
sty) [ParaStyleId]
style
    in ParagraphStyle
      {pStyle :: [ParStyle]
pStyle = [ParStyle]
pStyle'
      , numbered :: Bool
numbered = case NameSpaces -> Element -> Maybe (Text, Text)
getNumInfo NameSpaces
ns Element
element of
          Just (Text
numId, Text
lvl) -> Maybe Level -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Level -> Bool) -> Maybe Level -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Numbering -> Maybe Level
lookupLevel Text
numId Text
lvl Numbering
numbering
          Maybe (Text, Text)
Nothing -> Maybe (Text, Text) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Text, Text) -> Bool) -> Maybe (Text, Text) -> Bool
forall a b. (a -> b) -> a -> b
$ (ParStyle -> Maybe (Text, Text))
-> [ParStyle] -> Maybe (Text, Text)
forall a. (ParStyle -> Maybe a) -> [ParStyle] -> Maybe a
getParStyleField ParStyle -> Maybe (Text, Text)
numInfo [ParStyle]
pStyle'
      , indentation :: Maybe ParIndentation
indentation =
          NameSpaces -> Element -> Maybe ParIndentation
getIndentation NameSpaces
ns Element
element
      , dropCap :: Bool
dropCap =
          case
            NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"framePr" Element
pPr Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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
"dropCap"
          of
            Just Text
"none" -> Bool
False
            Just Text
_      -> Bool
True
            Maybe Text
Nothing     -> Bool
False
      , pChange :: Maybe TrackedChange
pChange     = NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"rPr" Element
pPr Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                      (Element -> Bool) -> Element -> Maybe Element
filterChild (\Element
e -> NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"ins" Element
e Bool -> Bool -> Bool
||
                                         NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"moveTo" Element
e Bool -> Bool -> Bool
||
                                         NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"del" Element
e Bool -> Bool -> Bool
||
                                         NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"moveFrom" Element
e
                                  ) Maybe Element
-> (Element -> Maybe TrackedChange) -> Maybe TrackedChange
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                      NameSpaces -> Element -> Maybe TrackedChange
getTrackedChange NameSpaces
ns
      , pBidi :: Maybe Bool
pBidi = NameSpaces -> Element -> QName -> Maybe Bool
checkOnOff NameSpaces
ns Element
pPr (NameSpaces -> Text -> Text -> QName
elemName NameSpaces
ns Text
"w" Text
"bidi")
      }
  | Bool
otherwise = ParagraphStyle
defaultParagraphStyle

elemToRunStyleD :: NameSpaces -> Element -> D RunStyle
elemToRunStyleD :: NameSpaces -> Element -> D RunStyle
elemToRunStyleD NameSpaces
ns Element
element
  | Just Element
rPr <- NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"rPr" Element
element = do
    CharStyleMap
charStyles <- (ReaderEnv -> CharStyleMap)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) CharStyleMap
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderEnv -> CharStyleMap
envCharStyles
    let parentSty :: Maybe CharStyle
parentSty =
          NameSpaces -> Text -> Text -> Element -> Maybe Element
findChildByName NameSpaces
ns Text
"w" Text
"rStyle" Element
rPr Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 CharStyle) -> Maybe CharStyle
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
          (CharStyleId -> CharStyleMap -> Maybe CharStyle)
-> CharStyleMap -> CharStyleId -> Maybe CharStyle
forall a b c. (a -> b -> c) -> b -> a -> c
flip CharStyleId -> CharStyleMap -> Maybe CharStyle
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup CharStyleMap
charStyles (CharStyleId -> Maybe CharStyle)
-> (Text -> CharStyleId) -> Text -> Maybe CharStyle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CharStyleId
CharStyleId
    RunStyle -> D RunStyle
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RunStyle -> D RunStyle) -> RunStyle -> D RunStyle
forall a b. (a -> b) -> a -> b
$ NameSpaces -> Element -> Maybe CharStyle -> RunStyle
elemToRunStyle NameSpaces
ns Element
element Maybe CharStyle
parentSty
elemToRunStyleD NameSpaces
_ Element
_ = RunStyle -> D RunStyle
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return RunStyle
defaultRunStyle

elemToRunElem :: NameSpaces -> Element -> D RunElem
elemToRunElem :: NameSpaces -> Element -> D RunElem
elemToRunElem NameSpaces
ns Element
element
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"t" Element
element
    Bool -> Bool -> Bool
|| NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"delText" Element
element
    Bool -> Bool -> Bool
|| NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"m" Text
"t" Element
element = do
    let str :: Text
str = Element -> Text
strContent Element
element
    Maybe Font
font <- (ReaderEnv -> Maybe Font)
-> ExceptT
     DocxError (ReaderT ReaderEnv (State ReaderState)) (Maybe Font)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderEnv -> Maybe Font
envFont
    case Maybe Font
font of
      Maybe Font
Nothing -> RunElem -> D RunElem
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RunElem -> D RunElem) -> RunElem -> D RunElem
forall a b. (a -> b) -> a -> b
$ Text -> RunElem
TextRun Text
str
      Just Font
f  -> RunElem -> D RunElem
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (RunElem -> D RunElem) -> (Text -> RunElem) -> Text -> D RunElem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> RunElem
TextRun (Text -> D RunElem) -> Text -> D RunElem
forall a b. (a -> b) -> a -> b
$
                  (Char -> Char) -> Text -> Text
T.map (\Char
x -> Char -> Maybe Char -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
x (Maybe Char -> Char) -> (Char -> Maybe Char) -> Char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Font -> Char -> Maybe Char
getUnicode Font
f (Char -> Maybe Char) -> (Char -> Char) -> Char -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char
lowerFromPrivate (Char -> Char) -> Char -> Char
forall a b. (a -> b) -> a -> b
$ Char
x) Text
str
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"br" Element
element = RunElem -> D RunElem
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return RunElem
LnBrk
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"tab" Element
element = RunElem -> D RunElem
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return RunElem
Tab
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"softHyphen" Element
element = RunElem -> D RunElem
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return RunElem
SoftHyphen
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"noBreakHyphen" Element
element = RunElem -> D RunElem
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return RunElem
NoBreakHyphen
  | NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"sym" Element
element = RunElem -> D RunElem
forall a.
a -> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall (m :: * -> *) a. Monad m => a -> m a
return (NameSpaces -> Element -> RunElem
getSymChar NameSpaces
ns Element
element)
  | Bool
otherwise = DocxError -> D RunElem
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem
  where
    lowerFromPrivate :: Char -> Char
lowerFromPrivate (Char -> Int
ord -> Int
c)
      | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Char -> Int
ord Char
'\xF000' = Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'\xF000'
      | Bool
otherwise = Int -> Char
chr Int
c

-- The char attribute is a hex string
getSymChar :: NameSpaces -> Element -> RunElem
getSymChar :: NameSpaces -> Element -> RunElem
getSymChar NameSpaces
ns Element
element
  | Just Text
s <- Text -> Text
lowerFromPrivate (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
getCodepoint
  , Just Font
font <- Maybe Font
getFont =
    case ReadS Char
readLitChar ([Char]
"\\x" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
s) of
         [(Char
char, [Char]
_)] -> Text -> RunElem
TextRun (Text -> RunElem) -> (Maybe Char -> Text) -> Maybe Char -> RunElem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> (Char -> Text) -> Maybe Char -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" Char -> Text
T.singleton (Maybe Char -> RunElem) -> Maybe Char -> RunElem
forall a b. (a -> b) -> a -> b
$ Font -> Char -> Maybe Char
getUnicode Font
font Char
char
         [(Char, [Char])]
_           -> Text -> RunElem
TextRun Text
""
  where
    getCodepoint :: Maybe Text
getCodepoint = NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"char" Element
element
    getFont :: Maybe Font
getFont = Text -> Maybe Font
textToFont (Text -> Maybe Font) -> Maybe Text -> Maybe Font
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NameSpaces -> Text -> Text -> Element -> Maybe Text
findAttrByName NameSpaces
ns Text
"w" Text
"font" Element
element
    lowerFromPrivate :: Text -> Text
lowerFromPrivate Text
t | Text
"F" Text -> Text -> Bool
`T.isPrefixOf` Text
t = Text
"0" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
1 Text
t
                       | Bool
otherwise             = Text
t
getSymChar NameSpaces
_ Element
_ = Text -> RunElem
TextRun Text
""

elemToRunElems :: NameSpaces -> Element -> D [RunElem]
elemToRunElems :: NameSpaces -> Element -> D [RunElem]
elemToRunElems NameSpaces
ns Element
element
  |  NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"w" Text
"r" Element
element
     Bool -> Bool -> Bool
|| NameSpaces -> Text -> Text -> Element -> Bool
isElem NameSpaces
ns Text
"m" Text
"r" Element
element = do
       let qualName :: Text -> QName
qualName = NameSpaces -> Text -> Text -> QName
elemName NameSpaces
ns Text
"w"
       let font :: Maybe Font
font = do
                    Element
fontElem <- QName -> Element -> Maybe Element
findElement (Text -> QName
qualName Text
"rFonts") Element
element
                    Text -> Maybe Font
textToFont (Text -> Maybe Font) -> Maybe Text -> Maybe Font
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                       (Text -> Maybe Text -> Maybe Text)
-> Maybe Text -> [Text] -> Maybe Text
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (Maybe Text -> Maybe Text -> Maybe Text)
-> (Text -> Maybe Text) -> Text -> Maybe Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((QName -> Element -> Maybe Text) -> Element -> QName -> Maybe Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip QName -> Element -> Maybe Text
findAttr Element
fontElem (QName -> Maybe Text) -> (Text -> QName) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> QName
qualName))
                         Maybe Text
forall a. Maybe a
Nothing [Text
"ascii", Text
"hAnsi"]
       (ReaderEnv -> ReaderEnv) -> D [RunElem] -> D [RunElem]
forall a.
(ReaderEnv -> ReaderEnv)
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Maybe Font -> ReaderEnv -> ReaderEnv
setFont Maybe Font
font) ((Element -> D RunElem) -> [Element] -> D [RunElem]
forall a b. (a -> D b) -> [a] -> D [b]
mapD (NameSpaces -> Element -> D RunElem
elemToRunElem NameSpaces
ns) (Element -> [Element]
elChildren Element
element))
elemToRunElems NameSpaces
_ Element
_ = DocxError -> D [RunElem]
forall a.
DocxError
-> ExceptT DocxError (ReaderT ReaderEnv (State ReaderState)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem

setFont :: Maybe Font -> ReaderEnv -> ReaderEnv
setFont :: Maybe Font -> ReaderEnv -> ReaderEnv
setFont Maybe Font
f ReaderEnv
s = ReaderEnv
s{envFont :: Maybe Font
envFont = Maybe Font
f}