content: {-# LANGUAGE CPP             #-}
  {-# LANGUAGE Arrows          #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE TupleSections   #-}
  {-# LANGUAGE OverloadedStrings #-}
  {- |
     Module      : Text.Pandoc.Readers.ODT.StyleReader
     Copyright   : Copyright (C) 2015 Martin Linnemann
     License     : GNU GPL, version 2 or above
  
     Maintainer  : Martin Linnemann <theCodingMarlin@googlemail.com>
     Stability   : alpha
     Portability : portable
  
  Reader for the style information in an odt document.
  -}
  
  module Text.Pandoc.Readers.ODT.StyleReader
  ( Style                (..)
  , StyleName
  , StyleFamily          (..)
  , Styles               (..)
  , StyleProperties      (..)
  , TextProperties       (..)
  , ParaProperties       (..)
  , VerticalTextPosition (..)
  , ListItemNumberFormat (..)
  , ListLevel
  , ListStyle            (..)
  , ListLevelStyle       (..)
  , ListLevelType        (..)
  , LengthOrPercent      (..)
  , lookupStyle
  , getListLevelStyle
  , getStyleFamily
  , lookupDefaultStyle'
  , lookupListStyleByName
  , extendedStylePropertyChain
  , readStylesAt
  ) where
  
  import Prelude hiding (Applicative(..))
  import Control.Applicative hiding (liftA, liftA2, liftA3)
  import Control.Arrow
  
  import Data.Default
  import qualified Data.Foldable as F
  import Data.List (unfoldr, foldl')
  import qualified Data.Map as M
  import Data.Maybe
  import Data.Text (Text)
  import qualified Data.Text as T
  import qualified Data.Set as S
  
  import qualified Text.Pandoc.XML.Light as XML
  
  import Text.Pandoc.Shared (safeRead, tshow)
  
  import Text.Pandoc.Readers.ODT.Arrows.Utils
  
  import Text.Pandoc.Readers.ODT.Generic.Fallible
  import qualified Text.Pandoc.Readers.ODT.Generic.SetMap as SM
  import Text.Pandoc.Readers.ODT.Generic.Utils
  import Text.Pandoc.Readers.ODT.Generic.XMLConverter
  
  import Text.Pandoc.Readers.ODT.Base
  import Text.Pandoc.Readers.ODT.Namespaces
  
  readStylesAt :: XML.Element -> Fallible Styles
  readStylesAt e = runConverter' readAllStyles mempty e
  
  --------------------------------------------------------------------------------
  -- Reader for font declarations and font pitches
  --------------------------------------------------------------------------------
  
  -- Pandoc has no support for different font pitches. Yet knowing them can be
  -- very helpful in cases where Pandoc has more semantics than OpenDocument.
  -- In these cases, the pitch can help deciding as what to define a block of
  -- text. So let's start with a type for font pitches:
  
  data FontPitch    = PitchVariable | PitchFixed
    deriving ( Eq, Show )
  
  instance Lookupable FontPitch where
    lookupTable = [ ("variable" , PitchVariable)
                  , ("fixed"    , PitchFixed   )
                  ]
  
  instance Default FontPitch where
    def = PitchVariable
  
  -- The font pitch can be specified in a style directly. Normally, however,
  -- it is defined in the font. That is also the specs' recommendation.
  --
  -- Thus, we want
  
  type FontFaceName = Text
  
  type FontPitches = M.Map FontFaceName FontPitch
  
  -- To get there, the fonts have to be read and the pitches extracted.
  -- But the resulting map are only needed at one later place, so it should not be
  -- transported on the value level, especially as we already use a state arrow.
  -- So instead, the resulting map is lifted into the state of the reader.
  -- (An alternative might be ImplicitParams, but again, we already have a state.)
  --
  -- So the main style readers will have the types
  type StyleReader     a b  = XMLReader     FontPitches a b
  -- and
  type StyleReaderSafe a b  = XMLReaderSafe FontPitches a b
  -- respectively.
  --
  -- But before we can work with these, we need to define the reader that reads
  -- the fonts:
  
  -- | A reader for font pitches
  fontPitchReader :: XMLReader _s _x FontPitches
  fontPitchReader = executeInSub NsOffice "font-face-decls" (
                            withEveryL NsStyle "font-face" (liftAsSuccess (
                                findAttr' NsStyle "name"
                                &&&
                                lookupDefaultingAttr NsStyle "font-pitch"
                              ))
                      >>?^ ( M.fromList . foldl' accumLegalPitches [] )
                    ) `ifFailedDo` returnV (Right M.empty)
    where accumLegalPitches ls (Nothing,_) = ls
          accumLegalPitches ls (Just n,p)  = (n,p):ls
  
  
  -- | A wrapper around the font pitch reader that lifts the result into the
  -- state.
  readFontPitches :: StyleReader x x
  readFontPitches = producingExtraState () () fontPitchReader
  
  
  -- | Looking up a pitch in the state of the arrow.
  --
  -- The function does the following:
  -- * Look for the font pitch in an attribute.
  -- * If that fails, look for the font name, look up the font in the state
  --   and use the pitch from there.
  -- * Return the result in a Maybe
  --
  findPitch :: XMLReaderSafe FontPitches _x (Maybe FontPitch)
  findPitch =     ( lookupAttr NsStyle "font-pitch"
                    `ifFailedDo`     findAttr NsStyle "font-name"
                                 >>? (     keepingTheValue getExtraState
                                       >>% M.lookup
                                       >>^ maybeToChoice
                                     )
                  )
              >>> choiceToMaybe
  
  --------------------------------------------------------------------------------
  -- Definitions of main data
  --------------------------------------------------------------------------------
  
  type StyleName        = Text
  
  -- | There are two types of styles: named styles with a style family and an
  -- optional style parent, and default styles for each style family,
  -- defining default style properties
  data Styles           = Styles
                            { stylesByName     :: M.Map StyleName   Style
                            , listStylesByName :: M.Map StyleName   ListStyle
                            , defaultStyleMap  :: M.Map StyleFamily StyleProperties
                            }
    deriving ( Show )
  
  -- Styles from a monoid under union
  instance Semigroup Styles where
    (Styles sBn1 dSm1 lsBn1) <> (Styles sBn2 dSm2 lsBn2)
            = Styles (M.union sBn1  sBn2)
                     (M.union dSm1  dSm2)
                     (M.union lsBn1 lsBn2)
  instance Monoid Styles where
    mempty  = Styles M.empty M.empty M.empty
    mappend = (<>)
  
  -- Not all families from the specifications are implemented, only those we need.
  -- But there are none that are not mentioned here.
  data StyleFamily      = FaText    | FaParagraph
  --                    | FaTable   | FaTableCell | FaTableColumn | FaTableRow
  --                    | FaGraphic | FaDrawing   | FaChart
  --                    | FaPresentation
  --                    | FaRuby
    deriving ( Eq, Ord, Show )
  
  instance Lookupable StyleFamily where
    lookupTable = [ ( "text"         , FaText         )
                  , ( "paragraph"    , FaParagraph    )
  --              , ( "table"        , FaTable        )
  --              , ( "table-cell"   , FaTableCell    )
  --              , ( "table-column" , FaTableColumn  )
  --              , ( "table-row"    , FaTableRow     )
  --              , ( "graphic"      , FaGraphic      )
  --              , ( "drawing-page" , FaDrawing      )
  --              , ( "chart"        , FaChart        )
  --              , ( "presentation" , FaPresentation )
  --              , ( "ruby"         , FaRuby         )
                  ]
  
  -- | A named style
  data Style            = Style  { styleFamily     :: Maybe StyleFamily
                                 , styleParentName :: Maybe StyleName
                                 , listStyle       :: Maybe StyleName
                                 , styleProperties :: StyleProperties
                                 }
    deriving ( Eq, Show )
  
  data StyleProperties  = SProps { textProperties :: Maybe TextProperties
                                 , paraProperties :: Maybe ParaProperties
  --                             , tableColProperties  :: Maybe TColProperties
  --                             , tableRowProperties  :: Maybe TRowProperties
  --                             , tableCellProperties :: Maybe TCellProperties
  --                             , tableProperties     :: Maybe TableProperties
  --                             , graphicProperties   :: Maybe GraphProperties
                                 }
    deriving ( Eq, Show )
  
  instance  Default StyleProperties where
    def =                SProps { textProperties       = Just def
                                 , paraProperties      = Just def
                                 }
  
  data TextProperties   = PropT  { isEmphasised     :: Bool
                                 , isStrong         :: Bool
                                 , pitch            :: Maybe FontPitch
                                 , verticalPosition :: VerticalTextPosition
                                 , underline        :: Maybe UnderlineMode
                                 , strikethrough    :: Maybe UnderlineMode
                                 }
    deriving ( Eq, Show )
  
  instance Default TextProperties where
    def =                 PropT  { isEmphasised     = False
                                 , isStrong         = False
                                 , pitch            = Just def
                                 , verticalPosition = def
                                 , underline        = Nothing
                                 , strikethrough    = Nothing
                                 }
  
  data ParaProperties   = PropP { paraNumbering :: ParaNumbering
                                , indentation   :: LengthOrPercent
                                , margin_left   :: LengthOrPercent
                                }
    deriving ( Eq, Show )
  
  instance Default ParaProperties where
    def =                 PropP { paraNumbering = NumberingNone
                                , indentation   = def
                                , margin_left   = def
                                }
  
  ----
  -- All the little data types that make up the properties
  ----
  
  data VerticalTextPosition = VPosNormal | VPosSuper | VPosSub
    deriving ( Eq, Show )
  
  instance Default VerticalTextPosition where
    def = VPosNormal
  
  instance Read VerticalTextPosition where
    readsPrec _ s =    [ (VPosSub        , s') | ("sub"   , s') <- lexS          ]
                    ++ [ (VPosSuper      , s') | ("super" , s') <- lexS          ]
                    ++ [ (signumToVPos n , s') | (  n     , s') <- readPercent s ]
      where
        lexS = lex s
        signumToVPos n | n < 0     = VPosSub
                       | n > 0     = VPosSuper
                       | otherwise = VPosNormal
  
  data UnderlineMode = UnderlineModeNormal | UnderlineModeSkipWhitespace
    deriving ( Eq, Show )
  
  instance Lookupable UnderlineMode where
    lookupTable = [ ( "continuous"       , UnderlineModeNormal         )
                  , ( "skip-white-space" , UnderlineModeSkipWhitespace )
                  ]
  
  
  data ParaNumbering = NumberingNone | NumberingKeep | NumberingRestart Int
    deriving ( Eq, Show )
  
  data LengthOrPercent = LengthValueMM Int | PercentValue Int
    deriving ( Eq, Show )
  
  instance Default LengthOrPercent where
    def = LengthValueMM 0
  
  instance Read LengthOrPercent where
    readsPrec _ s =
        [ (PercentValue  percent  , s' ) | (percent , s' ) <- readPercent s]
     ++ [ (LengthValueMM lengthMM , s'') | (length' , s' ) <- reads s
                                         , (unit    , s'') <- reads s'
                                         , let lengthMM = estimateInMillimeter
                                                                     length' unit
                                         ]
  
  data XslUnit = XslUnitMM | XslUnitCM
               | XslUnitInch
               | XslUnitPoints | XslUnitPica
               | XslUnitPixel
               | XslUnitEM
  
  instance Show XslUnit where
    show XslUnitMM     = "mm"
    show XslUnitCM     = "cm"
    show XslUnitInch   = "in"
    show XslUnitPoints = "pt"
    show XslUnitPica   = "pc"
    show XslUnitPixel  = "px"
    show XslUnitEM     = "em"
  
  instance Read XslUnit where
    readsPrec _ "mm" = [(XslUnitMM     , "")]
    readsPrec _ "cm" = [(XslUnitCM     , "")]
    readsPrec _ "in" = [(XslUnitInch   , "")]
    readsPrec _ "pt" = [(XslUnitPoints , "")]
    readsPrec _ "pc" = [(XslUnitPica   , "")]
    readsPrec _ "px" = [(XslUnitPixel  , "")]
    readsPrec _ "em" = [(XslUnitEM     , "")]
    readsPrec _  _   = []
  
  -- | Rough conversion of measures into millimetres.
  -- Pixels and em's are actually implementation dependent/relative measures,
  -- so I could not really easily calculate anything exact here even if I wanted.
  -- But I do not care about exactness right now, as I only use measures
  -- to determine if a paragraph is "indented" or not.
  estimateInMillimeter :: Double -> XslUnit -> Int
  estimateInMillimeter n XslUnitMM     = round n
  estimateInMillimeter n XslUnitCM     = round $ n * 10
  estimateInMillimeter n XslUnitInch   = round $ n * 25.4
  estimateInMillimeter n XslUnitPoints = round $ n * (1/72) * 25.4
  estimateInMillimeter n XslUnitPica   = round $ n * 12 * (1/72) * 25.4
  estimateInMillimeter n XslUnitPixel  = round $ n * (1/72) * 25.4
  estimateInMillimeter n XslUnitEM     = round $ n * 16 * (1/72) * 25.4
  
  
  ----
  -- List styles
  ----
  
  type ListLevel = Int
  
  newtype ListStyle = ListStyle { levelStyles :: M.Map ListLevel ListLevelStyle
                                }
    deriving ( Eq, Show )
  
  --
  getListLevelStyle :: ListLevel -> ListStyle -> Maybe ListLevelStyle
  getListLevelStyle level ListStyle{..} =
    let (lower , exactHit , _) = M.splitLookup level levelStyles
    in  exactHit <|> fmap fst (M.maxView lower)
    -- findBy (`M.lookup` levelStyles) [level, (level-1) .. 1]
    -- \^ simpler, but in general less efficient
  
  data ListLevelStyle = ListLevelStyle { listLevelType  :: ListLevelType
                                       , listItemPrefix :: Maybe Text
                                       , listItemSuffix :: Maybe Text
                                       , listItemFormat :: ListItemNumberFormat
                                       , listItemStart  :: Int
                                       }
    deriving ( Eq, Ord )
  
  instance Show ListLevelStyle where
    show ListLevelStyle{..} =    "<LLS|"
                              ++ show listLevelType
                              ++ "|"
                              ++ maybeToString (T.unpack <$> listItemPrefix)
                              ++ show listItemFormat
                              ++ maybeToString (T.unpack <$> listItemSuffix)
                              ++ ">"
      where maybeToString = fromMaybe ""
  
  data ListLevelType = LltBullet | LltImage | LltNumbered
    deriving ( Eq, Ord, Show )
  
  data ListItemNumberFormat = LinfNone
                            | LinfNumber
                            | LinfRomanLC | LinfRomanUC
                            | LinfAlphaLC | LinfAlphaUC
                            | LinfString String
    deriving ( Eq, Ord )
  
  instance Show ListItemNumberFormat where
    show  LinfNone      = ""
    show  LinfNumber    = "1"
    show  LinfRomanLC   = "i"
    show  LinfRomanUC   = "I"
    show  LinfAlphaLC   = "a"
    show  LinfAlphaUC   = "A"
    show (LinfString s) =  s
  
  instance Default ListItemNumberFormat where
    def = LinfNone
  
  instance Read ListItemNumberFormat where
    readsPrec _ ""  = [(LinfNone     , "")]
    readsPrec _ "1" = [(LinfNumber   , "")]
    readsPrec _ "i" = [(LinfRomanLC  , "")]
    readsPrec _ "I" = [(LinfRomanUC  , "")]
    readsPrec _ "a" = [(LinfAlphaLC  , "")]
    readsPrec _ "A" = [(LinfAlphaUC  , "")]
    readsPrec _  s  = [(LinfString s , "")]
  
  --------------------------------------------------------------------------------
  -- Readers
  --
  -- ...it seems like a whole lot of this should be automatically derivable
  --    or at least moveable into a class. Most of this is data concealed in
  --    code.
  --------------------------------------------------------------------------------
  
  --
  readAllStyles :: StyleReader _x Styles
  readAllStyles = (      readFontPitches
                    >>?! (     readAutomaticStyles
                           &&& readStyles ))
                    >>?%? chooseMax
   -- all top elements are always on the same hierarchy level
  
  --
  readStyles :: StyleReader _x Styles
  readStyles = executeInSub NsOffice "styles" $ liftAsSuccess
    $ liftA3 Styles
      ( tryAll NsStyle "style"         readStyle        >>^ M.fromList )
      ( tryAll NsText  "list-style"    readListStyle    >>^ M.fromList )
      ( tryAll NsStyle "default-style" readDefaultStyle >>^ M.fromList )
  
  --
  readAutomaticStyles :: StyleReader _x Styles
  readAutomaticStyles = executeInSub NsOffice "automatic-styles" $ liftAsSuccess
    $ liftA3 Styles
      ( tryAll NsStyle "style"         readStyle        >>^ M.fromList )
      ( tryAll NsText  "list-style"    readListStyle    >>^ M.fromList )
      ( returnV M.empty                                                )
  
  --
  readDefaultStyle :: StyleReader _x (StyleFamily, StyleProperties)
  readDefaultStyle =      lookupAttr NsStyle "family"
                     >>?! keepingTheValue readStyleProperties
  
  --
  readStyle :: StyleReader _x (StyleName,Style)
  readStyle =      findAttr NsStyle "name"
              >>?! keepingTheValue
                     ( liftA4 Style
                         ( lookupAttr' NsStyle "family"            )
                         ( findAttr'   NsStyle "parent-style-name" )
                         ( findAttr'   NsStyle "list-style-name"   )
                         readStyleProperties
                     )
  
  --
  readStyleProperties :: StyleReaderSafe _x StyleProperties
  readStyleProperties = liftA2 SProps
                         ( readTextProperties >>> choiceToMaybe )
                         ( readParaProperties >>> choiceToMaybe )
  
  --
  readTextProperties :: StyleReader _x TextProperties
  readTextProperties =
    executeInSub NsStyle "text-properties" $ liftAsSuccess
      ( liftA6 PropT
         ( searchAttr   NsXSL_FO "font-style"  False isFontEmphasised )
         ( searchAttr   NsXSL_FO "font-weight" False isFontBold       )
         findPitch
         ( getAttr      NsStyle  "text-position"                      )
         readUnderlineMode
         readStrikeThroughMode
       )
    where isFontEmphasised = [("normal",False),("italic",True),("oblique",True)]
          isFontBold = ("normal",False):("bold",True)
                      :map ((,True) . tshow) ([100,200..900]::[Int])
  
  readUnderlineMode     :: StyleReaderSafe _x (Maybe UnderlineMode)
  readUnderlineMode     = readLineMode "text-underline-mode"
                                       "text-underline-style"
  
  readStrikeThroughMode :: StyleReaderSafe _x (Maybe UnderlineMode)
  readStrikeThroughMode = readLineMode "text-line-through-mode"
                                       "text-line-through-style"
  
  readLineMode :: Text -> Text -> StyleReaderSafe _x (Maybe UnderlineMode)
  readLineMode modeAttr styleAttr = proc x -> do
    isUL <- searchAttr  NsStyle styleAttr False isLinePresent -< x
    mode <- lookupAttr' NsStyle  modeAttr                     -< x
    if isUL
      then case mode of
             Just m  -> returnA -< Just m
             Nothing -> returnA -< Just UnderlineModeNormal
      else              returnA -< Nothing
    where
      isLinePresent = ("none",False) : map (,True)
                      [ "dash"      , "dot-dash" , "dot-dot-dash" , "dotted"
                      , "long-dash" , "solid"    , "wave"
                      ]
  
  --
  readParaProperties :: StyleReader _x ParaProperties
  readParaProperties =
     executeInSub NsStyle "paragraph-properties" $ liftAsSuccess
       ( liftA3 PropP
         ( liftA2 readNumbering
           ( isSet'           NsText   "number-lines"           )
           ( readAttr'        NsText   "line-number"            )
         )
         ( liftA2 readIndentation
           ( isSetWithDefault NsStyle  "auto-text-indent" False )
           ( getAttr          NsXSL_FO "text-indent"            )
         )
         (   getAttr          NsXSL_FO "margin-left"            )
       )
    where readNumbering (Just True) (Just n) = NumberingRestart n
          readNumbering (Just True)  _       = NumberingKeep
          readNumbering      _       _       = NumberingNone
  
          readIndentation False indent = indent
          readIndentation True  _      = def
  
  ----
  -- List styles
  ----
  
  --
  readListStyle :: StyleReader _x (StyleName, ListStyle)
  readListStyle =
         findAttr NsStyle "name"
    >>?! keepingTheValue
         ( liftA ListStyle
           $ liftA3 SM.union3
               ( readListLevelStyles NsText "list-level-style-number" LltNumbered )
               ( readListLevelStyles NsText "list-level-style-bullet" LltBullet   )
               ( readListLevelStyles NsText "list-level-style-image"  LltImage    ) >>^ M.mapMaybe chooseMostSpecificListLevelStyle
         )
  --
  readListLevelStyles :: Namespace -> ElementName
                      -> ListLevelType
                      -> StyleReaderSafe _x (SM.SetMap Int ListLevelStyle)
  readListLevelStyles namespace elementName levelType =
    tryAll namespace elementName (readListLevelStyle levelType)
      >>^ SM.fromList
  
  --
  readListLevelStyle :: ListLevelType -> StyleReader _x (Int, ListLevelStyle)
  readListLevelStyle levelType =      readAttr NsText "level"
                                 >>?! keepingTheValue
                                      ( liftA5 toListLevelStyle
                                        ( returnV       levelType             )
                                        ( findAttr'     NsStyle "num-prefix"  )
                                        ( findAttr'     NsStyle "num-suffix"  )
                                        ( getAttr       NsStyle "num-format"  )
                                        ( findAttrText' NsText  "start-value" )
                                      )
    where
    toListLevelStyle _ p s LinfNone b         = ListLevelStyle LltBullet p s LinfNone (startValue b)
    toListLevelStyle _ p s f@(LinfString _) b = ListLevelStyle LltBullet p s f (startValue b)
    toListLevelStyle t p s f b                = ListLevelStyle t      p s f (startValue b)
    startValue mbx = fromMaybe 1 (mbx >>= safeRead)
  
  --
  chooseMostSpecificListLevelStyle :: S.Set ListLevelStyle -> Maybe ListLevelStyle
  chooseMostSpecificListLevelStyle ls = F.foldr select Nothing ls
    where
     select l Nothing = Just l
     select ( ListLevelStyle t1 p1 s1 f1 b1 )
            ( Just ( ListLevelStyle t2 p2 s2 f2 _ ))
          =   Just $ ListLevelStyle (select' t1 t2) (p1 <|> p2) (s1 <|> s2)
                                    (selectLinf f1 f2) b1
     select' LltNumbered _           = LltNumbered
     select' _           LltNumbered = LltNumbered
     select' _           _           = LltBullet
     selectLinf LinfNone       f2             = f2
     selectLinf f1             LinfNone       = f1
     selectLinf (LinfString _) f2             = f2
     selectLinf f1             (LinfString _) = f1
     selectLinf f1             _              = f1
  
  
  --------------------------------------------------------------------------------
  -- Tools to access style data
  --------------------------------------------------------------------------------
  
  --
  lookupStyle           :: StyleName   -> Styles -> Maybe Style
  lookupStyle name Styles{..} = M.lookup name stylesByName
  
  --
  lookupDefaultStyle'   :: Styles -> StyleFamily -> StyleProperties
  lookupDefaultStyle' Styles{..} family = fromMaybe def
                                          (M.lookup family defaultStyleMap)
  
  --
  lookupListStyleByName :: StyleName   -> Styles -> Maybe ListStyle
  lookupListStyleByName name Styles{..} = M.lookup name listStylesByName
  
  
  -- | Returns a chain of parent of the current style. The direct parent will
  -- be the first element of the list, followed by its parent and so on.
  -- The current style is not in the list.
  parents               :: Style       -> Styles ->      [Style]
  parents style styles = unfoldr findNextParent style -- Ha!
    where findNextParent Style{..}
            = fmap duplicate $ (`lookupStyle` styles) =<< styleParentName
  
  -- | Looks up the style family of the current style. Normally, every style
  -- should have one. But if not, all parents are searched.
  getStyleFamily        :: Style       -> Styles -> Maybe StyleFamily
  getStyleFamily style@Style{..} styles
    =     styleFamily
      <|> F.asum (map (`getStyleFamily` styles) $ parents style styles)
  
  -- | Each 'Style' has certain 'StyleProperties'. But sometimes not all property
  -- values are specified. Instead, a value might be inherited from a
  -- parent style. This function makes this chain of inheritance
  -- concrete and easily accessible by encapsulating the necessary lookups.
  -- The resulting list contains the direct properties of the style as the first
  -- element, the ones of the direct parent element as the next one, and so on.
  --
  -- Note: There should also be default properties for each style family. These
  --       are @not@ contained in this list because properties inherited from
  --       parent elements take precedence over default styles.
  --
  -- This function is primarily meant to be used through convenience wrappers.
  --
  stylePropertyChain    :: Style       -> Styles -> [StyleProperties]
  stylePropertyChain style styles
    = map styleProperties (style : parents style styles)
  
  --
  extendedStylePropertyChain :: [Style] -> Styles -> [StyleProperties]
  extendedStylePropertyChain [] _ = []
  extendedStylePropertyChain [style]       styles =    stylePropertyChain style styles
                                                    ++ maybeToList (fmap (lookupDefaultStyle' styles) (getStyleFamily style styles))
  extendedStylePropertyChain (style:trace) styles =    stylePropertyChain style styles
                                                    ++ extendedStylePropertyChain trace styles
  