{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
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
, :: 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)
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
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
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 | | 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 = 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 = | 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
| Restart
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]
-> Maybe Integer
-> Maybe [(Int, Cell)]
-> [(Int, Cell)]
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
}
type Extent = Maybe (Double, Double)
data ParPart = PlainRun Run
| ChangedRuns TrackedChange [Run]
| CommentId Author (Maybe CommentDate) [BodyPart]
| CommentId
| BookMark BookMarkId Anchor
| InternalHyperLink Anchor [ParPart]
| ExternalHyperLink URL [ParPart]
| Drawing FilePath T.Text T.Text B.ByteString Extent
| Chart
| Diagram
| 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]
| [BodyPart]
| Endnote [BodyPart]
| InlineDrawing FilePath T.Text T.Text B.ByteString Extent
| InlineChart
| InlineDiagram
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 = T.Text
type Author = T.Text
type ChangeDate = T.Text
type = 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
[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
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
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
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
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
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}
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
<|>
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
>>=
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]
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 []
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 []
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
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])
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]
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]
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
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
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}