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