{-# LANGUAGE FlexibleContexts  #-}
{- |
   Module : Text.Pandoc.Writers.Docx.StyleMap
   Copyright   : © 2014-2020 Jesse Rosenthal <jrosenthal@jhu.edu>,
                   2014-2024 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
                                         , TableStyleName
                                         , 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 { StyleMaps -> CharStyleNameMap
smCharStyle  :: CharStyleNameMap
                           , StyleMaps -> ParaStyleNameMap
smParaStyle  :: ParaStyleNameMap
                           , StyleMaps -> TableStyleNameMap
smTableStyle :: TableStyleNameMap }
type TableStyleNameMap = M.Map TableStyleName TableStyle
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 :: forall sn sty.
(Ord sn, FromStyleName sn, IsString (StyleId sty),
 HasStyleId sty) =>
sn -> Map sn sty -> StyleId sty
getStyleIdFromName sn
s = StyleId sty -> (sty -> StyleId sty) -> Maybe sty -> StyleId sty
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (sn -> StyleId sty
fallback sn
s) sty -> StyleId sty
forall a. HasStyleId a => a -> StyleId a
getStyleId (Maybe sty -> StyleId sty)
-> (Map sn sty -> Maybe sty) -> Map sn sty -> StyleId sty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sn -> Map sn sty -> Maybe sty
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup sn
s
  where fallback :: sn -> StyleId sty
fallback = String -> StyleId sty
forall a. IsString a => String -> a
fromString (String -> StyleId sty) -> (sn -> String) -> sn -> StyleId sty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (sn -> Text) -> sn -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) (Text -> Text) -> (sn -> Text) -> sn -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sn -> Text
forall a. FromStyleName a => a -> Text
fromStyleName

hasStyleName :: (Ord sn, HasStyleId sty)
             => sn -> M.Map sn sty -> Bool
hasStyleName :: forall sn sty. (Ord sn, HasStyleId sty) => sn -> Map sn sty -> Bool
hasStyleName sn
styleName = sn -> Map sn sty -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member sn
styleName

getStyleMaps :: Archive -> StyleMaps
getStyleMaps :: Archive -> StyleMaps
getStyleMaps Archive
arch =
  let (Map (StyleName CharStyle) CharStyle
s1, Map (StyleName ParStyle) ParStyle
s2, Map (StyleName TableStyle) TableStyle
s3) = (CharStyle -> StyleName CharStyle)
-> (ParStyle -> StyleName ParStyle)
-> (TableStyle -> StyleName TableStyle)
-> Archive
-> (Map (StyleName CharStyle) CharStyle,
    Map (StyleName ParStyle) ParStyle,
    Map (StyleName TableStyle) TableStyle)
forall k1 k2 k3 a1 a2 a3.
(Ord k1, Ord k2, Ord k3, ElemToStyle a1, ElemToStyle a2,
 ElemToStyle a3) =>
(a1 -> k1)
-> (a2 -> k2)
-> (a3 -> k3)
-> Archive
-> (Map k1 a1, Map k2 a2, Map k3 a3)
archiveToStyles' CharStyle -> StyleName CharStyle
forall a. HasStyleName a => a -> StyleName a
getStyleName ParStyle -> StyleName ParStyle
forall a. HasStyleName a => a -> StyleName a
getStyleName TableStyle -> StyleName TableStyle
forall a. HasStyleName a => a -> StyleName a
getStyleName Archive
arch
  in  CharStyleNameMap
-> ParaStyleNameMap -> TableStyleNameMap -> StyleMaps
StyleMaps Map (StyleName CharStyle) CharStyle
CharStyleNameMap
s1 Map (StyleName ParStyle) ParStyle
ParaStyleNameMap
s2 Map (StyleName TableStyle) TableStyle
TableStyleNameMap
s3