2bc0c77 · typeable/pandoc

1+{-# LANGUAGE PatternGuards #-}

2+

1{-

3{-

3

5

35 , BodyPart(..)

37 , BodyPart(..)

36 , TblLook(..)

38 , TblLook(..)

37 , ParPart(..)

39 , ParPart(..)

40+ , OMath(..)

41+ , OMathElem(..)

42+ , Base(..)

43+ , TopBottom(..)

44+ , AccentStyle(..)

45+ , BarStyle(..)

46+ , NAryStyle(..)

47+ , DelimStyle(..)

48+ , GroupStyle(..)

38 , Run(..)

49 , Run(..)

39 , RunElem(..)

50 , RunElem(..)

40 , Notes

51 , Notes

288

299

289elemToBodyPart :: NameSpaces -> Element -> Maybe BodyPart

300elemToBodyPart :: NameSpaces -> Element -> Maybe BodyPart

290elemToBodyPart ns element

301elemToBodyPart ns element

302+ | qName (elName element) == "p" &&

303+ qURI (elName element) == (lookup "w" ns)

304+ , (c:_) <- findChildren (QName "oMathPara" (lookup "m" ns) (Just "m")) element =

305+ let style = [] -- placeholder

306+ maths = mapMaybe (elemToMath ns)

307+ $ findChildren

308+ (QName "oMath" (lookup "m" ns) (Just "m")) c

309+ in

310+ Just $ OMathPara style maths

311+ | qName (elName element) == "p" &&

312+ qURI (elName element) == (lookup "w" ns)

313+ , Just (numId, lvl) <- elemToNumInfo ns element =

314+ let parstyle = elemToParagraphStyle ns element

315+ parparts = mapMaybe (elemToParPart ns)

316+ $ elChildren element

317+ in

318+ Just $ ListItem parstyle numId lvl parparts

291 | qName (elName element) == "p" &&

319 | qName (elName element) == "p" &&

292 qURI (elName element) == (lookup "w" ns) =

320 qURI (elName element) == (lookup "w" ns) =

293 let parstyle = elemToParagraphStyle ns element

321 let parstyle = elemToParagraphStyle ns element

294 parparts = mapMaybe (elemToParPart ns)

322 parparts = mapMaybe (elemToParPart ns)

295 $ elChildren element

323 $ elChildren element

296 in

324 in

297− case elemToNumInfo ns element of

298− Just (numId, lvl) -> Just $ ListItem parstyle numId lvl parparts

299− Nothing -> Just $ Paragraph parstyle parparts

325+ Just $ Paragraph parstyle parparts

300 | qName (elName element) == "tbl" &&

326 | qName (elName element) == "tbl" &&

301 qURI (elName element) == (lookup "w" ns) =

327 qURI (elName element) == (lookup "w" ns) =

302 let

328 let

392data BodyPart = Paragraph ParagraphStyle [ParPart]

418data BodyPart = Paragraph ParagraphStyle [ParPart]

393 | ListItem ParagraphStyle String String [ParPart]

419 | ListItem ParagraphStyle String String [ParPart]

394 | Tbl String TblGrid TblLook [Row]

420 | Tbl String TblGrid TblLook [Row]

395−

421+ | OMathPara OMathParaStyle [OMath]

396 deriving Show

422 deriving Show

397

423

398type TblGrid = [Integer]

424type TblGrid = [Integer]

451 | InternalHyperLink Anchor [Run]

477 | InternalHyperLink Anchor [Run]

452 | ExternalHyperLink RelId [Run]

478 | ExternalHyperLink RelId [Run]

453 | Drawing String

479 | Drawing String

480+ | PlainOMath OMath

454 deriving Show

481 deriving Show

455

482

456data Run = Run RunStyle [RunElem]

483data Run = Run RunStyle [RunElem]

458 | Endnote String

485 | Endnote String

459 deriving Show

486 deriving Show

460

487

488+data OMath = OMath [OMathElem]

489+ deriving Show

490+

491+data OMathElem = Accent AccentStyle Base

492+ | Bar BarStyle Base

493+ | Box Base

494+ | BorderBox Base

495+ | Delimiter DelimStyle [Base]

496+ | EquationArray [Base]

497+ | Fraction [OMathElem] [OMathElem]

498+ | Function [OMathElem] Base

499+ | Group GroupStyle Base

500+ | LowerLimit Base [OMathElem]

501+ | UpperLimit Base [OMathElem]

502+ | Matrix [[Base]]

503+ | NAry NAryStyle [OMathElem] [OMathElem] Base

504+ | Phantom Base

505+ | Radical [OMathElem] Base

506+ | PreSubSuper [OMathElem] [OMathElem] Base

507+ | Sub Base [OMathElem]

508+ | SubSuper Base [OMathElem] [OMathElem]

509+ | Super Base [OMathElem]

510+ | OMathRun OMathRunStyle Run

511+ deriving Show

512+

513+data Base = Base [OMathElem]

514+ deriving Show

515+

516+-- placeholders

517+type OMathParaStyle = [String]

518+

519+data TopBottom = Top | Bottom

520+ deriving Show

521+

522+data AccentStyle = AccentStyle { accentChar :: Maybe Char }

523+ deriving Show

524+

525+data BarStyle = BarStyle { barPos :: TopBottom}

526+ deriving Show

527+

528+data NAryStyle = NAryStyle { nAryChar :: Maybe Char

529+ , nAryLimLoc :: LimLoc}

530+ deriving Show

531+

532+defaultNAryStyle :: NAryStyle

533+defaultNAryStyle = NAryStyle { nAryChar = Nothing -- integral, in practice

534+ , nAryLimLoc = SubSup }

535+

536+data LimLoc = SubSup | UnderOver deriving Show

537+

538+data DelimStyle = DelimStyle { delimBegChar :: Maybe Char

539+ , delimSepChar :: Maybe Char

540+ , delimEndChar :: Maybe Char}

541+ deriving Show

542+

543+defaultDelimStyle :: DelimStyle

544+defaultDelimStyle = DelimStyle { delimBegChar = Nothing

545+ , delimSepChar = Nothing

546+ , delimEndChar = Nothing }

547+

548+data GroupStyle = GroupStyle { groupChr :: Maybe Char

549+ , groupPos :: Maybe TopBottom }

550+ deriving Show

551+

552+defaultGroupStyle :: GroupStyle

553+defaultGroupStyle = GroupStyle {groupChr = Nothing, groupPos = Nothing}

554+

555+type OMathRunStyle = [String]

556+

461data RunElem = TextRun String | LnBrk | Tab

557data RunElem = TextRun String | LnBrk | Tab

462 deriving Show

558 deriving Show

463

559

532elemToRunElem :: NameSpaces -> Element -> Maybe RunElem

628elemToRunElem :: NameSpaces -> Element -> Maybe RunElem

533elemToRunElem ns element

629elemToRunElem ns element

534 | (qName (elName element) == "t" || qName (elName element) == "delText") &&

630 | (qName (elName element) == "t" || qName (elName element) == "delText") &&

535− qURI (elName element) == (lookup "w" ns) =

631+ qURI (elName element) `elem` [(lookup "w" ns), (lookup "m" ns)] =

536 Just $ TextRun (strContent element)

632 Just $ TextRun (strContent element)

537 | qName (elName element) == "br" &&

633 | qName (elName element) == "br" &&

538− qURI (elName element) == (lookup "w" ns) =

634+ qURI (elName element) `elem` [(lookup "w" ns), (lookup "m" ns)] =

539 Just $ LnBrk

635 Just $ LnBrk

540 | qName (elName element) == "tab" &&

636 | qName (elName element) == "tab" &&

541− qURI (elName element) == (lookup "w" ns) =

637+ qURI (elName element) `elem` [(lookup "w" ns), (lookup "m" ns)] =

542 Just $ Tab

638 Just $ Tab

543 | otherwise = Nothing

639 | otherwise = Nothing

544

640

546elemToRunElems :: NameSpaces -> Element -> [RunElem]

642elemToRunElems :: NameSpaces -> Element -> [RunElem]

547elemToRunElems ns element

643elemToRunElems ns element

548 | qName (elName element) == "r" &&

644 | qName (elName element) == "r" &&

549− qURI (elName element) == (lookup "w" ns) =

645+ qURI (elName element) `elem` [(lookup "w" ns), (lookup "m" ns)] =

550 mapMaybe (elemToRunElem ns) (elChildren element)

646 mapMaybe (elemToRunElem ns) (elChildren element)

551 | otherwise = []

647 | otherwise = []

552

648

561 >>= (\s -> Just $ Drawing s)

657 >>= (\s -> Just $ Drawing s)

562elemToDrawing _ _ = Nothing

658elemToDrawing _ _ = Nothing

563

659

660+elemToMath :: NameSpaces -> Element -> Maybe OMath

661+elemToMath ns element

662+ | qName (elName element) == "oMath" &&

663+ qURI (elName element) == (lookup "m" ns) =

664+ Just $ OMath $ mapMaybe (elemToMathElem ns) (elChildren element)

665+elemToMath _ _ = Nothing

666+

667+

668+

669+elemToBase :: NameSpaces -> Element -> Maybe Base

670+elemToBase ns element

671+ | qName (elName element) == "e" &&

672+ qURI (elName element) == (lookup "m" ns) =

673+ Just $ Base $ mapMaybe (elemToMathElem ns) (elChildren element)

674+elemToBase _ _ = Nothing

675+

676+elemToNAryStyle :: NameSpaces -> Element -> NAryStyle

677+elemToNAryStyle ns element

678+ | Just narypr <- findChild (QName "naryPr" (lookup "m" ns) (Just "m")) element =

679+ let

680+ chr = findChild (QName "chr" (lookup "m" ns) (Just "m")) narypr >>=

681+ findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=

682+ Just . head

683+ limLoc = findChild (QName "limLoc" (lookup "m" ns) (Just "m")) narypr >>=

684+ findAttr (QName "val" (lookup "m" ns) (Just "m"))

685+ limLoc' = case limLoc of

686+ Just "undOver" -> UnderOver

687+ Just "subSup" -> SubSup

688+ _ -> SubSup

689+ in

690+ NAryStyle { nAryChar = chr, nAryLimLoc = limLoc'}

691+elemToNAryStyle _ _ = defaultNAryStyle

692+

693+elemToDelimStyle :: NameSpaces -> Element -> DelimStyle

694+elemToDelimStyle ns element

695+ | Just dPr <- findChild (QName "dPr" (lookup "m" ns) (Just "m")) element =

696+ let begChr = findChild (QName "begChr" (lookup "m" ns) (Just "m")) dPr >>=

697+ findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=

698+ (\c -> if null c then Nothing else (Just $ head c))

699+ sepChr = findChild (QName "sepChr" (lookup "m" ns) (Just "m")) dPr >>=

700+ findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=

701+ (\c -> if null c then Nothing else (Just $ head c))

702+ endChr = findChild (QName "endChr" (lookup "m" ns) (Just "m")) dPr >>=

703+ findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=

704+ (\c -> if null c then Nothing else (Just $ head c))

705+ in

706+ DelimStyle { delimBegChar = begChr

707+ , delimSepChar = sepChr

708+ , delimEndChar = endChr}

709+elemToDelimStyle _ _ = defaultDelimStyle

710+

711+elemToGroupStyle :: NameSpaces -> Element -> GroupStyle

712+elemToGroupStyle ns element

713+ | Just gPr <- findChild (QName "groupChrPr" (lookup "m" ns) (Just "m")) element =

714+ let chr = findChild (QName "chr" (lookup "m" ns) (Just "m")) gPr >>=

715+ findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=

716+ Just . head

717+ pos = findChild (QName "pos" (lookup "m" ns) (Just "m")) gPr >>=

718+ findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=

719+ (\s -> Just $ if s == "top" then Top else Bottom)

720+ in

721+ GroupStyle { groupChr = chr, groupPos = pos }

722+elemToGroupStyle _ _ = defaultGroupStyle

723+

724+elemToMathElem :: NameSpaces -> Element -> Maybe OMathElem

725+elemToMathElem ns element

726+ | qName (elName element) == "acc" &&

727+ qURI (elName element) == (lookup "m" ns) = do

728+ let accChar =

729+ findChild (QName "accPr" (lookup "m" ns) (Just "m")) element >>=

730+ findChild (QName "chr" (lookup "m" ns) (Just "m")) >>=

731+ findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=

732+ Just . head

733+ accPr = AccentStyle { accentChar = accChar}

734+ base <-findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=

735+ elemToBase ns

736+ return $ Accent accPr base

737+elemToMathElem ns element

738+ | qName (elName element) == "bar" &&

739+ qURI (elName element) == (lookup "m" ns) = do

740+ barPr <- findChild (QName "barPr" (lookup "m" ns) (Just "m")) element >>=

741+ findChild (QName "pos" (lookup "m" ns) (Just "m")) >>=

742+ findAttr (QName "val" (lookup "m" ns) (Just "m")) >>=

743+ (\s ->

744+ Just $ BarStyle {

745+ barPos = (if s == "bot" then Bottom else Top)

746+ })

747+ base <-findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=

748+ elemToBase ns

749+ return $ Bar barPr base

750+elemToMathElem ns element

751+ | qName (elName element) == "box" &&

752+ qURI (elName element) == (lookup "m" ns) =

753+ findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=

754+ elemToBase ns >>=

755+ (\b -> Just $ Box b)

756+elemToMathElem ns element

757+ | qName (elName element) == "borderBox" &&

758+ qURI (elName element) == (lookup "m" ns) =

759+ findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=

760+ elemToBase ns >>=

761+ (\b -> Just $ BorderBox b)

762+elemToMathElem ns element

763+ | qName (elName element) == "d" &&

764+ qURI (elName element) == (lookup "m" ns) =

765+ let style = elemToDelimStyle ns element

766+ in

767+ Just $ Delimiter style $ mapMaybe (elemToBase ns) (elChildren element)

768+elemToMathElem ns element

769+ | qName (elName element) == "eqArr" &&

770+ qURI (elName element) == (lookup "m" ns) =

771+ Just $ EquationArray

772+ $ mapMaybe (elemToBase ns) (elChildren element)

773+elemToMathElem ns element

774+ | qName (elName element) == "f" &&

775+ qURI (elName element) == (lookup "m" ns) = do

776+ num <- findChild (QName "num" (lookup "m" ns) (Just "m")) element

777+ den <- findChild (QName "den" (lookup "m" ns) (Just "m")) element

778+ let numElems = mapMaybe (elemToMathElem ns) (elChildren num)

779+ denElems = mapMaybe (elemToMathElem ns) (elChildren den)

780+ return $ Fraction numElems denElems

781+elemToMathElem ns element

782+ | qName (elName element) == "func" &&

783+ qURI (elName element) == (lookup "m" ns) = do

784+ fName <- findChild (QName "fName" (lookup "m" ns) (Just "m")) element

785+ base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=

786+ elemToBase ns

787+ let fnElems = mapMaybe (elemToMathElem ns) (elChildren fName)

788+ return $ Function fnElems base

789+elemToMathElem ns element

790+ | qName (elName element) == "groupChr" &&

791+ qURI (elName element) == (lookup "m" ns) =

792+ let style = elemToGroupStyle ns element

793+ in

794+ findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=

795+ elemToBase ns >>=

796+ (\b -> Just $ Group style b)

797+elemToMathElem ns element

798+ | qName (elName element) == "limLow" &&

799+ qURI (elName element) == (lookup "m" ns) = do

800+ base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element

801+ >>= elemToBase ns

802+ lim <- findChild (QName "lim" (lookup "m" ns) (Just "m")) element

803+ return $ LowerLimit base (mapMaybe (elemToMathElem ns) (elChildren lim))

804+elemToMathElem ns element

805+ | qName (elName element) == "limUpp" &&

806+ qURI (elName element) == (lookup "m" ns) = do

807+ base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element

808+ >>= elemToBase ns

809+ lim <- findChild (QName "lim" (lookup "m" ns) (Just "m")) element

810+ return $ UpperLimit base (mapMaybe (elemToMathElem ns) (elChildren lim))

811+elemToMathElem ns element

812+ | qName (elName element) == "m" &&

813+ qURI (elName element) == (lookup "m" ns) =

814+ let rows = findChildren (QName "mr" (lookup "m" ns) (Just "m")) element

815+ bases = map (\mr -> mapMaybe (elemToBase ns) (elChildren mr)) rows

816+ in

817+ Just $ Matrix bases

818+elemToMathElem ns element

819+ | qName (elName element) == "nary" &&

820+ qURI (elName element) == (lookup "m" ns) = do

821+ let style = elemToNAryStyle ns element

822+ sub <- findChild (QName "sub" (lookup "m" ns) (Just "m")) element >>=

823+ (\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))

824+ sup <- findChild (QName "sup" (lookup "m" ns) (Just "m")) element >>=

825+ (\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))

826+ base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=

827+ elemToBase ns

828+ return $ NAry style sub sup base

829+elemToMathElem ns element

830+ | qName (elName element) == "rad" &&

831+ qURI (elName element) == (lookup "m" ns) = do

832+ deg <- findChild (QName "deg" (lookup "m" ns) (Just "m")) element >>=

833+ (\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))

834+ base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=

835+ elemToBase ns

836+ return $ Radical deg base

837+-- skipping for now:

838+-- phant

839+elemToMathElem ns element

840+ | qName (elName element) == "sPre" &&

841+ qURI (elName element) == (lookup "m" ns) = do

842+ sub <- findChild (QName "sub" (lookup "m" ns) (Just "m")) element >>=

843+ (\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))

844+ sup <- findChild (QName "sup" (lookup "m" ns) (Just "m")) element >>=

845+ (\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))

846+ base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=

847+ elemToBase ns

848+ return $ PreSubSuper sub sup base

849+elemToMathElem ns element

850+ | qName (elName element) == "sSub" &&

851+ qURI (elName element) == (lookup "m" ns) = do

852+ base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=

853+ elemToBase ns

854+ sub <- findChild (QName "sub" (lookup "m" ns) (Just "m")) element >>=

855+ (\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))

856+ return $ Sub base sub

857+elemToMathElem ns element

858+ | qName (elName element) == "sSubSup" &&

859+ qURI (elName element) == (lookup "m" ns) = do

860+ base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=

861+ elemToBase ns

862+ sub <- findChild (QName "sub" (lookup "m" ns) (Just "m")) element >>=

863+ (\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))

864+ sup <- findChild (QName "sup" (lookup "m" ns) (Just "m")) element >>=

865+ (\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))

866+ return $ SubSuper base sub sup

867+elemToMathElem ns element

868+ | qName (elName element) == "sSup" &&

869+ qURI (elName element) == (lookup "m" ns) = do

870+ base <- findChild (QName "e" (lookup "m" ns) (Just "m")) element >>=

871+ elemToBase ns

872+ sup <- findChild (QName "sup" (lookup "m" ns) (Just "m")) element >>=

873+ (\e -> Just $ mapMaybe (elemToMathElem ns) (elChildren e))

874+ return $ Super base sup

875+elemToMathElem ns element

876+ | qName (elName element) == "r" &&

877+ qURI (elName element) == (lookup "m" ns) =

878+ let style = [] -- placeholder

879+ rstyle = elemToRunStyle ns element

880+ relems = elemToRunElems ns element

881+ in

882+ Just $ OMathRun style $ Run rstyle relems

883+elemToMathElem _ _ = Nothing

884+

564

885

886+

565elemToParPart :: NameSpaces -> Element -> Maybe ParPart

887elemToParPart :: NameSpaces -> Element -> Maybe ParPart

566elemToParPart ns element

888elemToParPart ns element

567 | qName (elName element) == "r" &&

889 | qName (elName element) == "r" &&

606 case findAttr (QName "id" (lookup "r" ns) (Just "r")) element of

928 case findAttr (QName "id" (lookup "r" ns) (Just "r")) element of

607 Just relId -> Just $ ExternalHyperLink relId runs

929 Just relId -> Just $ ExternalHyperLink relId runs

608 Nothing -> Nothing

930 Nothing -> Nothing

931+elemToParPart ns element

932+ | qName (elName element) == "oMath" &&

933+ qURI (elName element) == (lookup "m" ns) =

934+ elemToMath ns element >>=

935+ (\m -> Just $ PlainOMath m)

609elemToParPart _ _ = Nothing

936elemToParPart _ _ = Nothing

610

937

938+

611type Target = String

939type Target = String

612type Anchor = String

940type Anchor = String

613type BookMarkId = String

941type BookMarkId = String