{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ViewPatterns #-}
{-# 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(..)
, Cell(..)
, TrackedChange(..)
, ChangeType(..)
, ChangeInfo(..)
, FieldInfo(..)
, Level(..)
, ParaStyleName
, CharStyleName
, FromStyleName(..)
, HasStyleName(..)
, HasParentStyle(..)
, archiveToDocx
, archiveToDocxWithWarnings
, getStyleNames
, pHeading
, constructBogusParStyleData
, leftBiasedMergeRunStyle
) where
import Prelude
import Text.Pandoc.Readers.Docx.Parse.Styles
import Codec.Archive.Zip
import Control.Applicative ((<|>))
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.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.XML.Light
import qualified Text.XML.Light.Cursor as XMLC
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 -> FilePath
envDocXmlPath :: FilePath
}
deriving Int -> ReaderEnv -> ShowS
[ReaderEnv] -> ShowS
ReaderEnv -> FilePath
(Int -> ReaderEnv -> ShowS)
-> (ReaderEnv -> FilePath)
-> ([ReaderEnv] -> ShowS)
-> Show ReaderEnv
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ReaderEnv] -> ShowS
$cshowList :: [ReaderEnv] -> ShowS
show :: ReaderEnv -> FilePath
$cshow :: ReaderEnv -> FilePath
showsPrec :: Int -> ReaderEnv -> ShowS
$cshowsPrec :: Int -> ReaderEnv -> ShowS
Show
data ReaderState = ReaderState { ReaderState -> [Text]
stateWarnings :: [T.Text]
, ReaderState -> FldCharState
stateFldCharState :: FldCharState
}
deriving Int -> ReaderState -> ShowS
[ReaderState] -> ShowS
ReaderState -> FilePath
(Int -> ReaderState -> ShowS)
-> (ReaderState -> FilePath)
-> ([ReaderState] -> ShowS)
-> Show ReaderState
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ReaderState] -> ShowS
$cshowList :: [ReaderState] -> ShowS
show :: ReaderState -> FilePath
$cshow :: ReaderState -> FilePath
showsPrec :: Int -> ReaderState -> ShowS
$cshowsPrec :: Int -> ReaderState -> ShowS
Show
data FldCharState = FldCharOpen
| FldCharFieldInfo FieldInfo
| FldCharContent FieldInfo [Run]
| FldCharClosed
deriving (Int -> FldCharState -> ShowS
[FldCharState] -> ShowS
FldCharState -> FilePath
(Int -> FldCharState -> ShowS)
-> (FldCharState -> FilePath)
-> ([FldCharState] -> ShowS)
-> Show FldCharState
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [FldCharState] -> ShowS
$cshowList :: [FldCharState] -> ShowS
show :: FldCharState -> FilePath
$cshow :: FldCharState -> FilePath
showsPrec :: Int -> FldCharState -> ShowS
$cshowsPrec :: Int -> FldCharState -> ShowS
Show)
data DocxError = DocxError
| WrongElem
deriving Int -> DocxError -> ShowS
[DocxError] -> ShowS
DocxError -> FilePath
(Int -> DocxError -> ShowS)
-> (DocxError -> FilePath)
-> ([DocxError] -> ShowS)
-> Show DocxError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DocxError] -> ShowS
$cshowList :: [DocxError] -> ShowS
show :: DocxError -> FilePath
$cshow :: DocxError -> FilePath
showsPrec :: Int -> DocxError -> ShowS
$cshowsPrec :: Int -> DocxError -> ShowS
Show
type D = ExceptT DocxError (ReaderT ReaderEnv (State ReaderState))
runD :: D a -> ReaderEnv -> ReaderState -> (Either DocxError a, ReaderState)
runD :: D a
-> ReaderEnv -> ReaderState -> (Either DocxError a, ReaderState)
runD dx :: D a
dx re :: ReaderEnv
re rs :: 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 :: Maybe a -> D a
maybeToD (Just a :: a
a) = a -> D a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
maybeToD Nothing = DocxError -> D a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
DocxError
eitherToD :: Either a b -> D b
eitherToD :: Either a b -> D b
eitherToD (Right b :: b
b) = b -> D b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
eitherToD (Left _) = DocxError -> D b
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
DocxError
concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b]
concatMapM :: (a -> m [b]) -> [a] -> m [b]
concatMapM f :: a -> m [b]
f xs :: [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)
mapM a -> m [b]
f [a]
xs)
mapD :: (a -> D b) -> [a] -> D [b]
mapD :: (a -> D b) -> [a] -> D [b]
mapD f :: a -> D b
f xs :: [a]
xs =
let handler :: a -> D [b]
handler x :: a
x = (a -> D b
f a
x D b -> (b -> D [b]) -> D [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\y :: b
y-> [b] -> D [b]
forall (m :: * -> *) a. Monad m => a -> m a
return [b
y])) D [b] -> (DocxError -> D [b]) -> D [b]
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` (\_ -> [b] -> D [b]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
in
(a -> D [b]) -> [a] -> D [b]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM a -> D [b]
handler [a]
xs
unwrap :: NameSpaces -> Content -> [Content]
unwrap :: NameSpaces -> Content -> [Content]
unwrap ns :: NameSpaces
ns (Elem element :: Element
element)
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "sdt" Element
element
, Just sdtContent :: Element
sdtContent <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "sdtContent" Element
element
= (Element -> [Content]) -> [Element] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NameSpaces -> Content -> [Content]
unwrap NameSpaces
ns (Content -> [Content])
-> (Element -> Content) -> Element -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Content
Elem) (Element -> [Element]
elChildren Element
sdtContent)
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "smartTag" Element
element
= (Element -> [Content]) -> [Element] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NameSpaces -> Content -> [Content]
unwrap NameSpaces
ns (Content -> [Content])
-> (Element -> Content) -> Element -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Content
Elem) (Element -> [Element]
elChildren Element
element)
unwrap _ content :: Content
content = [Content
content]
unwrapChild :: NameSpaces -> Content -> Content
unwrapChild :: NameSpaces -> Content -> Content
unwrapChild ns :: NameSpaces
ns (Elem element :: Element
element) =
Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Element
element { elContent :: [Content]
elContent = (Content -> [Content]) -> [Content] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (NameSpaces -> Content -> [Content]
unwrap NameSpaces
ns) (Element -> [Content]
elContent Element
element) }
unwrapChild _ content :: Content
content = Content
content
walkDocument' :: NameSpaces -> XMLC.Cursor -> XMLC.Cursor
walkDocument' :: NameSpaces -> Cursor -> Cursor
walkDocument' ns :: NameSpaces
ns cur :: Cursor
cur =
let modifiedCur :: Cursor
modifiedCur = (Content -> Content) -> Cursor -> Cursor
XMLC.modifyContent (NameSpaces -> Content -> Content
unwrapChild NameSpaces
ns) Cursor
cur
in
case Cursor -> Maybe Cursor
XMLC.nextDF Cursor
modifiedCur of
Just cur' :: Cursor
cur' -> NameSpaces -> Cursor -> Cursor
walkDocument' NameSpaces
ns Cursor
cur'
Nothing -> Cursor -> Cursor
XMLC.root Cursor
modifiedCur
walkDocument :: NameSpaces -> Element -> Maybe Element
walkDocument :: NameSpaces -> Element -> Maybe Element
walkDocument ns :: NameSpaces
ns element :: Element
element =
let cur :: Cursor
cur = Content -> Cursor
XMLC.fromContent (Element -> Content
Elem Element
element)
cur' :: Cursor
cur' = NameSpaces -> Cursor -> Cursor
walkDocument' NameSpaces
ns Cursor
cur
in
case Cursor -> Content
XMLC.toTree Cursor
cur' of
Elem element' :: Element
element' -> Element -> Maybe Element
forall a. a -> Maybe a
Just Element
element'
_ -> Maybe Element
forall a. Maybe a
Nothing
newtype Docx = Docx Document
deriving Int -> Docx -> ShowS
[Docx] -> ShowS
Docx -> FilePath
(Int -> Docx -> ShowS)
-> (Docx -> FilePath) -> ([Docx] -> ShowS) -> Show Docx
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Docx] -> ShowS
$cshowList :: [Docx] -> ShowS
show :: Docx -> FilePath
$cshow :: Docx -> FilePath
showsPrec :: Int -> Docx -> ShowS
$cshowsPrec :: Int -> Docx -> ShowS
Show
data Document = Document NameSpaces Body
deriving Int -> Document -> ShowS
[Document] -> ShowS
Document -> FilePath
(Int -> Document -> ShowS)
-> (Document -> FilePath) -> ([Document] -> ShowS) -> Show Document
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Document] -> ShowS
$cshowList :: [Document] -> ShowS
show :: Document -> FilePath
$cshow :: Document -> FilePath
showsPrec :: Int -> Document -> ShowS
$cshowsPrec :: Int -> Document -> ShowS
Show
newtype Body = Body [BodyPart]
deriving Int -> Body -> ShowS
[Body] -> ShowS
Body -> FilePath
(Int -> Body -> ShowS)
-> (Body -> FilePath) -> ([Body] -> ShowS) -> Show Body
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Body] -> ShowS
$cshowList :: [Body] -> ShowS
show :: Body -> FilePath
$cshow :: Body -> FilePath
showsPrec :: Int -> Body -> ShowS
$cshowsPrec :: Int -> 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 -> FilePath
(Int -> Numbering -> ShowS)
-> (Numbering -> FilePath)
-> ([Numbering] -> ShowS)
-> Show Numbering
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Numbering] -> ShowS
$cshowList :: [Numbering] -> ShowS
show :: Numbering -> FilePath
$cshow :: Numbering -> FilePath
showsPrec :: Int -> Numbering -> ShowS
$cshowsPrec :: Int -> Numbering -> ShowS
Show
data Numb = Numb T.Text T.Text [LevelOverride]
deriving Int -> Numb -> ShowS
[Numb] -> ShowS
Numb -> FilePath
(Int -> Numb -> ShowS)
-> (Numb -> FilePath) -> ([Numb] -> ShowS) -> Show Numb
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Numb] -> ShowS
$cshowList :: [Numb] -> ShowS
show :: Numb -> FilePath
$cshow :: Numb -> FilePath
showsPrec :: Int -> Numb -> ShowS
$cshowsPrec :: Int -> Numb -> ShowS
Show
data LevelOverride = LevelOverride T.Text (Maybe Integer) (Maybe Level)
deriving Int -> LevelOverride -> ShowS
[LevelOverride] -> ShowS
LevelOverride -> FilePath
(Int -> LevelOverride -> ShowS)
-> (LevelOverride -> FilePath)
-> ([LevelOverride] -> ShowS)
-> Show LevelOverride
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [LevelOverride] -> ShowS
$cshowList :: [LevelOverride] -> ShowS
show :: LevelOverride -> FilePath
$cshow :: LevelOverride -> FilePath
showsPrec :: Int -> LevelOverride -> ShowS
$cshowsPrec :: Int -> LevelOverride -> ShowS
Show
data AbstractNumb = AbstractNumb T.Text [Level]
deriving Int -> AbstractNumb -> ShowS
[AbstractNumb] -> ShowS
AbstractNumb -> FilePath
(Int -> AbstractNumb -> ShowS)
-> (AbstractNumb -> FilePath)
-> ([AbstractNumb] -> ShowS)
-> Show AbstractNumb
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [AbstractNumb] -> ShowS
$cshowList :: [AbstractNumb] -> ShowS
show :: AbstractNumb -> FilePath
$cshow :: AbstractNumb -> FilePath
showsPrec :: Int -> AbstractNumb -> ShowS
$cshowsPrec :: Int -> AbstractNumb -> ShowS
Show
data Level = Level T.Text T.Text T.Text (Maybe Integer)
deriving Int -> Level -> ShowS
[Level] -> ShowS
Level -> FilePath
(Int -> Level -> ShowS)
-> (Level -> FilePath) -> ([Level] -> ShowS) -> Show Level
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Level] -> ShowS
$cshowList :: [Level] -> ShowS
show :: Level -> FilePath
$cshow :: Level -> FilePath
showsPrec :: Int -> Level -> ShowS
$cshowsPrec :: Int -> 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
/= :: DocumentLocation -> DocumentLocation -> Bool
$c/= :: DocumentLocation -> DocumentLocation -> Bool
== :: DocumentLocation -> DocumentLocation -> Bool
$c== :: DocumentLocation -> DocumentLocation -> Bool
Eq,Int -> DocumentLocation -> ShowS
[DocumentLocation] -> ShowS
DocumentLocation -> FilePath
(Int -> DocumentLocation -> ShowS)
-> (DocumentLocation -> FilePath)
-> ([DocumentLocation] -> ShowS)
-> Show DocumentLocation
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [DocumentLocation] -> ShowS
$cshowList :: [DocumentLocation] -> ShowS
show :: DocumentLocation -> FilePath
$cshow :: DocumentLocation -> FilePath
showsPrec :: Int -> DocumentLocation -> ShowS
$cshowsPrec :: Int -> DocumentLocation -> ShowS
Show)
data Relationship = Relationship DocumentLocation RelId Target
deriving Int -> Relationship -> ShowS
[Relationship] -> ShowS
Relationship -> FilePath
(Int -> Relationship -> ShowS)
-> (Relationship -> FilePath)
-> ([Relationship] -> ShowS)
-> Show Relationship
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Relationship] -> ShowS
$cshowList :: [Relationship] -> ShowS
show :: Relationship -> FilePath
$cshow :: Relationship -> FilePath
showsPrec :: Int -> Relationship -> ShowS
$cshowsPrec :: Int -> 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 -> FilePath
(Int -> Notes -> ShowS)
-> (Notes -> FilePath) -> ([Notes] -> ShowS) -> Show Notes
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Notes] -> ShowS
$cshowList :: [Notes] -> ShowS
show :: Notes -> FilePath
$cshow :: Notes -> FilePath
showsPrec :: Int -> Notes -> ShowS
$cshowsPrec :: Int -> Notes -> ShowS
Show
data = NameSpaces (M.Map T.Text Element)
deriving Int -> Comments -> ShowS
[Comments] -> ShowS
Comments -> FilePath
(Int -> Comments -> ShowS)
-> (Comments -> FilePath) -> ([Comments] -> ShowS) -> Show Comments
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Comments] -> ShowS
$cshowList :: [Comments] -> ShowS
show :: Comments -> FilePath
$cshow :: Comments -> FilePath
showsPrec :: Int -> Comments -> ShowS
$cshowsPrec :: Int -> Comments -> ShowS
Show
data ParIndentation = ParIndentation { ParIndentation -> Maybe Integer
leftParIndent :: Maybe Integer
, ParIndentation -> Maybe Integer
rightParIndent :: Maybe Integer
, ParIndentation -> Maybe Integer
hangingParIndent :: Maybe Integer}
deriving Int -> ParIndentation -> ShowS
[ParIndentation] -> ShowS
ParIndentation -> FilePath
(Int -> ParIndentation -> ShowS)
-> (ParIndentation -> FilePath)
-> ([ParIndentation] -> ShowS)
-> Show ParIndentation
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ParIndentation] -> ShowS
$cshowList :: [ParIndentation] -> ShowS
show :: ParIndentation -> FilePath
$cshow :: ParIndentation -> FilePath
showsPrec :: Int -> ParIndentation -> ShowS
$cshowsPrec :: Int -> ParIndentation -> ShowS
Show
data ChangeType = Insertion | Deletion
deriving Int -> ChangeType -> ShowS
[ChangeType] -> ShowS
ChangeType -> FilePath
(Int -> ChangeType -> ShowS)
-> (ChangeType -> FilePath)
-> ([ChangeType] -> ShowS)
-> Show ChangeType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ChangeType] -> ShowS
$cshowList :: [ChangeType] -> ShowS
show :: ChangeType -> FilePath
$cshow :: ChangeType -> FilePath
showsPrec :: Int -> ChangeType -> ShowS
$cshowsPrec :: Int -> ChangeType -> ShowS
Show
data ChangeInfo = ChangeInfo ChangeId Author ChangeDate
deriving Int -> ChangeInfo -> ShowS
[ChangeInfo] -> ShowS
ChangeInfo -> FilePath
(Int -> ChangeInfo -> ShowS)
-> (ChangeInfo -> FilePath)
-> ([ChangeInfo] -> ShowS)
-> Show ChangeInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ChangeInfo] -> ShowS
$cshowList :: [ChangeInfo] -> ShowS
show :: ChangeInfo -> FilePath
$cshow :: ChangeInfo -> FilePath
showsPrec :: Int -> ChangeInfo -> ShowS
$cshowsPrec :: Int -> ChangeInfo -> ShowS
Show
data TrackedChange = TrackedChange ChangeType ChangeInfo
deriving Int -> TrackedChange -> ShowS
[TrackedChange] -> ShowS
TrackedChange -> FilePath
(Int -> TrackedChange -> ShowS)
-> (TrackedChange -> FilePath)
-> ([TrackedChange] -> ShowS)
-> Show TrackedChange
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TrackedChange] -> ShowS
$cshowList :: [TrackedChange] -> ShowS
show :: TrackedChange -> FilePath
$cshow :: TrackedChange -> FilePath
showsPrec :: Int -> TrackedChange -> ShowS
$cshowsPrec :: Int -> TrackedChange -> ShowS
Show
data ParagraphStyle = ParagraphStyle { ParagraphStyle -> [ParStyle]
pStyle :: [ParStyle]
, ParagraphStyle -> Maybe ParIndentation
indentation :: Maybe ParIndentation
, ParagraphStyle -> Bool
dropCap :: Bool
, ParagraphStyle -> Maybe TrackedChange
pChange :: Maybe TrackedChange
, ParagraphStyle -> Maybe Bool
pBidi :: Maybe Bool
}
deriving Int -> ParagraphStyle -> ShowS
[ParagraphStyle] -> ShowS
ParagraphStyle -> FilePath
(Int -> ParagraphStyle -> ShowS)
-> (ParagraphStyle -> FilePath)
-> ([ParagraphStyle] -> ShowS)
-> Show ParagraphStyle
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ParagraphStyle] -> ShowS
$cshowList :: [ParagraphStyle] -> ShowS
show :: ParagraphStyle -> FilePath
$cshow :: ParagraphStyle -> FilePath
showsPrec :: Int -> ParagraphStyle -> ShowS
$cshowsPrec :: Int -> ParagraphStyle -> ShowS
Show
defaultParagraphStyle :: ParagraphStyle
defaultParagraphStyle :: ParagraphStyle
defaultParagraphStyle = ParagraphStyle :: [ParStyle]
-> Maybe ParIndentation
-> Bool
-> Maybe TrackedChange
-> Maybe Bool
-> ParagraphStyle
ParagraphStyle { pStyle :: [ParStyle]
pStyle = []
, indentation :: Maybe ParIndentation
indentation = Maybe ParIndentation
forall a. Maybe a
Nothing
, 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]
| OMathPara [Exp]
deriving Int -> BodyPart -> ShowS
[BodyPart] -> ShowS
BodyPart -> FilePath
(Int -> BodyPart -> ShowS)
-> (BodyPart -> FilePath) -> ([BodyPart] -> ShowS) -> Show BodyPart
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [BodyPart] -> ShowS
$cshowList :: [BodyPart] -> ShowS
show :: BodyPart -> FilePath
$cshow :: BodyPart -> FilePath
showsPrec :: Int -> BodyPart -> ShowS
$cshowsPrec :: Int -> BodyPart -> ShowS
Show
type TblGrid = [Integer]
newtype TblLook = TblLook {TblLook -> Bool
firstRowFormatting::Bool}
deriving Int -> TblLook -> ShowS
[TblLook] -> ShowS
TblLook -> FilePath
(Int -> TblLook -> ShowS)
-> (TblLook -> FilePath) -> ([TblLook] -> ShowS) -> Show TblLook
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [TblLook] -> ShowS
$cshowList :: [TblLook] -> ShowS
show :: TblLook -> FilePath
$cshow :: TblLook -> FilePath
showsPrec :: Int -> TblLook -> ShowS
$cshowsPrec :: Int -> TblLook -> ShowS
Show
defaultTblLook :: TblLook
defaultTblLook :: TblLook
defaultTblLook = TblLook :: Bool -> TblLook
TblLook{firstRowFormatting :: Bool
firstRowFormatting = Bool
False}
newtype Row = Row [Cell]
deriving Int -> Row -> ShowS
[Row] -> ShowS
Row -> FilePath
(Int -> Row -> ShowS)
-> (Row -> FilePath) -> ([Row] -> ShowS) -> Show Row
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Row] -> ShowS
$cshowList :: [Row] -> ShowS
show :: Row -> FilePath
$cshow :: Row -> FilePath
showsPrec :: Int -> Row -> ShowS
$cshowsPrec :: Int -> Row -> ShowS
Show
newtype Cell = Cell [BodyPart]
deriving Int -> Cell -> ShowS
[Cell] -> ShowS
Cell -> FilePath
(Int -> Cell -> ShowS)
-> (Cell -> FilePath) -> ([Cell] -> ShowS) -> Show Cell
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Cell] -> ShowS
$cshowList :: [Cell] -> ShowS
show :: Cell -> FilePath
$cshow :: Cell -> FilePath
showsPrec :: Int -> Cell -> ShowS
$cshowsPrec :: Int -> Cell -> ShowS
Show
leftBiasedMergeRunStyle :: RunStyle -> RunStyle -> RunStyle
leftBiasedMergeRunStyle :: RunStyle -> RunStyle -> RunStyle
leftBiasedMergeRunStyle a :: RunStyle
a b :: RunStyle
b = RunStyle :: Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe VertAlign
-> Maybe FilePath
-> Maybe CharStyle
-> RunStyle
RunStyle
{ isBold :: Maybe Bool
isBold = RunStyle -> Maybe Bool
isBold RunStyle
a Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RunStyle -> Maybe Bool
isBold RunStyle
b
, isItalic :: Maybe Bool
isItalic = RunStyle -> Maybe Bool
isItalic RunStyle
a Maybe Bool -> Maybe Bool -> Maybe Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RunStyle -> Maybe Bool
isItalic RunStyle
b
, isSmallCaps :: Maybe Bool
isSmallCaps = RunStyle -> Maybe Bool
isSmallCaps RunStyle
a Maybe Bool -> Maybe Bool -> Maybe Bool
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 (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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RunStyle -> Maybe Bool
isRTL RunStyle
b
, rVertAlign :: Maybe VertAlign
rVertAlign = RunStyle -> Maybe VertAlign
rVertAlign RunStyle
a Maybe VertAlign -> Maybe VertAlign -> Maybe VertAlign
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RunStyle -> Maybe VertAlign
rVertAlign RunStyle
b
, rUnderline :: Maybe FilePath
rUnderline = RunStyle -> Maybe FilePath
rUnderline RunStyle
a Maybe FilePath -> Maybe FilePath -> Maybe FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> RunStyle -> Maybe FilePath
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 CommentDate [BodyPart]
| CommentId
| BookMark BookMarkId Anchor
| InternalHyperLink Anchor [Run]
| ExternalHyperLink URL [Run]
| Drawing FilePath T.Text T.Text B.ByteString Extent
| Chart
| PlainOMath [Exp]
| Field FieldInfo [Run]
| NullParPart
deriving Int -> ParPart -> ShowS
[ParPart] -> ShowS
ParPart -> FilePath
(Int -> ParPart -> ShowS)
-> (ParPart -> FilePath) -> ([ParPart] -> ShowS) -> Show ParPart
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ParPart] -> ShowS
$cshowList :: [ParPart] -> ShowS
show :: ParPart -> FilePath
$cshow :: ParPart -> FilePath
showsPrec :: Int -> ParPart -> ShowS
$cshowsPrec :: Int -> ParPart -> ShowS
Show
data Run = Run RunStyle [RunElem]
| [BodyPart]
| Endnote [BodyPart]
| InlineDrawing FilePath T.Text T.Text B.ByteString Extent
| InlineChart
deriving Int -> Run -> ShowS
[Run] -> ShowS
Run -> FilePath
(Int -> Run -> ShowS)
-> (Run -> FilePath) -> ([Run] -> ShowS) -> Show Run
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Run] -> ShowS
$cshowList :: [Run] -> ShowS
show :: Run -> FilePath
$cshow :: Run -> FilePath
showsPrec :: Int -> Run -> ShowS
$cshowsPrec :: Int -> Run -> ShowS
Show
data RunElem = TextRun T.Text | LnBrk | Tab | SoftHyphen | NoBreakHyphen
deriving Int -> RunElem -> ShowS
[RunElem] -> ShowS
RunElem -> FilePath
(Int -> RunElem -> ShowS)
-> (RunElem -> FilePath) -> ([RunElem] -> ShowS) -> Show RunElem
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [RunElem] -> ShowS
$cshowList :: [RunElem] -> ShowS
show :: RunElem -> FilePath
$cshow :: RunElem -> FilePath
showsPrec :: Int -> RunElem -> ShowS
$cshowsPrec :: Int -> 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
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
archive = do
FilePath
docXmlPath <- case Archive -> Maybe FilePath
getDocumentXmlPath Archive
archive of
Just fp :: FilePath
fp -> FilePath -> Either DocxError FilePath
forall a b. b -> Either a b
Right FilePath
fp
Nothing -> DocxError -> Either DocxError FilePath
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 -> FilePath -> [Relationship]
archiveToRelationships Archive
archive FilePath
docXmlPath
media :: Media
media = Archive -> (FilePath -> Bool) -> Media
filteredFilesFromArchive Archive
archive FilePath -> Bool
filePathIsMedia
(styles :: CharStyleMap
styles, parstyles :: ParStyleMap
parstyles) = Archive -> (CharStyleMap, ParStyleMap)
archiveToStyles Archive
archive
rEnv :: ReaderEnv
rEnv = ReaderEnv :: Notes
-> Comments
-> Numbering
-> [Relationship]
-> Media
-> Maybe Font
-> CharStyleMap
-> ParStyleMap
-> DocumentLocation
-> FilePath
-> ReaderEnv
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 :: FilePath
envDocXmlPath = FilePath
docXmlPath
}
rState :: ReaderState
rState = ReaderState :: [Text] -> FldCharState -> ReaderState
ReaderState { stateWarnings :: [Text]
stateWarnings = []
, stateFldCharState :: FldCharState
stateFldCharState = FldCharState
FldCharClosed
}
(eitherDoc :: Either DocxError Document
eitherDoc, st :: 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 doc :: 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 e :: DocxError
e -> DocxError -> Either DocxError (Docx, [Text])
forall a b. a -> Either a b
Left DocxError
e
getDocumentXmlPath :: Archive -> Maybe FilePath
getDocumentXmlPath :: Archive -> Maybe FilePath
getDocumentXmlPath zf :: Archive
zf = do
Entry
entry <- FilePath -> Archive -> Maybe Entry
findEntryByPath "_rels/.rels" Archive
zf
Element
relsElem <- (FilePath -> Maybe Element
forall s. XmlSource s => s -> Maybe Element
parseXMLDoc (FilePath -> Maybe Element)
-> (Entry -> FilePath) -> Entry -> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
UTF8.toStringLazy (ByteString -> FilePath)
-> (Entry -> ByteString) -> Entry -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> ByteString
fromEntry) Entry
entry
let rels :: [Element]
rels = (QName -> Bool) -> Element -> [Element]
filterChildrenName (\n :: QName
n -> QName -> FilePath
qName QName
n FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "Relationship") Element
relsElem
Element
rel <- [Element] -> Maybe Element
forall a. [a] -> Maybe a
listToMaybe ([Element] -> Maybe Element) -> [Element] -> Maybe Element
forall a b. (a -> b) -> a -> b
$
(Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter (\e :: Element
e -> QName -> Element -> Maybe FilePath
findAttr (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
QName "Type" Maybe FilePath
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing) Element
e Maybe FilePath -> Maybe FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==
FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument")
[Element]
rels
FilePath
fp <- QName -> Element -> Maybe FilePath
findAttr (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
QName "Target" Maybe FilePath
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing) Element
rel
FilePath -> Maybe FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ case FilePath
fp of
'/' : fp' :: FilePath
fp' -> FilePath
fp'
_ -> FilePath
fp
archiveToDocument :: Archive -> D Document
archiveToDocument :: Archive -> D Document
archiveToDocument zf :: Archive
zf = do
FilePath
docPath <- (ReaderEnv -> FilePath)
-> ExceptT
DocxError (ReaderT ReaderEnv (State ReaderState)) FilePath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ReaderEnv -> FilePath
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
$ FilePath -> Archive -> Maybe Entry
findEntryByPath FilePath
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
$ (FilePath -> Maybe Element
forall s. XmlSource s => s -> Maybe Element
parseXMLDoc (FilePath -> Maybe Element)
-> (Entry -> FilePath) -> Entry -> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
UTF8.toStringLazy (ByteString -> FilePath)
-> (Entry -> ByteString) -> Entry -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> ByteString
fromEntry) 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 -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
namespaces "w" "body" Element
docElem
let bodyElem' :: Element
bodyElem' = Element -> Maybe Element -> Element
forall a. a -> Maybe a -> a
fromMaybe Element
bodyElem (NameSpaces -> Element -> Maybe Element
walkDocument NameSpaces
namespaces Element
bodyElem)
Body
body <- NameSpaces -> Element -> D Body
elemToBody NameSpaces
namespaces Element
bodyElem'
Document -> D Document
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 ns :: NameSpaces
ns element :: Element
element | NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "body" Element
element =
([BodyPart] -> Body)
-> ExceptT
DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart]
-> D Body
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 _ _ = DocxError -> D Body
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 -> CharStyleId
forall a. HasStyleId a => a -> StyleId a
getStyleId 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 :: t a -> t (StyleName a)
getStyleNames = (a -> StyleName a) -> t a -> t (StyleName a)
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 stName :: ParaStyleName
stName = ParStyle :: Maybe (ParaStyleName, Int)
-> Maybe (Text, Text)
-> Maybe ParStyle
-> ParaStyleName
-> ParaStyleId
-> ParStyle
ParStyle
{ headingLev :: Maybe (ParaStyleName, Int)
headingLev = Maybe (ParaStyleName, Int)
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
/=' ') (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 zf :: Archive
zf =
let fnElem :: Maybe Element
fnElem = FilePath -> Archive -> Maybe Entry
findEntryByPath "word/footnotes.xml" Archive
zf
Maybe Entry -> (Entry -> Maybe Element) -> Maybe Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Maybe Element
forall s. XmlSource s => s -> Maybe Element
parseXMLDoc (FilePath -> Maybe Element)
-> (Entry -> FilePath) -> Entry -> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
UTF8.toStringLazy (ByteString -> FilePath)
-> (Entry -> ByteString) -> Entry -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> ByteString
fromEntry)
enElem :: Maybe Element
enElem = FilePath -> Archive -> Maybe Entry
findEntryByPath "word/endnotes.xml" Archive
zf
Maybe Entry -> (Entry -> Maybe Element) -> Maybe Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Maybe Element
forall s. XmlSource s => s -> Maybe Element
parseXMLDoc (FilePath -> Maybe Element)
-> (Entry -> FilePath) -> Entry -> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
UTF8.toStringLazy (ByteString -> FilePath)
-> (Entry -> ByteString) -> Entry -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> ByteString
fromEntry)
fn_namespaces :: NameSpaces
fn_namespaces = case Maybe Element
fnElem of
Just e :: Element
e -> Element -> NameSpaces
elemToNameSpaces Element
e
Nothing -> []
en_namespaces :: NameSpaces
en_namespaces = case Maybe Element
enElem of
Just e :: Element
e -> Element -> NameSpaces
elemToNameSpaces Element
e
Nothing -> []
ns :: NameSpaces
ns = ((FilePath, FilePath) -> (FilePath, FilePath) -> Bool)
-> NameSpaces -> NameSpaces -> NameSpaces
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
unionBy (\x :: (FilePath, FilePath)
x y :: (FilePath, FilePath)
y -> (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst (FilePath, FilePath)
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst (FilePath, FilePath)
y) NameSpaces
fn_namespaces NameSpaces
en_namespaces
fn :: Maybe (Map Text Element)
fn = Maybe Element
fnElem Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> Element -> Maybe Element
walkDocument NameSpaces
ns Maybe Element
-> (Element -> Maybe (Map Text Element))
-> Maybe (Map Text Element)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> FilePath -> Element -> Maybe (Map Text Element)
elemToNotes NameSpaces
ns "footnote"
en :: Maybe (Map Text Element)
en = Maybe Element
enElem Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> Element -> Maybe Element
walkDocument NameSpaces
ns Maybe Element
-> (Element -> Maybe (Map Text Element))
-> Maybe (Map Text Element)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> FilePath -> Element -> Maybe (Map Text Element)
elemToNotes NameSpaces
ns "endnote"
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
zf :: Archive
zf =
let cmtsElem :: Maybe Element
cmtsElem = FilePath -> Archive -> Maybe Entry
findEntryByPath "word/comments.xml" Archive
zf
Maybe Entry -> (Entry -> Maybe Element) -> Maybe Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> Maybe Element
forall s. XmlSource s => s -> Maybe Element
parseXMLDoc (FilePath -> Maybe Element)
-> (Entry -> FilePath) -> Entry -> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
UTF8.toStringLazy (ByteString -> FilePath)
-> (Entry -> ByteString) -> Entry -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> ByteString
fromEntry)
cmts_namespaces :: NameSpaces
cmts_namespaces = case Maybe Element
cmtsElem of
Just e :: Element
e -> Element -> NameSpaces
elemToNameSpaces Element
e
Nothing -> []
cmts :: Maybe (Map Text Element)
cmts = NameSpaces -> Element -> Map Text Element
elemToComments 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 Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> Element -> Maybe Element
walkDocument NameSpaces
cmts_namespaces)
in
case Maybe (Map Text Element)
cmts of
Just c :: Map Text Element
c -> NameSpaces -> Map Text Element -> Comments
Comments NameSpaces
cmts_namespaces Map Text Element
c
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 :: FilePath -> FilePath -> Maybe DocumentLocation
filePathToRelType "word/_rels/footnotes.xml.rels" _ = DocumentLocation -> Maybe DocumentLocation
forall a. a -> Maybe a
Just DocumentLocation
InFootnote
filePathToRelType "word/_rels/endnotes.xml.rels" _ = DocumentLocation -> Maybe DocumentLocation
forall a. a -> Maybe a
Just DocumentLocation
InEndnote
filePathToRelType path :: FilePath
path docXmlPath :: FilePath
docXmlPath =
if FilePath
path FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "word/_rels/" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
takeFileName FilePath
docXmlPath FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ".rels"
then DocumentLocation -> Maybe DocumentLocation
forall a. a -> Maybe a
Just DocumentLocation
InDocument
else Maybe DocumentLocation
forall a. Maybe a
Nothing
relElemToRelationship :: DocumentLocation -> Element -> Maybe Relationship
relElemToRelationship :: DocumentLocation -> Element -> Maybe Relationship
relElemToRelationship relType :: DocumentLocation
relType element :: Element
element | QName -> FilePath
qName (Element -> QName
elName Element
element) FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "Relationship" =
do
Text
relId <- QName -> Element -> Maybe Text
findAttrText (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
QName "Id" Maybe FilePath
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing) Element
element
Text
target <- QName -> Element -> Maybe Text
findAttrText (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
QName "Target" Maybe FilePath
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing) Element
element
Relationship -> Maybe Relationship
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 _ _ = Maybe Relationship
forall a. Maybe a
Nothing
filePathToRelationships :: Archive -> FilePath -> FilePath -> [Relationship]
filePathToRelationships :: Archive -> FilePath -> FilePath -> [Relationship]
filePathToRelationships ar :: Archive
ar docXmlPath :: FilePath
docXmlPath fp :: FilePath
fp
| Just relType :: DocumentLocation
relType <- FilePath -> FilePath -> Maybe DocumentLocation
filePathToRelType FilePath
fp FilePath
docXmlPath
, Just entry :: Entry
entry <- FilePath -> Archive -> Maybe Entry
findEntryByPath FilePath
fp Archive
ar
, Just relElems :: Element
relElems <- (FilePath -> Maybe Element
forall s. XmlSource s => s -> Maybe Element
parseXMLDoc (FilePath -> Maybe Element)
-> (Entry -> FilePath) -> Entry -> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
UTF8.toStringLazy (ByteString -> FilePath)
-> (Entry -> ByteString) -> Entry -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> ByteString
fromEntry) Entry
entry =
(Element -> Maybe Relationship) -> [Element] -> [Relationship]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (DocumentLocation -> Element -> Maybe Relationship
relElemToRelationship DocumentLocation
relType) ([Element] -> [Relationship]) -> [Element] -> [Relationship]
forall a b. (a -> b) -> a -> b
$ Element -> [Element]
elChildren Element
relElems
filePathToRelationships _ _ _ = []
archiveToRelationships :: Archive -> FilePath -> [Relationship]
archiveToRelationships :: Archive -> FilePath -> [Relationship]
archiveToRelationships archive :: Archive
archive docXmlPath :: FilePath
docXmlPath =
(FilePath -> [Relationship]) -> [FilePath] -> [Relationship]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Archive -> FilePath -> FilePath -> [Relationship]
filePathToRelationships Archive
archive FilePath
docXmlPath) ([FilePath] -> [Relationship]) -> [FilePath] -> [Relationship]
forall a b. (a -> b) -> a -> b
$ Archive -> [FilePath]
filesInArchive Archive
archive
filePathIsMedia :: FilePath -> Bool
filePathIsMedia :: FilePath -> Bool
filePathIsMedia fp :: FilePath
fp =
let (dir :: FilePath
dir, _) = FilePath -> (FilePath, FilePath)
splitFileName FilePath
fp
in
(FilePath
dir FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "word/media/")
lookupLevel :: T.Text -> T.Text -> Numbering -> Maybe Level
lookupLevel :: Text -> Text -> Numbering -> Maybe Level
lookupLevel numId :: Text
numId ilvl :: Text
ilvl (Numbering _ numbs :: [Numb]
numbs absNumbs :: [AbstractNumb]
absNumbs) = do
(absNumId :: Text
absNumId, ovrrides :: [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 nid :: Text
nid absnumid :: Text
absnumid ovrRides :: [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 aid :: Text
aid ls :: [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 ilvl' :: Text
ilvl' _ _) -> (Text
ilvl', LevelOverride
lo)) [LevelOverride]
ovrrides
case Maybe LevelOverride
lvlOverride of
Just (LevelOverride _ _ (Just lvl' :: Level
lvl')) -> Level -> Maybe Level
forall a. a -> Maybe a
Just Level
lvl'
Just (LevelOverride _ (Just strt :: Integer
strt) _) ->
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 i :: Text
i fmt :: Text
fmt s :: Text
s _) -> (Text
i, Text -> Text -> Text -> Maybe Integer -> Level
Level Text
i Text
fmt Text
s (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
strt))) [Level]
lvls
_ ->
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 i :: Text
i _ _ _) -> (Text
i, Level
l)) [Level]
lvls
loElemToLevelOverride :: NameSpaces -> Element -> Maybe LevelOverride
loElemToLevelOverride :: NameSpaces -> Element -> Maybe LevelOverride
loElemToLevelOverride ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "lvlOverride" Element
element = do
Text
ilvl <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "ilvl" Element
element
let startOverride :: Maybe Integer
startOverride = NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "startOverride" Element
element
Maybe Element -> (Element -> Maybe FilePath) -> Maybe FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> FilePath -> FilePath -> Element -> Maybe FilePath
findAttrByName NameSpaces
ns "w" "val"
Maybe FilePath -> (FilePath -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s :: FilePath
s -> [Integer] -> Maybe Integer
forall a. [a] -> Maybe a
listToMaybe (((Integer, FilePath) -> Integer)
-> [(Integer, FilePath)] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, FilePath) -> Integer
forall a b. (a, b) -> a
fst (ReadS Integer
forall a. Read a => ReadS a
reads FilePath
s :: [(Integer, String)])))
lvl :: Maybe Level
lvl = NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "lvl" Element
element
Maybe Element -> (Element -> Maybe Level) -> Maybe Level
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> Element -> Maybe Level
levelElemToLevel NameSpaces
ns
LevelOverride -> Maybe LevelOverride
forall (m :: * -> *) a. Monad m => a -> m a
return (LevelOverride -> Maybe LevelOverride)
-> LevelOverride -> Maybe LevelOverride
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Integer -> Maybe Level -> LevelOverride
LevelOverride Text
ilvl Maybe Integer
startOverride Maybe Level
lvl
loElemToLevelOverride _ _ = Maybe LevelOverride
forall a. Maybe a
Nothing
numElemToNum :: NameSpaces -> Element -> Maybe Numb
numElemToNum :: NameSpaces -> Element -> Maybe Numb
numElemToNum ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "num" Element
element = do
Text
numId <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "numId" Element
element
Text
absNumId <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "abstractNumId" Element
element
Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "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 -> FilePath -> FilePath -> Element -> [Element]
findChildrenByName NameSpaces
ns "w" "lvlOverride" Element
element)
Numb -> Maybe Numb
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 _ _ = Maybe Numb
forall a. Maybe a
Nothing
absNumElemToAbsNum :: NameSpaces -> Element -> Maybe AbstractNumb
absNumElemToAbsNum :: NameSpaces -> Element -> Maybe AbstractNumb
absNumElemToAbsNum ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "abstractNum" Element
element = do
Text
absNumId <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "abstractNumId" Element
element
let levelElems :: [Element]
levelElems = NameSpaces -> FilePath -> FilePath -> Element -> [Element]
findChildrenByName NameSpaces
ns "w" "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 (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 _ _ = Maybe AbstractNumb
forall a. Maybe a
Nothing
levelElemToLevel :: NameSpaces -> Element -> Maybe Level
levelElemToLevel :: NameSpaces -> Element -> Maybe Level
levelElemToLevel ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "lvl" Element
element = do
Text
ilvl <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "ilvl" Element
element
Text
fmt <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "numFmt" Element
element
Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "val"
Text
txt <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "lvlText" Element
element
Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "val"
let start :: Maybe Integer
start = NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "start" Element
element
Maybe Element -> (Element -> Maybe FilePath) -> Maybe FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> FilePath -> FilePath -> Element -> Maybe FilePath
findAttrByName NameSpaces
ns "w" "val"
Maybe FilePath -> (FilePath -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s :: FilePath
s -> [Integer] -> Maybe Integer
forall a. [a] -> Maybe a
listToMaybe (((Integer, FilePath) -> Integer)
-> [(Integer, FilePath)] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, FilePath) -> Integer
forall a b. (a, b) -> a
fst (ReadS Integer
forall a. Read a => ReadS a
reads FilePath
s :: [(Integer, String)])))
Level -> Maybe Level
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Text -> Text -> Maybe Integer -> Level
Level Text
ilvl Text
fmt Text
txt Maybe Integer
start)
levelElemToLevel _ _ = Maybe Level
forall a. Maybe a
Nothing
archiveToNumbering' :: Archive -> Maybe Numbering
archiveToNumbering' :: Archive -> Maybe Numbering
archiveToNumbering' zf :: Archive
zf =
case FilePath -> Archive -> Maybe Entry
findEntryByPath "word/numbering.xml" Archive
zf of
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 [] [] []
Just entry :: Entry
entry -> do
Element
numberingElem <- (FilePath -> Maybe Element
forall s. XmlSource s => s -> Maybe Element
parseXMLDoc (FilePath -> Maybe Element)
-> (Entry -> FilePath) -> Entry -> Maybe Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
UTF8.toStringLazy (ByteString -> FilePath)
-> (Entry -> ByteString) -> Entry -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> ByteString
fromEntry) Entry
entry
let namespaces :: NameSpaces
namespaces = Element -> NameSpaces
elemToNameSpaces Element
numberingElem
numElems :: [Element]
numElems = NameSpaces -> FilePath -> FilePath -> Element -> [Element]
findChildrenByName NameSpaces
namespaces "w" "num" Element
numberingElem
absNumElems :: [Element]
absNumElems = NameSpaces -> FilePath -> FilePath -> Element -> [Element]
findChildrenByName NameSpaces
namespaces "w" "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 (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
archive =
Numbering -> Maybe Numbering -> Numbering
forall a. a -> Maybe a -> a
fromMaybe (NameSpaces -> [Numb] -> [AbstractNumb] -> Numbering
Numbering [] [] []) (Archive -> Maybe Numbering
archiveToNumbering' Archive
archive)
elemToNotes :: NameSpaces -> String -> Element -> Maybe (M.Map T.Text Element)
elemToNotes :: NameSpaces -> FilePath -> Element -> Maybe (Map Text Element)
elemToNotes ns :: NameSpaces
ns notetype :: FilePath
notetype element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" (FilePath
notetype FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> "s") Element
element =
let pairs :: [(Text, Element)]
pairs = (Element -> Maybe (Text, Element))
-> [Element] -> [(Text, Element)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
(\e :: Element
e -> NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "id" Element
e Maybe Text
-> (Text -> Maybe (Text, Element)) -> Maybe (Text, Element)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(\a :: Text
a -> (Text, Element) -> Maybe (Text, Element)
forall a. a -> Maybe a
Just (Text
a, Element
e)))
(NameSpaces -> FilePath -> FilePath -> Element -> [Element]
findChildrenByName NameSpaces
ns "w" FilePath
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 _ _ _ = Maybe (Map Text Element)
forall a. Maybe a
Nothing
elemToComments :: NameSpaces -> Element -> M.Map T.Text Element
ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "comments" Element
element =
let pairs :: [(Text, Element)]
pairs = (Element -> Maybe (Text, Element))
-> [Element] -> [(Text, Element)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
(\e :: Element
e -> NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "id" Element
e Maybe Text
-> (Text -> Maybe (Text, Element)) -> Maybe (Text, Element)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(\a :: Text
a -> (Text, Element) -> Maybe (Text, Element)
forall a. a -> Maybe a
Just (Text
a, Element
e)))
(NameSpaces -> FilePath -> FilePath -> Element -> [Element]
findChildrenByName NameSpaces
ns "w" "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 _ _ = Map Text Element
forall k a. Map k a
M.empty
elemToTblGrid :: NameSpaces -> Element -> D TblGrid
elemToTblGrid :: NameSpaces -> Element -> D [Integer]
elemToTblGrid ns :: NameSpaces
ns element :: Element
element | NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "tblGrid" Element
element =
let cols :: [Element]
cols = NameSpaces -> FilePath -> FilePath -> Element -> [Element]
findChildrenByName NameSpaces
ns "w" "gridCol" Element
element
in
(Element -> D Integer) -> [Element] -> D [Integer]
forall a b. (a -> D b) -> [a] -> D [b]
mapD (\e :: Element
e -> Maybe Integer -> D Integer
forall a. Maybe a -> D a
maybeToD (NameSpaces -> FilePath -> FilePath -> Element -> Maybe FilePath
findAttrByName NameSpaces
ns "w" "val" Element
e Maybe FilePath -> (FilePath -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Maybe Integer
stringToInteger))
[Element]
cols
elemToTblGrid _ _ = DocxError -> D [Integer]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem
elemToTblLook :: NameSpaces -> Element -> D TblLook
elemToTblLook :: NameSpaces -> Element -> D TblLook
elemToTblLook ns :: NameSpaces
ns element :: Element
element | NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "tblLook" Element
element =
let firstRow :: Maybe FilePath
firstRow = NameSpaces -> FilePath -> FilePath -> Element -> Maybe FilePath
findAttrByName NameSpaces
ns "w" "firstRow" Element
element
val :: Maybe FilePath
val = NameSpaces -> FilePath -> FilePath -> Element -> Maybe FilePath
findAttrByName NameSpaces
ns "w" "val" Element
element
firstRowFmt :: Bool
firstRowFmt =
case Maybe FilePath
firstRow of
Just "1" -> Bool
True
Just _ -> Bool
False
Nothing -> case Maybe FilePath
val of
Just bitMask :: FilePath
bitMask -> FilePath -> Int -> Bool
testBitMask FilePath
bitMask 0x020
Nothing -> Bool
False
in
TblLook -> D TblLook
forall (m :: * -> *) a. Monad m => a -> m a
return TblLook :: Bool -> TblLook
TblLook{firstRowFormatting :: Bool
firstRowFormatting = Bool
firstRowFmt}
elemToTblLook _ _ = DocxError -> D TblLook
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem
elemToRow :: NameSpaces -> Element -> D Row
elemToRow :: NameSpaces -> Element -> D Row
elemToRow ns :: NameSpaces
ns element :: Element
element | NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "tr" Element
element =
do
let cellElems :: [Element]
cellElems = NameSpaces -> FilePath -> FilePath -> Element -> [Element]
findChildrenByName NameSpaces
ns "w" "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
Row -> D Row
forall (m :: * -> *) a. Monad m => a -> m a
return (Row -> D Row) -> Row -> D Row
forall a b. (a -> b) -> a -> b
$ [Cell] -> Row
Row [Cell]
cells
elemToRow _ _ = DocxError -> D Row
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem
elemToCell :: NameSpaces -> Element -> D Cell
elemToCell :: NameSpaces -> Element -> D Cell
elemToCell ns :: NameSpaces
ns element :: Element
element | NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "tc" Element
element =
do
[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 (m :: * -> *) a. Monad m => a -> m a
return (Cell -> D Cell) -> Cell -> D Cell
forall a b. (a -> b) -> a -> b
$ [BodyPart] -> Cell
Cell [BodyPart]
cellContents
elemToCell _ _ = DocxError -> D Cell
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem
elemToParIndentation :: NameSpaces -> Element -> Maybe ParIndentation
elemToParIndentation :: NameSpaces -> Element -> Maybe ParIndentation
elemToParIndentation ns :: NameSpaces
ns element :: Element
element | NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "ind" Element
element =
ParIndentation -> Maybe ParIndentation
forall a. a -> Maybe a
Just ParIndentation :: Maybe Integer -> Maybe Integer -> Maybe Integer -> ParIndentation
ParIndentation {
leftParIndent :: Maybe Integer
leftParIndent =
NameSpaces -> FilePath -> FilePath -> Element -> Maybe FilePath
findAttrByName NameSpaces
ns "w" "left" Element
element Maybe FilePath -> (FilePath -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
FilePath -> Maybe Integer
stringToInteger
, rightParIndent :: Maybe Integer
rightParIndent =
NameSpaces -> FilePath -> FilePath -> Element -> Maybe FilePath
findAttrByName NameSpaces
ns "w" "right" Element
element Maybe FilePath -> (FilePath -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
FilePath -> Maybe Integer
stringToInteger
, hangingParIndent :: Maybe Integer
hangingParIndent =
NameSpaces -> FilePath -> FilePath -> Element -> Maybe FilePath
findAttrByName NameSpaces
ns "w" "hanging" Element
element Maybe FilePath -> (FilePath -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
FilePath -> Maybe Integer
stringToInteger}
elemToParIndentation _ _ = Maybe ParIndentation
forall a. Maybe a
Nothing
testBitMask :: String -> Int -> Bool
testBitMask :: FilePath -> Int -> Bool
testBitMask bitMaskS :: FilePath
bitMaskS n :: Int
n =
case (ReadS Int
forall a. Read a => ReadS a
reads ("0x" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
bitMaskS) :: [(Int, String)]) of
[] -> Bool
False
((n' :: Int
n', _) : _) -> (Int
n' Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
n) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 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
elemToBodyPart :: NameSpaces -> Element -> D BodyPart
elemToBodyPart :: NameSpaces -> Element -> D BodyPart
elemToBodyPart ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "p" Element
element
, (c :: Element
c:_) <- NameSpaces -> FilePath -> FilePath -> Element -> [Element]
findChildrenByName NameSpaces
ns "m" "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
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Element -> FilePath
showElement Element
c
BodyPart -> D BodyPart
forall (m :: * -> *) a. Monad m => a -> m a
return (BodyPart -> D BodyPart) -> BodyPart -> D BodyPart
forall a b. (a -> b) -> a -> b
$ [Exp] -> BodyPart
OMathPara [Exp]
expsLst
elemToBodyPart ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "p" Element
element
, Just (numId :: Text
numId, lvl :: Text
lvl) <- NameSpaces -> Element -> Maybe (Text, Text)
getNumInfo NameSpaces
ns Element
element = do
ParagraphStyle
parstyle <- NameSpaces -> Element -> ParStyleMap -> ParagraphStyle
elemToParagraphStyle NameSpaces
ns Element
element (ParStyleMap -> ParagraphStyle)
-> ExceptT
DocxError (ReaderT ReaderEnv (State ReaderState)) ParStyleMap
-> ExceptT
DocxError (ReaderT ReaderEnv (State ReaderState)) 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
[ParPart]
parparts <- (Element -> D ParPart) -> [Element] -> D [ParPart]
forall a b. (a -> D b) -> [a] -> D [b]
mapD (NameSpaces -> Element -> D ParPart
elemToParPart NameSpaces
ns) (Element -> [Element]
elChildren Element
element)
Maybe Level
levelInfo <- 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 (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
levelInfo [ParPart]
parparts
elemToBodyPart ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "p" Element
element = do
ParagraphStyle
parstyle <- NameSpaces -> Element -> ParStyleMap -> ParagraphStyle
elemToParagraphStyle NameSpaces
ns Element
element (ParStyleMap -> ParagraphStyle)
-> ExceptT
DocxError (ReaderT ReaderEnv (State ReaderState)) ParStyleMap
-> ExceptT
DocxError (ReaderT ReaderEnv (State ReaderState)) 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
[ParPart]
parparts <- (Element -> D ParPart) -> [Element] -> D [ParPart]
forall a b. (a -> D b) -> [a] -> D [b]
mapD (NameSpaces -> Element -> D ParPart
elemToParPart NameSpaces
ns) (Element -> [Element]
elChildren Element
element)
case ParagraphStyle -> Maybe (ParaStyleName, Int)
pHeading ParagraphStyle
parstyle of
Nothing | Just (numId :: Text
numId, lvl :: Text
lvl) <- ParagraphStyle -> Maybe (Text, Text)
pNumInfo ParagraphStyle
parstyle -> do
Maybe Level
levelInfo <- 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 (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
levelInfo [ParPart]
parparts
_ -> BodyPart -> D BodyPart
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 ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "tbl" Element
element = do
let caption' :: Maybe Text
caption' = NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "tblPr" Element
element
Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "tblCaption"
Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "val"
caption :: Text
caption = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "" Maybe Text
caption'
grid' :: D [Integer]
grid' = case NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "tblGrid" Element
element of
Just g :: Element
g -> NameSpaces -> Element -> D [Integer]
elemToTblGrid NameSpaces
ns Element
g
Nothing -> [Integer] -> D [Integer]
forall (m :: * -> *) a. Monad m => a -> m a
return []
tblLook' :: D TblLook
tblLook' = case NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "tblPr" Element
element Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "tblLook"
of
Just l :: Element
l -> NameSpaces -> Element -> D TblLook
elemToTblLook NameSpaces
ns Element
l
Nothing -> TblLook -> D TblLook
forall (m :: * -> *) a. Monad m => a -> m a
return TblLook
defaultTblLook
[Integer]
grid <- D [Integer]
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 (m :: * -> *) a. Monad m => a -> m a
return (BodyPart -> D BodyPart) -> BodyPart -> D BodyPart
forall a b. (a -> b) -> a -> b
$ Text -> [Integer] -> TblLook -> [Row] -> BodyPart
Tbl Text
caption [Integer]
grid TblLook
tblLook [Row]
rows
elemToBodyPart _ _ = DocxError -> D BodyPart
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 docLocation :: DocumentLocation
docLocation relid :: Text
relid rels :: [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 loc :: DocumentLocation
loc relid' :: Text
relid' target :: Text
target) -> ((DocumentLocation
loc, Text
relid'), Text
target)) [Relationship]
rels
expandDrawingId :: T.Text -> D (FilePath, B.ByteString)
expandDrawingId :: Text -> D (FilePath, ByteString)
expandDrawingId s :: 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 FilePath
target <- (ReaderEnv -> Maybe FilePath)
-> ExceptT
DocxError (ReaderT ReaderEnv (State ReaderState)) (Maybe FilePath)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((Text -> FilePath) -> Maybe Text -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
T.unpack (Maybe Text -> Maybe FilePath)
-> (ReaderEnv -> Maybe Text) -> ReaderEnv -> Maybe FilePath
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 FilePath
target of
Just filepath :: FilePath
filepath -> do
Maybe ByteString
bytes <- (ReaderEnv -> Maybe ByteString)
-> ExceptT
DocxError
(ReaderT ReaderEnv (State ReaderState))
(Maybe ByteString)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (FilePath -> Media -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ("word/" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
filepath) (Media -> Maybe ByteString)
-> (ReaderEnv -> Media) -> ReaderEnv -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderEnv -> Media
envMedia)
case Maybe ByteString
bytes of
Just bs :: ByteString
bs -> (FilePath, ByteString) -> D (FilePath, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
filepath, ByteString
bs)
Nothing -> DocxError -> D (FilePath, ByteString)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
DocxError
Nothing -> DocxError -> D (FilePath, ByteString)
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 ns :: NameSpaces
ns element :: Element
element =
let mbDocPr :: Maybe Element
mbDocPr = NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "wp" "inline" Element
element Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "wp" "docPr"
title :: Text
title = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe Element
mbDocPr Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "" "title")
alt :: Text
alt = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe Element
mbDocPr Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "" "descr")
in (Text
title, Text
alt)
elemToParPart :: NameSpaces -> Element -> D ParPart
elemToParPart :: NameSpaces -> Element -> D ParPart
elemToParPart ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "r" Element
element
, Just drawingElem :: Element
drawingElem <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "drawing" Element
element
, FilePath
pic_ns <- "http://schemas.openxmlformats.org/drawingml/2006/picture"
, Just picElem :: Element
picElem <- QName -> Element -> Maybe Element
findElement (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
QName "pic" (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
pic_ns) (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "pic")) Element
drawingElem
= let (title :: Text
title, alt :: Text
alt) = NameSpaces -> Element -> (Text, Text)
getTitleAndAlt NameSpaces
ns Element
drawingElem
a_ns :: FilePath
a_ns = "http://schemas.openxmlformats.org/drawingml/2006/main"
drawing :: Maybe Text
drawing = QName -> Element -> Maybe Element
findElement (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
QName "blip" (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
a_ns) (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "a")) Element
picElem
Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "r" "embed"
in
case Maybe Text
drawing of
Just s :: Text
s -> Text -> D (FilePath, ByteString)
expandDrawingId Text
s D (FilePath, ByteString)
-> ((FilePath, ByteString) -> D ParPart) -> D ParPart
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\(fp :: FilePath
fp, bs :: ByteString
bs) -> ParPart -> D ParPart
forall (m :: * -> *) a. Monad m => a -> m a
return (ParPart -> D ParPart) -> ParPart -> D ParPart
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> Text -> ByteString -> Extent -> ParPart
Drawing FilePath
fp Text
title Text
alt ByteString
bs (Extent -> ParPart) -> Extent -> ParPart
forall a b. (a -> b) -> a -> b
$ Element -> Extent
elemToExtent Element
drawingElem)
Nothing -> DocxError -> D ParPart
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem
elemToParPart ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "r" Element
element
, Just _ <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "pict" Element
element =
let drawing :: Maybe Text
drawing = QName -> Element -> Maybe Element
findElement (NameSpaces -> FilePath -> FilePath -> QName
elemName NameSpaces
ns "v" "imagedata") Element
element
Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "r" "id"
in
case Maybe Text
drawing of
Just s :: Text
s -> Text -> D (FilePath, ByteString)
expandDrawingId Text
s D (FilePath, ByteString)
-> ((FilePath, ByteString) -> D ParPart) -> D ParPart
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\(fp :: FilePath
fp, bs :: ByteString
bs) -> ParPart -> D ParPart
forall (m :: * -> *) a. Monad m => a -> m a
return (ParPart -> D ParPart) -> ParPart -> D ParPart
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> Text -> ByteString -> Extent -> ParPart
Drawing FilePath
fp "" "" ByteString
bs Extent
forall a. Maybe a
Nothing)
Nothing -> DocxError -> D ParPart
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem
elemToParPart ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "r" Element
element
, Just drawingElem :: Element
drawingElem <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "drawing" Element
element
, FilePath
c_ns <- "http://schemas.openxmlformats.org/drawingml/2006/chart"
, Just _ <- QName -> Element -> Maybe Element
findElement (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
QName "chart" (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
c_ns) (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "c")) Element
drawingElem
= ParPart -> D ParPart
forall (m :: * -> *) a. Monad m => a -> m a
return ParPart
Chart
elemToParPart ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "r" Element
element
, Just fldChar :: Element
fldChar <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "fldChar" Element
element
, Just fldCharType :: FilePath
fldCharType <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe FilePath
findAttrByName NameSpaces
ns "w" "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
FldCharClosed | FilePath
fldCharType FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "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
$ \st :: ReaderState
st -> ReaderState
st {stateFldCharState :: FldCharState
stateFldCharState = FldCharState
FldCharOpen}
ParPart -> D ParPart
forall (m :: * -> *) a. Monad m => a -> m a
return ParPart
NullParPart
FldCharFieldInfo info :: FieldInfo
info | FilePath
fldCharType FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "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
$ \st :: ReaderState
st -> ReaderState
st {stateFldCharState :: FldCharState
stateFldCharState = FieldInfo -> [Run] -> FldCharState
FldCharContent FieldInfo
info []}
ParPart -> D ParPart
forall (m :: * -> *) a. Monad m => a -> m a
return ParPart
NullParPart
FldCharContent info :: FieldInfo
info runs :: [Run]
runs | FilePath
fldCharType FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== "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
$ \st :: ReaderState
st -> ReaderState
st {stateFldCharState :: FldCharState
stateFldCharState = FldCharState
FldCharClosed}
ParPart -> D ParPart
forall (m :: * -> *) a. Monad m => a -> m a
return (ParPart -> D ParPart) -> ParPart -> D ParPart
forall a b. (a -> b) -> a -> b
$ FieldInfo -> [Run] -> ParPart
Field FieldInfo
info ([Run] -> ParPart) -> [Run] -> ParPart
forall a b. (a -> b) -> a -> b
$ [Run] -> [Run]
forall a. [a] -> [a]
reverse [Run]
runs
_ -> DocxError -> D ParPart
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem
elemToParPart ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "r" Element
element
, Just instrText :: Element
instrText <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "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
FldCharOpen -> 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
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Element -> FilePath
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
$ \st :: ReaderState
st -> ReaderState
st{stateFldCharState :: FldCharState
stateFldCharState = FieldInfo -> FldCharState
FldCharFieldInfo FieldInfo
info}
ParPart -> D ParPart
forall (m :: * -> *) a. Monad m => a -> m a
return ParPart
NullParPart
_ -> ParPart -> D ParPart
forall (m :: * -> *) a. Monad m => a -> m a
return ParPart
NullParPart
elemToParPart ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "r" Element
element = do
Run
run <- NameSpaces -> Element -> D Run
elemToRun NameSpaces
ns 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
case FldCharState
fldCharState of
FldCharContent info :: FieldInfo
info runs :: [Run]
runs -> 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
$ \st :: ReaderState
st -> ReaderState
st{stateFldCharState :: FldCharState
stateFldCharState = FieldInfo -> [Run] -> FldCharState
FldCharContent FieldInfo
info (Run
run Run -> [Run] -> [Run]
forall a. a -> [a] -> [a]
: [Run]
runs)}
ParPart -> D ParPart
forall (m :: * -> *) a. Monad m => a -> m a
return ParPart
NullParPart
_ -> ParPart -> D ParPart
forall (m :: * -> *) a. Monad m => a -> m a
return (ParPart -> D ParPart) -> ParPart -> D ParPart
forall a b. (a -> b) -> a -> b
$ Run -> ParPart
PlainRun Run
run
elemToParPart ns :: NameSpaces
ns element :: Element
element
| Just change :: TrackedChange
change <- NameSpaces -> Element -> Maybe TrackedChange
getTrackedChange NameSpaces
ns Element
element = do
[Run]
runs <- (Element -> D Run) -> [Element] -> D [Run]
forall a b. (a -> D b) -> [a] -> D [b]
mapD (NameSpaces -> Element -> D Run
elemToRun NameSpaces
ns) (Element -> [Element]
elChildren Element
element)
ParPart -> D ParPart
forall (m :: * -> *) a. Monad m => a -> m a
return (ParPart -> D ParPart) -> ParPart -> D ParPart
forall a b. (a -> b) -> a -> b
$ TrackedChange -> [Run] -> ParPart
ChangedRuns TrackedChange
change [Run]
runs
elemToParPart ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "bookmarkStart" Element
element
, Just bmId :: Text
bmId <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "id" Element
element
, Just bmName :: Text
bmName <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "name" Element
element =
ParPart -> D ParPart
forall (m :: * -> *) a. Monad m => a -> m a
return (ParPart -> D ParPart) -> ParPart -> D ParPart
forall a b. (a -> b) -> a -> b
$ Text -> Text -> ParPart
BookMark Text
bmId Text
bmName
elemToParPart ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "hyperlink" Element
element
, Just relId :: Text
relId <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "r" "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
[Run]
runs <- (Element -> D Run) -> [Element] -> D [Run]
forall a b. (a -> D b) -> [a] -> D [b]
mapD (NameSpaces -> Element -> D Run
elemToRun 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 target :: Text
target ->
case NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "anchor" Element
element of
Just anchor :: Text
anchor -> ParPart -> D ParPart
forall (m :: * -> *) a. Monad m => a -> m a
return (ParPart -> D ParPart) -> ParPart -> D ParPart
forall a b. (a -> b) -> a -> b
$ Text -> [Run] -> ParPart
ExternalHyperLink (Text
target Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
anchor) [Run]
runs
Nothing -> ParPart -> D ParPart
forall (m :: * -> *) a. Monad m => a -> m a
return (ParPart -> D ParPart) -> ParPart -> D ParPart
forall a b. (a -> b) -> a -> b
$ Text -> [Run] -> ParPart
ExternalHyperLink Text
target [Run]
runs
Nothing -> ParPart -> D ParPart
forall (m :: * -> *) a. Monad m => a -> m a
return (ParPart -> D ParPart) -> ParPart -> D ParPart
forall a b. (a -> b) -> a -> b
$ Text -> [Run] -> ParPart
ExternalHyperLink "" [Run]
runs
elemToParPart ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "hyperlink" Element
element
, Just anchor :: Text
anchor <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "anchor" Element
element = do
[Run]
runs <- (Element -> D Run) -> [Element] -> D [Run]
forall a b. (a -> D b) -> [a] -> D [b]
mapD (NameSpaces -> Element -> D Run
elemToRun NameSpaces
ns) (Element -> [Element]
elChildren Element
element)
ParPart -> D ParPart
forall (m :: * -> *) a. Monad m => a -> m a
return (ParPart -> D ParPart) -> ParPart -> D ParPart
forall a b. (a -> b) -> a -> b
$ Text -> [Run] -> ParPart
InternalHyperLink Text
anchor [Run]
runs
elemToParPart ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "commentRangeStart" Element
element
, Just cmtId :: Text
cmtId <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "id" Element
element = do
(Comments _ commentMap :: 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 cmtElem :: Element
cmtElem -> NameSpaces -> Element -> D ParPart
elemToCommentStart NameSpaces
ns Element
cmtElem
Nothing -> DocxError -> D ParPart
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem
elemToParPart ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "commentRangeEnd" Element
element
, Just cmtId :: Text
cmtId <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "id" Element
element =
ParPart -> D ParPart
forall (m :: * -> *) a. Monad m => a -> m a
return (ParPart -> D ParPart) -> ParPart -> D ParPart
forall a b. (a -> b) -> a -> b
$ Text -> ParPart
CommentEnd Text
cmtId
elemToParPart ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "m" "oMath" Element
element =
([Exp] -> ParPart) -> D [Exp] -> D ParPart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [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
$ FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Element -> FilePath
showElement Element
element)
elemToParPart _ _ = DocxError -> D ParPart
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem
elemToCommentStart :: NameSpaces -> Element -> D ParPart
ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "comment" Element
element
, Just cmtId :: Text
cmtId <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "id" Element
element
, Just cmtAuthor :: Text
cmtAuthor <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "author" Element
element
, Just cmtDate :: Text
cmtDate <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "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 -> D ParPart
forall (m :: * -> *) a. Monad m => a -> m a
return (ParPart -> D ParPart) -> ParPart -> D ParPart
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> [BodyPart] -> ParPart
CommentStart Text
cmtId Text
cmtAuthor Text
cmtDate [BodyPart]
bps
elemToCommentStart _ _ = DocxError -> D ParPart
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem
lookupFootnote :: T.Text -> Notes -> Maybe Element
s :: Text
s (Notes _ fns :: Maybe (Map Text Element)
fns _) = Maybe (Map Text Element)
fns Maybe (Map Text Element)
-> (Map Text Element -> Maybe Element) -> Maybe Element
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 s :: Text
s (Notes _ _ ens :: Maybe (Map Text Element)
ens) = Maybe (Map Text Element)
ens Maybe (Map Text Element)
-> (Map Text Element -> Maybe Element) -> Maybe Element
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 drawingElem :: Element
drawingElem =
case (FilePath -> Maybe Double
forall b. Read b => FilePath -> Maybe b
getDim "cx", FilePath -> Maybe Double
forall b. Read b => FilePath -> Maybe b
getDim "cy") of
(Just w :: Double
w, Just h :: Double
h) -> (Double, Double) -> Extent
forall a. a -> Maybe a
Just (Double
w, Double
h)
_ -> Extent
forall a. Maybe a
Nothing
where
wp_ns :: FilePath
wp_ns = "http://schemas.openxmlformats.org/drawingml/2006/wordprocessingDrawing"
getDim :: FilePath -> Maybe b
getDim at :: FilePath
at = QName -> Element -> Maybe Element
findElement (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
QName "extent" (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
wp_ns) (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "wp")) Element
drawingElem
Maybe Element -> (Element -> Maybe FilePath) -> Maybe FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= QName -> Element -> Maybe FilePath
findAttr (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
QName FilePath
at Maybe FilePath
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing) Maybe FilePath -> (FilePath -> 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 (Text -> Maybe b) -> (FilePath -> Text) -> FilePath -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack
childElemToRun :: NameSpaces -> Element -> D Run
childElemToRun :: NameSpaces -> Element -> D Run
childElemToRun ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "drawing" Element
element
, FilePath
pic_ns <- "http://schemas.openxmlformats.org/drawingml/2006/picture"
, Just picElem :: Element
picElem <- QName -> Element -> Maybe Element
findElement (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
QName "pic" (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
pic_ns) (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "pic")) Element
element
= let (title :: Text
title, alt :: Text
alt) = NameSpaces -> Element -> (Text, Text)
getTitleAndAlt NameSpaces
ns Element
element
a_ns :: FilePath
a_ns = "http://schemas.openxmlformats.org/drawingml/2006/main"
drawing :: Maybe Text
drawing = QName -> Element -> Maybe Element
findElement (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
QName "blip" (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
a_ns) (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "a")) Element
picElem
Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= QName -> Element -> Maybe Text
findAttrText (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
QName "embed" (FilePath -> NameSpaces -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup "r" NameSpaces
ns) (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "r"))
in
case Maybe Text
drawing of
Just s :: Text
s -> Text -> D (FilePath, ByteString)
expandDrawingId Text
s D (FilePath, ByteString)
-> ((FilePath, ByteString) -> D Run) -> D Run
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(\(fp :: FilePath
fp, bs :: ByteString
bs) -> Run -> D Run
forall (m :: * -> *) a. Monad m => a -> m a
return (Run -> D Run) -> Run -> D Run
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> Text -> ByteString -> Extent -> Run
InlineDrawing FilePath
fp Text
title Text
alt ByteString
bs (Extent -> Run) -> Extent -> Run
forall a b. (a -> b) -> a -> b
$ Element -> Extent
elemToExtent Element
element)
Nothing -> DocxError -> D Run
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem
childElemToRun ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "drawing" Element
element
, FilePath
c_ns <- "http://schemas.openxmlformats.org/drawingml/2006/chart"
, Just _ <- QName -> Element -> Maybe Element
findElement (FilePath -> Maybe FilePath -> Maybe FilePath -> QName
QName "chart" (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
c_ns) (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just "c")) Element
element
= Run -> D Run
forall (m :: * -> *) a. Monad m => a -> m a
return Run
InlineChart
childElemToRun ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "footnoteReference" Element
element
, Just fnId :: Text
fnId <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "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 e :: Element
e -> do [BodyPart]
bps <- (ReaderEnv -> ReaderEnv)
-> ExceptT
DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart]
-> ExceptT
DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\r :: 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 (m :: * -> *) a. Monad m => a -> m a
return (Run -> D Run) -> Run -> D Run
forall a b. (a -> b) -> a -> b
$ [BodyPart] -> Run
Footnote [BodyPart]
bps
Nothing -> Run -> D Run
forall (m :: * -> *) a. Monad m => a -> m a
return (Run -> D Run) -> Run -> D Run
forall a b. (a -> b) -> a -> b
$ [BodyPart] -> Run
Footnote []
childElemToRun ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "endnoteReference" Element
element
, Just enId :: Text
enId <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "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 e :: Element
e -> do [BodyPart]
bps <- (ReaderEnv -> ReaderEnv)
-> ExceptT
DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart]
-> ExceptT
DocxError (ReaderT ReaderEnv (State ReaderState)) [BodyPart]
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\r :: 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 (m :: * -> *) a. Monad m => a -> m a
return (Run -> D Run) -> Run -> D Run
forall a b. (a -> b) -> a -> b
$ [BodyPart] -> Run
Endnote [BodyPart]
bps
Nothing -> Run -> D Run
forall (m :: * -> *) a. Monad m => a -> m a
return (Run -> D Run) -> Run -> D Run
forall a b. (a -> b) -> a -> b
$ [BodyPart] -> Run
Endnote []
childElemToRun _ _ = DocxError -> D Run
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem
elemToRun :: NameSpaces -> Element -> D Run
elemToRun :: NameSpaces -> Element -> D Run
elemToRun ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "r" Element
element
, Just altCont :: Element
altCont <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "mc" "AlternateContent" Element
element =
do let choices :: [Element]
choices = NameSpaces -> FilePath -> FilePath -> Element -> [Element]
findChildrenByName NameSpaces
ns "mc" "Choice" Element
altCont
choiceChildren :: [Element]
choiceChildren = ([Element] -> Element) -> [[Element]] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map [Element] -> Element
forall a. [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 (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] -> D [Run]
forall a b. (a -> D b) -> [a] -> D [b]
mapD (NameSpaces -> Element -> D Run
childElemToRun NameSpaces
ns) [Element]
choiceChildren
case [Run]
outputs of
r :: Run
r : _ -> Run -> D Run
forall (m :: * -> *) a. Monad m => a -> m a
return Run
r
[] -> DocxError -> D Run
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem
elemToRun ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "r" Element
element
, Just drawingElem :: Element
drawingElem <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "drawing" Element
element =
NameSpaces -> Element -> D Run
childElemToRun NameSpaces
ns Element
drawingElem
elemToRun ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "r" Element
element
, Just ref :: Element
ref <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "footnoteReference" Element
element =
NameSpaces -> Element -> D Run
childElemToRun NameSpaces
ns Element
ref
elemToRun ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "r" Element
element
, Just ref :: Element
ref <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "endnoteReference" Element
element =
NameSpaces -> Element -> D Run
childElemToRun NameSpaces
ns Element
ref
elemToRun ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "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 (m :: * -> *) a. Monad m => a -> m a
return (Run -> D Run) -> Run -> D Run
forall a b. (a -> b) -> a -> b
$ RunStyle -> [RunElem] -> Run
Run RunStyle
runStyle [RunElem]
runElems
elemToRun _ _ = DocxError -> D Run
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem
getParentStyleValue :: (ParStyle -> Maybe a) -> ParStyle -> Maybe a
getParentStyleValue :: (ParStyle -> Maybe a) -> ParStyle -> Maybe a
getParentStyleValue field :: ParStyle -> Maybe a
field style :: ParStyle
style
| Just value :: a
value <- ParStyle -> Maybe a
field ParStyle
style = a -> Maybe a
forall a. a -> Maybe a
Just a
value
| Just parentStyle :: 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 _ _ = Maybe a
forall a. Maybe a
Nothing
getParStyleField :: (ParStyle -> Maybe a) -> [ParStyle] -> Maybe a
getParStyleField :: (ParStyle -> Maybe a) -> [ParStyle] -> Maybe a
getParStyleField field :: ParStyle -> Maybe a
field styles :: [ParStyle]
styles
| (y :: a
y:_) <- (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 _ _ = Maybe a
forall a. Maybe a
Nothing
getTrackedChange :: NameSpaces -> Element -> Maybe TrackedChange
getTrackedChange :: NameSpaces -> Element -> Maybe TrackedChange
getTrackedChange ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "ins" Element
element Bool -> Bool -> Bool
|| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "moveTo" Element
element
, Just cId :: Text
cId <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "id" Element
element
, Just cAuthor :: Text
cAuthor <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "author" Element
element
, Just cDate :: Text
cDate <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "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 -> Text -> ChangeInfo
ChangeInfo Text
cId Text
cAuthor Text
cDate)
getTrackedChange ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "del" Element
element Bool -> Bool -> Bool
|| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "moveFrom" Element
element
, Just cId :: Text
cId <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "id" Element
element
, Just cAuthor :: Text
cAuthor <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "author" Element
element
, Just cDate :: Text
cDate <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "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 -> Text -> ChangeInfo
ChangeInfo Text
cId Text
cAuthor Text
cDate)
getTrackedChange _ _ = Maybe TrackedChange
forall a. Maybe a
Nothing
elemToParagraphStyle :: NameSpaces -> Element -> ParStyleMap -> ParagraphStyle
elemToParagraphStyle :: NameSpaces -> Element -> ParStyleMap -> ParagraphStyle
elemToParagraphStyle ns :: NameSpaces
ns element :: Element
element sty :: ParStyleMap
sty
| Just pPr :: Element
pPr <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "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 (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 -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "val")
(NameSpaces -> FilePath -> FilePath -> Element -> [Element]
findChildrenByName NameSpaces
ns "w" "pStyle" Element
pPr)
in ParagraphStyle :: [ParStyle]
-> Maybe ParIndentation
-> Bool
-> Maybe TrackedChange
-> Maybe Bool
-> ParagraphStyle
ParagraphStyle
{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
, indentation :: Maybe ParIndentation
indentation =
NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "ind" Element
pPr Maybe Element
-> (Element -> Maybe ParIndentation) -> Maybe ParIndentation
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
NameSpaces -> Element -> Maybe ParIndentation
elemToParIndentation NameSpaces
ns
, dropCap :: Bool
dropCap =
case
NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "framePr" Element
pPr Maybe Element -> (Element -> Maybe FilePath) -> Maybe FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
NameSpaces -> FilePath -> FilePath -> Element -> Maybe FilePath
findAttrByName NameSpaces
ns "w" "dropCap"
of
Just "none" -> Bool
False
Just _ -> Bool
True
Nothing -> Bool
False
, pChange :: Maybe TrackedChange
pChange = NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "rPr" Element
pPr Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(Element -> Bool) -> Element -> Maybe Element
filterChild (\e :: Element
e -> NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "ins" Element
e Bool -> Bool -> Bool
||
NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "moveTo" Element
e Bool -> Bool -> Bool
||
NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "del" Element
e Bool -> Bool -> Bool
||
NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "moveFrom" Element
e
) Maybe Element
-> (Element -> Maybe TrackedChange) -> Maybe TrackedChange
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 -> FilePath -> FilePath -> QName
elemName NameSpaces
ns "w" "bidi")
}
elemToParagraphStyle _ _ _ = ParagraphStyle
defaultParagraphStyle
elemToRunStyleD :: NameSpaces -> Element -> D RunStyle
elemToRunStyleD :: NameSpaces -> Element -> D RunStyle
elemToRunStyleD ns :: NameSpaces
ns element :: Element
element
| Just rPr :: Element
rPr <- NameSpaces -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "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 -> FilePath -> FilePath -> Element -> Maybe Element
findChildByName NameSpaces
ns "w" "rStyle" Element
rPr Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
NameSpaces -> FilePath -> FilePath -> Element -> Maybe Text
findAttrTextByName NameSpaces
ns "w" "val" Maybe Text -> (Text -> Maybe CharStyle) -> Maybe CharStyle
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 (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 _ _ = RunStyle -> D RunStyle
forall (m :: * -> *) a. Monad m => a -> m a
return RunStyle
defaultRunStyle
elemToRunElem :: NameSpaces -> Element -> D RunElem
elemToRunElem :: NameSpaces -> Element -> D RunElem
elemToRunElem ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "t" Element
element
Bool -> Bool -> Bool
|| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "delText" Element
element
Bool -> Bool -> Bool
|| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "m" "t" Element
element = do
let str :: Text
str = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Element -> FilePath
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
Nothing -> RunElem -> D RunElem
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 f :: Font
f -> RunElem -> D RunElem
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 (\x :: 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 -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "br" Element
element = RunElem -> D RunElem
forall (m :: * -> *) a. Monad m => a -> m a
return RunElem
LnBrk
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "tab" Element
element = RunElem -> D RunElem
forall (m :: * -> *) a. Monad m => a -> m a
return RunElem
Tab
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "softHyphen" Element
element = RunElem -> D RunElem
forall (m :: * -> *) a. Monad m => a -> m a
return RunElem
SoftHyphen
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "noBreakHyphen" Element
element = RunElem -> D RunElem
forall (m :: * -> *) a. Monad m => a -> m a
return RunElem
NoBreakHyphen
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "sym" Element
element = RunElem -> D RunElem
forall (m :: * -> *) a. Monad m => a -> m a
return (NameSpaces -> Element -> RunElem
getSymChar NameSpaces
ns Element
element)
| Bool
otherwise = DocxError -> D RunElem
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 '\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 '\xF000'
| Bool
otherwise = Int -> Char
chr Int
c
getSymChar :: NameSpaces -> Element -> RunElem
getSymChar :: NameSpaces -> Element -> RunElem
getSymChar ns :: NameSpaces
ns element :: Element
element
| Just s :: FilePath
s <- ShowS
lowerFromPrivate ShowS -> Maybe FilePath -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
getCodepoint
, Just font :: Font
font <- Maybe Font
getFont =
case ReadS Char
readLitChar ("\\x" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
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 "" 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
_ -> Text -> RunElem
TextRun ""
where
getCodepoint :: Maybe FilePath
getCodepoint = NameSpaces -> FilePath -> FilePath -> Element -> Maybe FilePath
findAttrByName NameSpaces
ns "w" "char" Element
element
getFont :: Maybe Font
getFont = Text -> Maybe Font
textToFont (Text -> Maybe Font)
-> (FilePath -> Text) -> FilePath -> Maybe Font
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Maybe Font) -> Maybe FilePath -> Maybe Font
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NameSpaces -> FilePath -> FilePath -> Element -> Maybe FilePath
findAttrByName NameSpaces
ns "w" "font" Element
element
lowerFromPrivate :: ShowS
lowerFromPrivate ('F':xs :: FilePath
xs) = '0'Char -> ShowS
forall a. a -> [a] -> [a]
:FilePath
xs
lowerFromPrivate xs :: FilePath
xs = FilePath
xs
getSymChar _ _ = Text -> RunElem
TextRun ""
elemToRunElems :: NameSpaces -> Element -> D [RunElem]
elemToRunElems :: NameSpaces -> Element -> D [RunElem]
elemToRunElems ns :: NameSpaces
ns element :: Element
element
| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "w" "r" Element
element
Bool -> Bool -> Bool
|| NameSpaces -> FilePath -> FilePath -> Element -> Bool
isElem NameSpaces
ns "m" "r" Element
element = do
let qualName :: FilePath -> QName
qualName = NameSpaces -> FilePath -> FilePath -> QName
elemName NameSpaces
ns "w"
let font :: Maybe Font
font = do
Element
fontElem <- QName -> Element -> Maybe Element
findElement (FilePath -> QName
qualName "rFonts") Element
element
Text -> Maybe Font
textToFont (Text -> Maybe Font)
-> (FilePath -> Text) -> FilePath -> Maybe Font
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Maybe Font) -> Maybe FilePath -> Maybe Font
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
(FilePath -> Maybe FilePath -> Maybe FilePath)
-> Maybe FilePath -> [FilePath] -> Maybe FilePath
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Maybe FilePath -> Maybe FilePath -> Maybe FilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) (Maybe FilePath -> Maybe FilePath -> Maybe FilePath)
-> (FilePath -> Maybe FilePath)
-> FilePath
-> Maybe FilePath
-> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((QName -> Element -> Maybe FilePath)
-> Element -> QName -> Maybe FilePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip QName -> Element -> Maybe FilePath
findAttr Element
fontElem (QName -> Maybe FilePath)
-> (FilePath -> QName) -> FilePath -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> QName
qualName)) Maybe FilePath
forall a. Maybe a
Nothing ["ascii", "hAnsi"]
(ReaderEnv -> ReaderEnv) -> D [RunElem] -> D [RunElem]
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 _ _ = DocxError -> D [RunElem]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError DocxError
WrongElem
setFont :: Maybe Font -> ReaderEnv -> ReaderEnv
setFont :: Maybe Font -> ReaderEnv -> ReaderEnv
setFont f :: Maybe Font
f s :: ReaderEnv
s = ReaderEnv
s{envFont :: Maybe Font
envFont = Maybe Font
f}