{-# LANGUAGE FlexibleContexts  #-}
{- |
   Module : Text.Pandoc.Writers.Docx.StyleMap
   Copyright   : © 2014-2020 Jesse Rosenthal <jrosenthal@jhu.edu>,
                   2014-2020 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 { StyleMaps -> CharStyleNameMap
smCharStyle :: CharStyleNameMap, StyleMaps -> ParaStyleNameMap
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 :: 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 :: 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 = (CharStyleNameMap -> ParaStyleNameMap -> StyleMaps)
-> (CharStyleNameMap, ParaStyleNameMap) -> StyleMaps
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry CharStyleNameMap -> ParaStyleNameMap -> StyleMaps
StyleMaps ((CharStyleNameMap, ParaStyleNameMap) -> StyleMaps)
-> (Archive -> (CharStyleNameMap, ParaStyleNameMap))
-> Archive
-> StyleMaps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CharStyle -> CharStyleName)
-> (ParStyle -> ParaStyleName)
-> Archive
-> (CharStyleNameMap, ParaStyleNameMap)
forall k1 k2 a1 a2.
(Ord k1, Ord k2, ElemToStyle a1, ElemToStyle a2) =>
(a1 -> k1) -> (a2 -> k2) -> Archive -> (Map k1 a1, Map k2 a2)
archiveToStyles' CharStyle -> CharStyleName
forall a. HasStyleName a => a -> StyleName a
getStyleName ParStyle -> ParaStyleName
forall a. HasStyleName a => a -> StyleName a
getStyleName