d2643c2 · typeable/pandoc

1{-# OPTIONS_GHC -Wall #-}

2{-# LANGUAGE PatternGuards #-}

3{-

5

6This program is free software; you can redistribute it and/or modify

7it under the terms of the GNU General Public License as published by

24 License : GNU GPL, version 2 or above

25

26− Maintainer : Andrea Rossato <andrea.rossato@unibz.it>

26+ Maintainer : Andrea Rossato <andrea.rossato@ing.unitn.it>

27 Stability : alpha

28 Portability : portable

29

50--

51

52data WriterState =

53− WriterState { stNotes :: [Doc]

53+ WriterState { stNotes :: [Doc]

54− , stTableStyles :: [Doc]

54+ , stTableStyles :: [Doc]

55− , stParaStyles :: [Doc]

55+ , stParaStyles :: [Doc]

56 , stListStyles :: [(Int, [Doc])]

57 , indentPara :: Int

58− } deriving Show

58+ }

59

60defaultWriterState :: WriterState

61defaultWriterState =

222 | Plain b <- bs = wrap o b

223 | Para b <- bs = inParagraphTags <$> wrap o b

224 | Header i b <- bs = inHeaderTags i <$> wrap o b

225− | BlockQuote b <- bs = doBlockQuote b

225+ | BlockQuote b <- bs = mkBlockQuote b

226 | CodeBlock _ s <- bs = preformatted s

227 | RawHtml _ <- bs = return empty

228 | DefinitionList b <- bs = defList b

235 where

236 defList b = vcat <$> mapM (deflistItemToOpenDocument o) b

237 preformatted s = vcat <$> mapM (inPreformattedTags . escapeStringForXML) (lines s)

238− doBlockQuote b = do increaseIndent

238+ mkBlockQuote b = do increaseIndent

239 i <- paraStyle "Quotations" []

240 inBlockQuote o i (map plainToPara b)

241 orderedList a b = do (ln,pn) <- newOrderedListStyle a

275

276tableItemToOpenDocument :: WriterOptions -> String -> (String,[Block])-> State WriterState Doc

277tableItemToOpenDocument o tn (n,i) =

278− let a = [ ("table:style-name" , tn ++ ".A1" )

278+ let a = [ ("table:style-name" , tn ++ ".A1" )

279 , ("office:value-type", "string" )

280 ]

281 in inTags True "table:table-cell" a <$>

310 | Code s <- ils = preformatted s

311 | Math s <- ils = inlinesToOpenDocument o (readTeXMath s)

312 | TeX s <- ils = preformatted s

313− | HtmlInline _ <- ils = return empty

313+ | HtmlInline s <- ils = preformatted s

314 | Link l (s,t) <- ils = mkLink s t <$> inlinesToOpenDocument o l

315 | Image l (s,t) <- ils = mkLink s t <$> inlinesToOpenDocument o l

316 | Note l <- ils = mkNote l

317 | otherwise = return empty

318 where

319− preformatted = return . inSpanTags "Teletype" . text . escapeStringForXML

319+ preformatted = return . inSpanTags "Teletype" . text . escapeStringForXML

320 mkLink s t = inTags False "text:a" [ ("xlink:type" , "simple")

321 , ("xlink:href" , s )

322 , ("office:name", t )

368 LowerRoman -> "i"

369 _ -> "1"

370 listStyle = inTags True "text:list-level-style-number"

371− ([ ("text:level" , show $ 1 + length ls )

371+ ([ ("text:level" , show $ 1 + length ls )

372 , ("text:style-name" , "Numbering_20_Symbols")

373 , ("style:num-format", format )

374− , ("text:start-value", show s )

374+ , ("text:start-value", show s )

375 ] ++ suffix) (listLevelStyle (1 + length ls))

376 in (l, ls ++ [listStyle])

377

378listLevelStyle :: Int -> Doc

379listLevelStyle i =

380+ let indent = show (0.25 * fromIntegral i :: Double) in

380 selfClosingTag "style:list-level-properties"

381 selfClosingTag "style:list-level-properties"

381− [ ("text:space-before" , show (0.25 * fromIntegral i :: Double) ++ "in")

382+ [ ("text:space-before" , indent ++ "in")

382− , ("text:min-label-width","0.25in")]

383+ , ("text:min-label-width", "0.25in")]

383

384

384tableStyle :: Int -> [(Char,Float)] -> Doc

385tableStyle :: Int -> [(Char,Float)] -> Doc

385tableStyle num wcs =

386tableStyle num wcs =

386 let tableId = "Table" ++ show (num + 1)

387 let tableId = "Table" ++ show (num + 1)

387− table = inTags True "style:style" [("style:name", tableId)] $

388+ table = inTags True "style:style"

389+ [("style:name", tableId)] $

388− selfClosingTag "style:table-properties" [ ("style:rel-width", "100%" )

390+ selfClosingTag "style:table-properties"

391+ [ ("style:rel-width", "100%" )

389− , ("table:align" , "center")]

392+ , ("table:align" , "center")]

390− colStyle (c,w) = inTags True "style:style" [ ("style:name" , tableId ++ "." ++ [c])

393+ colStyle (c,w) = inTags True "style:style"

394+ [ ("style:name" , tableId ++ "." ++ [c])

391− , ("style:family", "table-column" )] $

395+ , ("style:family", "table-column" )] $

392− selfClosingTag "style:table-column-properties" [("style:column-width", show (7 * w) ++ "in")]

396+ selfClosingTag "style:table-column-properties"

397+ [("style:column-width", show (7 * w) ++ "in")]

393− cellStyle = inTags True "style:style" [ ("style:name" , tableId ++ ".A1")

398+ cellStyle = inTags True "style:style"

399+ [ ("style:name" , tableId ++ ".A1")

394− , ("style:family", "table-cell" )] $

400+ , ("style:family", "table-cell" )] $

395− selfClosingTag "style:table-cell-properties" [ ("fo:border", "none")]

401+ selfClosingTag "style:table-cell-properties"

402+ [ ("fo:border", "none")]

396 columnStyles = map colStyle wcs

403 columnStyles = map colStyle wcs

397−

398 in table $$ vcat columnStyles $$ cellStyle

404 in table $$ vcat columnStyles $$ cellStyle

399

405

400paraStyle :: String -> [(String,String)] -> State WriterState Int

406paraStyle :: String -> [(String,String)] -> State WriterState Int

401paraStyle parent attrs = do

407paraStyle parent attrs = do

402 pn <- (+) 1 . length <$> gets stParaStyles

408 pn <- (+) 1 . length <$> gets stParaStyles

403− i <- (*) 0.5 . fromIntegral <$> gets indentPara :: State WriterState Double

409+ i <- (*) 0.5 . fromIntegral <$> gets indentPara :: State WriterState Double

404 let styleAttr = [ ("style:name" , "P" ++ show pn)

410 let styleAttr = [ ("style:name" , "P" ++ show pn)

405 , ("style:family" , "paragraph" )

411 , ("style:family" , "paragraph" )

406 , ("style:parent-style-name", parent )]

412 , ("style:parent-style-name", parent )]

415 return pn

421 return pn

416

422

417paraListStyle :: Int -> State WriterState Int

423paraListStyle :: Int -> State WriterState Int

418−paraListStyle l =

419− paraStyle "Text_20_body" [("style:list-style-name", "L" ++ show l )]

424+paraListStyle l = paraStyle "Text_20_body" [("style:list-style-name", "L" ++ show l )]

420

425

421paraTableStyles :: String -> Int -> [Alignment] -> [(String, Doc)]

426paraTableStyles :: String -> Int -> [Alignment] -> [(String, Doc)]

422paraTableStyles _ _ [] = []

427paraTableStyles _ _ [] = []

428 res sn x = inTags True "style:style"

433 res sn x = inTags True "style:style"

429 [ ("style:name" , pName sn )

434 [ ("style:name" , pName sn )

430 , ("style:family" , "paragraph" )

435 , ("style:family" , "paragraph" )

431− , ("style:parent-style-name", "Table_20_" ++ t)

436+ , ("style:parent-style-name", "Table_20_" ++ t)] $

432− ] $

433 selfClosingTag "style:paragraph-properties"

437 selfClosingTag "style:paragraph-properties"

434 [ ("fo:text-align", x)

438 [ ("fo:text-align", x)

435− , ("style:justify-single-word", "false")

439+ , ("style:justify-single-word", "false")]

436− ]

437

440

438openDocumentNameSpaces :: [(String, String)]

441openDocumentNameSpaces :: [(String, String)]

439openDocumentNameSpaces =

442openDocumentNameSpaces =