1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
|
{-# LANGUAGE FlexibleContexts #-}
{- |
Module : Text.Pandoc.Writers.Docx.StyleMap
Copyright : © 2014-2020 Jesse Rosenthal <jrosenthal@jhu.edu>,
2014-2021 John MacFarlane <jgm@berkeley.edu>,
2015-2019 Nikolay Yakimov <root@livid.pp.ru>
License : GNU GPL, version 2 or above
Maintainer : Jesse Rosenthal <jrosenthal@jhu.edu>
Stability : alpha
Portability : portable
Mappings of element styles (word to pandoc-internal).
-}
module Text.Pandoc.Writers.Docx.StyleMap ( StyleMaps(..)
, ParaStyleName
, CharStyleName
, getStyleMaps
, getStyleIdFromName
, hasStyleName
, fromStyleId
, fromStyleName
) where
import Text.Pandoc.Readers.Docx.Parse.Styles
import Codec.Archive.Zip
import qualified Data.Map as M
import qualified Data.Text as T
import Data.String
import Data.Char (isSpace)
data StyleMaps = StyleMaps { smCharStyle :: CharStyleNameMap, smParaStyle :: ParaStyleNameMap }
type ParaStyleNameMap = M.Map ParaStyleName ParStyle
type CharStyleNameMap = M.Map CharStyleName CharStyle
getStyleIdFromName :: (Ord sn, FromStyleName sn, IsString (StyleId sty), HasStyleId sty)
=> sn -> M.Map sn sty -> StyleId sty
getStyleIdFromName s = maybe (fallback s) getStyleId . M.lookup s
where fallback = fromString . T.unpack . T.filter (not . isSpace) . fromStyleName
hasStyleName :: (Ord sn, HasStyleId sty)
=> sn -> M.Map sn sty -> Bool
hasStyleName styleName = M.member styleName
getStyleMaps :: Archive -> StyleMaps
getStyleMaps = uncurry StyleMaps . archiveToStyles' getStyleName getStyleName
|
