    {-# 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 qualified Data.List as L
    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 :: Element -> Fallible Styles
    readStylesAt Element
    e = FallibleXMLConverter Namespace FontPitches () Styles
    -> FontPitches -> Element -> Fallible Styles
    forall nsID extraState success.
    NameSpaceID nsID =>
    FallibleXMLConverter nsID extraState () success
    -> extraState -> Element -> Fallible success
    runConverter' FallibleXMLConverter Namespace FontPitches () Styles
    forall a. StyleReader a Styles
    readAllStyles FontPitches
    forall a. Monoid a => a
    mempty Element
    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 ( FontPitch -> FontPitch -> Bool
    (FontPitch -> FontPitch -> Bool)
    -> (FontPitch -> FontPitch -> Bool) -> Eq FontPitch
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: FontPitch -> FontPitch -> Bool
    == :: FontPitch -> FontPitch -> Bool
    $c/= :: FontPitch -> FontPitch -> Bool
    /= :: FontPitch -> FontPitch -> Bool
    Eq, Int -> FontPitch -> ShowS
    [FontPitch] -> ShowS
    FontPitch -> String
    (Int -> FontPitch -> ShowS)
    -> (FontPitch -> String)
    -> ([FontPitch] -> ShowS)
    -> Show FontPitch
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FontPitch -> ShowS
    showsPrec :: Int -> FontPitch -> ShowS
    $cshow :: FontPitch -> String
    show :: FontPitch -> String
    $cshowList :: [FontPitch] -> ShowS
    showList :: [FontPitch] -> ShowS
    Show )

    instance Lookupable FontPitch where
      lookupTable :: [(StyleName, FontPitch)]
    lookupTable = [ (StyleName
    "variable" , FontPitch
    PitchVariable)
                    , (StyleName
    "fixed"    , FontPitch
    PitchFixed   )
                    ]

    instance Default FontPitch where
      def :: FontPitch
    def = FontPitch
    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 a FontPitches
    fontPitchReader :: forall s a. XMLReader s a FontPitches
    fontPitchReader = Namespace
    -> StyleName
    -> FallibleXMLConverter Namespace s a FontPitches
    -> FallibleXMLConverter Namespace s a FontPitches
    forall nsID extraState f s.
    NameSpaceID nsID =>
    nsID
    -> StyleName
    -> FallibleXMLConverter nsID extraState f s
    -> FallibleXMLConverter nsID extraState f s
    executeInSub Namespace
    NsOffice StyleName
    "font-face-decls" (
                              Namespace
    -> StyleName
    -> FallibleXMLConverter Namespace s a (Maybe StyleName, FontPitch)
    -> FallibleXMLConverter
         Namespace s a [(Maybe StyleName, FontPitch)]
    forall nsID extraState a b.
    NameSpaceID nsID =>
    nsID
    -> StyleName
    -> FallibleXMLConverter nsID extraState a b
    -> FallibleXMLConverter nsID extraState a [b]
    withEveryL Namespace
    NsStyle StyleName
    "font-face" (ArrowState
      (XMLConverterState Namespace s) a (Maybe StyleName, FontPitch)
    -> FallibleXMLConverter Namespace s a (Maybe StyleName, FontPitch)
    forall (a :: * -> * -> *) x success failure.
    ArrowChoice a =>
    a x success -> FallibleArrow a x failure success
    liftAsSuccess (
                                  Namespace
    -> StyleName -> XMLConverter Namespace s a (Maybe StyleName)
    forall nsID extraState x.
    NameSpaceID nsID =>
    nsID
    -> StyleName -> XMLConverter nsID extraState x (Maybe StyleName)
    findAttr' Namespace
    NsStyle StyleName
    "name"
                                  XMLConverter Namespace s a (Maybe StyleName)
    -> ArrowState (XMLConverterState Namespace s) a FontPitch
    -> ArrowState
         (XMLConverterState Namespace s) a (Maybe StyleName, FontPitch)
    forall b c c'.
    ArrowState (XMLConverterState Namespace s) b c
    -> ArrowState (XMLConverterState Namespace s) b c'
    -> ArrowState (XMLConverterState Namespace s) b (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&&
                                  Namespace
    -> StyleName
    -> ArrowState (XMLConverterState Namespace s) a FontPitch
    forall nsID a extraState x.
    (NameSpaceID nsID, Lookupable a, Default a) =>
    nsID -> StyleName -> XMLConverter nsID extraState x a
    lookupDefaultingAttr Namespace
    NsStyle StyleName
    "font-pitch"
                                ))
                        FallibleXMLConverter Namespace s a [(Maybe StyleName, FontPitch)]
    -> ([(Maybe StyleName, FontPitch)] -> FontPitches)
    -> FallibleXMLConverter Namespace s a FontPitches
    forall (a :: * -> * -> *) x failure success success'.
    ArrowChoice a =>
    FallibleArrow a x failure success
    -> (success -> success') -> FallibleArrow a x failure success'
    >>?^ ( [(StyleName, FontPitch)] -> FontPitches
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ([(StyleName, FontPitch)] -> FontPitches)
    -> ([(Maybe StyleName, FontPitch)] -> [(StyleName, FontPitch)])
    -> [(Maybe StyleName, FontPitch)]
    -> FontPitches
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([(StyleName, FontPitch)]
     -> (Maybe StyleName, FontPitch) -> [(StyleName, FontPitch)])
    -> [(StyleName, FontPitch)]
    -> [(Maybe StyleName, FontPitch)]
    -> [(StyleName, FontPitch)]
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    L.foldl' [(StyleName, FontPitch)]
    -> (Maybe StyleName, FontPitch) -> [(StyleName, FontPitch)]
    forall {a} {b}. [(a, b)] -> (Maybe a, b) -> [(a, b)]
    accumLegalPitches [] )
                      ) FallibleXMLConverter Namespace s a FontPitches
    -> FallibleXMLConverter Namespace s a FontPitches
    -> FallibleXMLConverter Namespace s a FontPitches
    forall (a :: * -> * -> *) x f y.
    ArrowChoice a =>
    FallibleArrow a x f y
    -> FallibleArrow a x f y -> FallibleArrow a x f y
    `ifFailedDo` Either () FontPitches
    -> FallibleXMLConverter Namespace s a FontPitches
    forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
    returnV (FontPitches -> Either () FontPitches
    forall a b. b -> Either a b
    Right FontPitches
    forall k a. Map k a
    M.empty)
      where accumLegalPitches :: [(a, b)] -> (Maybe a, b) -> [(a, b)]
    accumLegalPitches [(a, b)]
    ls (Maybe a
    Nothing,b
    _) = [(a, b)]
    ls
            accumLegalPitches [(a, b)]
    ls (Just a
    n,b
    p)  = (a
    n,b
    p)(a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    :[(a, b)]
    ls

    -- | A wrapper around the font pitch reader that lifts the result into the
    -- state.
    readFontPitches :: StyleReader a a
    readFontPitches :: forall a. StyleReader a a
    readFontPitches = ()
    -> ()
    -> FallibleXMLConverter Namespace () () FontPitches
    -> FallibleXMLConverter Namespace FontPitches a a
    forall extraState' a nsID extraState x.
    extraState'
    -> a
    -> FallibleXMLConverter nsID extraState' a extraState
    -> FallibleXMLConverter nsID extraState x x
    producingExtraState () () FallibleXMLConverter Namespace () () FontPitches
    forall s a. XMLReader s a FontPitches
    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 a (Maybe FontPitch)
    findPitch :: forall a. XMLReaderSafe FontPitches a (Maybe FontPitch)
    findPitch =     ( Namespace
    -> StyleName
    -> FallibleXMLConverter Namespace FontPitches a FontPitch
    forall nsID a extraState x.
    (NameSpaceID nsID, Lookupable a) =>
    nsID -> StyleName -> FallibleXMLConverter nsID extraState x a
    lookupAttr Namespace
    NsStyle StyleName
    "font-pitch"
                      FallibleXMLConverter Namespace FontPitches a FontPitch
    -> FallibleXMLConverter Namespace FontPitches a FontPitch
    -> FallibleXMLConverter Namespace FontPitches a FontPitch
    forall (a :: * -> * -> *) x f y.
    ArrowChoice a =>
    FallibleArrow a x f y
    -> FallibleArrow a x f y -> FallibleArrow a x f y
    `ifFailedDo`     Namespace
    -> StyleName
    -> FallibleXMLConverter Namespace FontPitches a StyleName
    forall nsID extraState x.
    NameSpaceID nsID =>
    nsID
    -> StyleName -> FallibleXMLConverter nsID extraState x StyleName
    findAttr Namespace
    NsStyle StyleName
    "font-name"
                                   FallibleXMLConverter Namespace FontPitches a StyleName
    -> FallibleArrow
         (ArrowState (XMLConverterState Namespace FontPitches))
         StyleName
         ()
         FontPitch
    -> FallibleXMLConverter Namespace FontPitches a FontPitch
    forall (a :: * -> * -> *) x failure success success'.
    ArrowChoice a =>
    FallibleArrow a x failure success
    -> FallibleArrow a success failure success'
    -> FallibleArrow a x failure success'
    >>? (     ArrowState
      (XMLConverterState Namespace FontPitches) StyleName FontPitches
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (StyleName, FontPitches)
    forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
    keepingTheValue ArrowState
      (XMLConverterState Namespace FontPitches) StyleName FontPitches
    forall nsID extraState x. XMLConverter nsID extraState x extraState
    getExtraState
                                         ArrowState
      (XMLConverterState Namespace FontPitches)
      StyleName
      (StyleName, FontPitches)
    -> (StyleName -> FontPitches -> Maybe FontPitch)
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (Maybe FontPitch)
    forall (a :: * -> * -> *) x b c d.
    Arrow a =>
    a x (b, c) -> (b -> c -> d) -> a x d
    >>% StyleName -> FontPitches -> Maybe FontPitch
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup
                                         ArrowState
      (XMLConverterState Namespace FontPitches)
      StyleName
      (Maybe FontPitch)
    -> (Maybe FontPitch -> Either () FontPitch)
    -> FallibleArrow
         (ArrowState (XMLConverterState Namespace FontPitches))
         StyleName
         ()
         FontPitch
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> (c -> d) -> a b d
    >>^ Maybe FontPitch -> Either () FontPitch
    forall (a :: * -> * -> *) b.
    ArrowChoice a =>
    a (Maybe b) (Fallible b)
    maybeToChoice
                                       )
                    )
                FallibleXMLConverter Namespace FontPitches a FontPitch
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         (Either () FontPitch)
         (Maybe FontPitch)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a (Maybe FontPitch)
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> ArrowState
      (XMLConverterState Namespace FontPitches)
      (Either () FontPitch)
      (Maybe FontPitch)
    forall (a :: * -> * -> *) l r.
    ArrowChoice a =>
    a (Either l r) (Maybe r)
    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
                              { Styles -> Map StyleName Style
    stylesByName     :: M.Map StyleName   Style
                              , Styles -> Map StyleName ListStyle
    listStylesByName :: M.Map StyleName   ListStyle
                              , Styles -> Map StyleFamily StyleProperties
    defaultStyleMap  :: M.Map StyleFamily StyleProperties
                              }
      deriving ( Int -> Styles -> ShowS
    [Styles] -> ShowS
    Styles -> String
    (Int -> Styles -> ShowS)
    -> (Styles -> String) -> ([Styles] -> ShowS) -> Show Styles
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Styles -> ShowS
    showsPrec :: Int -> Styles -> ShowS
    $cshow :: Styles -> String
    show :: Styles -> String
    $cshowList :: [Styles] -> ShowS
    showList :: [Styles] -> ShowS
    Show )

    -- Styles from a monoid under union
    instance Semigroup Styles where
      (Styles Map StyleName Style
    sBn1 Map StyleName ListStyle
    dSm1 Map StyleFamily StyleProperties
    lsBn1) <> :: Styles -> Styles -> Styles
    <> (Styles Map StyleName Style
    sBn2 Map StyleName ListStyle
    dSm2 Map StyleFamily StyleProperties
    lsBn2)
              = Map StyleName Style
    -> Map StyleName ListStyle
    -> Map StyleFamily StyleProperties
    -> Styles
    Styles (Map StyleName Style -> Map StyleName Style -> Map StyleName Style
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    M.union Map StyleName Style
    sBn1  Map StyleName Style
    sBn2)
                       (Map StyleName ListStyle
    -> Map StyleName ListStyle -> Map StyleName ListStyle
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    M.union Map StyleName ListStyle
    dSm1  Map StyleName ListStyle
    dSm2)
                       (Map StyleFamily StyleProperties
    -> Map StyleFamily StyleProperties
    -> Map StyleFamily StyleProperties
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    M.union Map StyleFamily StyleProperties
    lsBn1 Map StyleFamily StyleProperties
    lsBn2)
    instance Monoid Styles where
      mempty :: Styles
    mempty  = Map StyleName Style
    -> Map StyleName ListStyle
    -> Map StyleFamily StyleProperties
    -> Styles
    Styles Map StyleName Style
    forall k a. Map k a
    M.empty Map StyleName ListStyle
    forall k a. Map k a
    M.empty Map StyleFamily StyleProperties
    forall k a. Map k a
    M.empty
      mappend :: Styles -> Styles -> Styles
    mappend = Styles -> Styles -> Styles
    forall a. Semigroup a => a -> a -> a
    (<>)

    -- 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 ( StyleFamily -> StyleFamily -> Bool
    (StyleFamily -> StyleFamily -> Bool)
    -> (StyleFamily -> StyleFamily -> Bool) -> Eq StyleFamily
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: StyleFamily -> StyleFamily -> Bool
    == :: StyleFamily -> StyleFamily -> Bool
    $c/= :: StyleFamily -> StyleFamily -> Bool
    /= :: StyleFamily -> StyleFamily -> Bool
    Eq, Eq StyleFamily
    Eq StyleFamily =>
    (StyleFamily -> StyleFamily -> Ordering)
    -> (StyleFamily -> StyleFamily -> Bool)
    -> (StyleFamily -> StyleFamily -> Bool)
    -> (StyleFamily -> StyleFamily -> Bool)
    -> (StyleFamily -> StyleFamily -> Bool)
    -> (StyleFamily -> StyleFamily -> StyleFamily)
    -> (StyleFamily -> StyleFamily -> StyleFamily)
    -> Ord StyleFamily
    StyleFamily -> StyleFamily -> Bool
    StyleFamily -> StyleFamily -> Ordering
    StyleFamily -> StyleFamily -> StyleFamily
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: StyleFamily -> StyleFamily -> Ordering
    compare :: StyleFamily -> StyleFamily -> Ordering
    $c< :: StyleFamily -> StyleFamily -> Bool
    < :: StyleFamily -> StyleFamily -> Bool
    $c<= :: StyleFamily -> StyleFamily -> Bool
    <= :: StyleFamily -> StyleFamily -> Bool
    $c> :: StyleFamily -> StyleFamily -> Bool
    > :: StyleFamily -> StyleFamily -> Bool
    $c>= :: StyleFamily -> StyleFamily -> Bool
    >= :: StyleFamily -> StyleFamily -> Bool
    $cmax :: StyleFamily -> StyleFamily -> StyleFamily
    max :: StyleFamily -> StyleFamily -> StyleFamily
    $cmin :: StyleFamily -> StyleFamily -> StyleFamily
    min :: StyleFamily -> StyleFamily -> StyleFamily
    Ord, Int -> StyleFamily -> ShowS
    [StyleFamily] -> ShowS
    StyleFamily -> String
    (Int -> StyleFamily -> ShowS)
    -> (StyleFamily -> String)
    -> ([StyleFamily] -> ShowS)
    -> Show StyleFamily
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> StyleFamily -> ShowS
    showsPrec :: Int -> StyleFamily -> ShowS
    $cshow :: StyleFamily -> String
    show :: StyleFamily -> String
    $cshowList :: [StyleFamily] -> ShowS
    showList :: [StyleFamily] -> ShowS
    Show )

    instance Lookupable StyleFamily where
      lookupTable :: [(StyleName, StyleFamily)]
    lookupTable = [ ( StyleName
    "text"         , StyleFamily
    FaText         )
                    , ( StyleName
    "paragraph"    , StyleFamily
    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  { Style -> Maybe StyleFamily
    styleFamily     :: Maybe StyleFamily
                                   , Style -> Maybe StyleName
    styleParentName :: Maybe StyleName
                                   , Style -> Maybe StyleName
    listStyle       :: Maybe StyleName
                                   , Style -> StyleProperties
    styleProperties :: StyleProperties
                                   }
      deriving ( Style -> Style -> Bool
    (Style -> Style -> Bool) -> (Style -> Style -> Bool) -> Eq Style
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Style -> Style -> Bool
    == :: Style -> Style -> Bool
    $c/= :: Style -> Style -> Bool
    /= :: Style -> Style -> Bool
    Eq, Int -> Style -> ShowS
    [Style] -> ShowS
    Style -> String
    (Int -> Style -> ShowS)
    -> (Style -> String) -> ([Style] -> ShowS) -> Show Style
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Style -> ShowS
    showsPrec :: Int -> Style -> ShowS
    $cshow :: Style -> String
    show :: Style -> String
    $cshowList :: [Style] -> ShowS
    showList :: [Style] -> ShowS
    Show )

    data StyleProperties  = SProps { StyleProperties -> Maybe TextProperties
    textProperties :: Maybe TextProperties
                                   , StyleProperties -> Maybe ParaProperties
    paraProperties :: Maybe ParaProperties
    --                             , tableColProperties  :: Maybe TColProperties
    --                             , tableRowProperties  :: Maybe TRowProperties
    --                             , tableCellProperties :: Maybe TCellProperties
    --                             , tableProperties     :: Maybe TableProperties
    --                             , graphicProperties   :: Maybe GraphProperties
                                   }
      deriving ( StyleProperties -> StyleProperties -> Bool
    (StyleProperties -> StyleProperties -> Bool)
    -> (StyleProperties -> StyleProperties -> Bool)
    -> Eq StyleProperties
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: StyleProperties -> StyleProperties -> Bool
    == :: StyleProperties -> StyleProperties -> Bool
    $c/= :: StyleProperties -> StyleProperties -> Bool
    /= :: StyleProperties -> StyleProperties -> Bool
    Eq, Int -> StyleProperties -> ShowS
    [StyleProperties] -> ShowS
    StyleProperties -> String
    (Int -> StyleProperties -> ShowS)
    -> (StyleProperties -> String)
    -> ([StyleProperties] -> ShowS)
    -> Show StyleProperties
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> StyleProperties -> ShowS
    showsPrec :: Int -> StyleProperties -> ShowS
    $cshow :: StyleProperties -> String
    show :: StyleProperties -> String
    $cshowList :: [StyleProperties] -> ShowS
    showList :: [StyleProperties] -> ShowS
    Show )

    instance  Default StyleProperties where
      def :: StyleProperties
    def =                SProps { textProperties :: Maybe TextProperties
    textProperties       = TextProperties -> Maybe TextProperties
    forall a. a -> Maybe a
    Just TextProperties
    forall a. Default a => a
    def
                                   , paraProperties :: Maybe ParaProperties
    paraProperties      = ParaProperties -> Maybe ParaProperties
    forall a. a -> Maybe a
    Just ParaProperties
    forall a. Default a => a
    def
                                   }

    data TextProperties   = PropT  { TextProperties -> Bool
    isEmphasised     :: Bool
                                   , TextProperties -> Bool
    isStrong         :: Bool
                                   , TextProperties -> Maybe FontPitch
    pitch            :: Maybe FontPitch
                                   , TextProperties -> VerticalTextPosition
    verticalPosition :: VerticalTextPosition
                                   , TextProperties -> Maybe UnderlineMode
    underline        :: Maybe UnderlineMode
                                   , TextProperties -> Maybe UnderlineMode
    strikethrough    :: Maybe UnderlineMode
                                   }
      deriving ( TextProperties -> TextProperties -> Bool
    (TextProperties -> TextProperties -> Bool)
    -> (TextProperties -> TextProperties -> Bool) -> Eq TextProperties
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TextProperties -> TextProperties -> Bool
    == :: TextProperties -> TextProperties -> Bool
    $c/= :: TextProperties -> TextProperties -> Bool
    /= :: TextProperties -> TextProperties -> Bool
    Eq, Int -> TextProperties -> ShowS
    [TextProperties] -> ShowS
    TextProperties -> String
    (Int -> TextProperties -> ShowS)
    -> (TextProperties -> String)
    -> ([TextProperties] -> ShowS)
    -> Show TextProperties
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> TextProperties -> ShowS
    showsPrec :: Int -> TextProperties -> ShowS
    $cshow :: TextProperties -> String
    show :: TextProperties -> String
    $cshowList :: [TextProperties] -> ShowS
    showList :: [TextProperties] -> ShowS
    Show )

    instance Default TextProperties where
      def :: TextProperties
    def =                 PropT  { isEmphasised :: Bool
    isEmphasised     = Bool
    False
                                   , isStrong :: Bool
    isStrong         = Bool
    False
                                   , pitch :: Maybe FontPitch
    pitch            = FontPitch -> Maybe FontPitch
    forall a. a -> Maybe a
    Just FontPitch
    forall a. Default a => a
    def
                                   , verticalPosition :: VerticalTextPosition
    verticalPosition = VerticalTextPosition
    forall a. Default a => a
    def
                                   , underline :: Maybe UnderlineMode
    underline        = Maybe UnderlineMode
    forall a. Maybe a
    Nothing
                                   , strikethrough :: Maybe UnderlineMode
    strikethrough    = Maybe UnderlineMode
    forall a. Maybe a
    Nothing
                                   }

    data ParaProperties   = PropP { ParaProperties -> ParaNumbering
    paraNumbering :: ParaNumbering
                                  , ParaProperties -> LengthOrPercent
    indentation   :: LengthOrPercent
                                  , ParaProperties -> LengthOrPercent
    margin_left   :: LengthOrPercent
                                  }
      deriving ( ParaProperties -> ParaProperties -> Bool
    (ParaProperties -> ParaProperties -> Bool)
    -> (ParaProperties -> ParaProperties -> Bool) -> Eq ParaProperties
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ParaProperties -> ParaProperties -> Bool
    == :: ParaProperties -> ParaProperties -> Bool
    $c/= :: ParaProperties -> ParaProperties -> Bool
    /= :: ParaProperties -> ParaProperties -> Bool
    Eq, Int -> ParaProperties -> ShowS
    [ParaProperties] -> ShowS
    ParaProperties -> String
    (Int -> ParaProperties -> ShowS)
    -> (ParaProperties -> String)
    -> ([ParaProperties] -> ShowS)
    -> Show ParaProperties
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ParaProperties -> ShowS
    showsPrec :: Int -> ParaProperties -> ShowS
    $cshow :: ParaProperties -> String
    show :: ParaProperties -> String
    $cshowList :: [ParaProperties] -> ShowS
    showList :: [ParaProperties] -> ShowS
    Show )

    instance Default ParaProperties where
      def :: ParaProperties
    def =                 PropP { paraNumbering :: ParaNumbering
    paraNumbering = ParaNumbering
    NumberingNone
                                  , indentation :: LengthOrPercent
    indentation   = LengthOrPercent
    forall a. Default a => a
    def
                                  , margin_left :: LengthOrPercent
    margin_left   = LengthOrPercent
    forall a. Default a => a
    def
                                  }

    ----
    -- All the little data types that make up the properties
    ----

    data VerticalTextPosition = VPosNormal | VPosSuper | VPosSub
      deriving ( VerticalTextPosition -> VerticalTextPosition -> Bool
    (VerticalTextPosition -> VerticalTextPosition -> Bool)
    -> (VerticalTextPosition -> VerticalTextPosition -> Bool)
    -> Eq VerticalTextPosition
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: VerticalTextPosition -> VerticalTextPosition -> Bool
    == :: VerticalTextPosition -> VerticalTextPosition -> Bool
    $c/= :: VerticalTextPosition -> VerticalTextPosition -> Bool
    /= :: VerticalTextPosition -> VerticalTextPosition -> Bool
    Eq, Int -> VerticalTextPosition -> ShowS
    [VerticalTextPosition] -> ShowS
    VerticalTextPosition -> String
    (Int -> VerticalTextPosition -> ShowS)
    -> (VerticalTextPosition -> String)
    -> ([VerticalTextPosition] -> ShowS)
    -> Show VerticalTextPosition
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> VerticalTextPosition -> ShowS
    showsPrec :: Int -> VerticalTextPosition -> ShowS
    $cshow :: VerticalTextPosition -> String
    show :: VerticalTextPosition -> String
    $cshowList :: [VerticalTextPosition] -> ShowS
    showList :: [VerticalTextPosition] -> ShowS
    Show )

    instance Default VerticalTextPosition where
      def :: VerticalTextPosition
    def = VerticalTextPosition
    VPosNormal

    instance Read VerticalTextPosition where
      readsPrec :: Int -> ReadS VerticalTextPosition
    readsPrec Int
    _ String
    s =    [ (VerticalTextPosition
    VPosSub        , String
    s') | (String
    "sub"   , String
    s') <- [(String, String)]
    lexS          ]
                      [(VerticalTextPosition, String)]
    -> [(VerticalTextPosition, String)]
    -> [(VerticalTextPosition, String)]
    forall a. [a] -> [a] -> [a]
    ++ [ (VerticalTextPosition
    VPosSuper      , String
    s') | (String
    "super" , String
    s') <- [(String, String)]
    lexS          ]
                      [(VerticalTextPosition, String)]
    -> [(VerticalTextPosition, String)]
    -> [(VerticalTextPosition, String)]
    forall a. [a] -> [a] -> [a]
    ++ [ (Int -> VerticalTextPosition
    forall {a}. (Ord a, Num a) => a -> VerticalTextPosition
    signumToVPos Int
    n , String
    s') | (  Int
    n     , String
    s') <- ReadS Int
    readPercent String
    s ]
        where
          lexS :: [(String, String)]
    lexS = ReadS String
    lex String
    s
          signumToVPos :: a -> VerticalTextPosition
    signumToVPos a
    n | a
    n a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    < a
    0     = VerticalTextPosition
    VPosSub
                         | a
    n a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    > a
    0     = VerticalTextPosition
    VPosSuper
                         | Bool
    otherwise = VerticalTextPosition
    VPosNormal

    data UnderlineMode = UnderlineModeNormal | UnderlineModeSkipWhitespace
      deriving ( UnderlineMode -> UnderlineMode -> Bool
    (UnderlineMode -> UnderlineMode -> Bool)
    -> (UnderlineMode -> UnderlineMode -> Bool) -> Eq UnderlineMode
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: UnderlineMode -> UnderlineMode -> Bool
    == :: UnderlineMode -> UnderlineMode -> Bool
    $c/= :: UnderlineMode -> UnderlineMode -> Bool
    /= :: UnderlineMode -> UnderlineMode -> Bool
    Eq, Int -> UnderlineMode -> ShowS
    [UnderlineMode] -> ShowS
    UnderlineMode -> String
    (Int -> UnderlineMode -> ShowS)
    -> (UnderlineMode -> String)
    -> ([UnderlineMode] -> ShowS)
    -> Show UnderlineMode
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> UnderlineMode -> ShowS
    showsPrec :: Int -> UnderlineMode -> ShowS
    $cshow :: UnderlineMode -> String
    show :: UnderlineMode -> String
    $cshowList :: [UnderlineMode] -> ShowS
    showList :: [UnderlineMode] -> ShowS
    Show )

    instance Lookupable UnderlineMode where
      lookupTable :: [(StyleName, UnderlineMode)]
    lookupTable = [ ( StyleName
    "continuous"       , UnderlineMode
    UnderlineModeNormal         )
                    , ( StyleName
    "skip-white-space" , UnderlineMode
    UnderlineModeSkipWhitespace )
                    ]

    data ParaNumbering = NumberingNone | NumberingKeep | NumberingRestart Int
      deriving ( ParaNumbering -> ParaNumbering -> Bool
    (ParaNumbering -> ParaNumbering -> Bool)
    -> (ParaNumbering -> ParaNumbering -> Bool) -> Eq ParaNumbering
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ParaNumbering -> ParaNumbering -> Bool
    == :: ParaNumbering -> ParaNumbering -> Bool
    $c/= :: ParaNumbering -> ParaNumbering -> Bool
    /= :: ParaNumbering -> ParaNumbering -> Bool
    Eq, Int -> ParaNumbering -> ShowS
    [ParaNumbering] -> ShowS
    ParaNumbering -> String
    (Int -> ParaNumbering -> ShowS)
    -> (ParaNumbering -> String)
    -> ([ParaNumbering] -> ShowS)
    -> Show ParaNumbering
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ParaNumbering -> ShowS
    showsPrec :: Int -> ParaNumbering -> ShowS
    $cshow :: ParaNumbering -> String
    show :: ParaNumbering -> String
    $cshowList :: [ParaNumbering] -> ShowS
    showList :: [ParaNumbering] -> ShowS
    Show )

    data LengthOrPercent = LengthValueMM Int | PercentValue Int
      deriving ( LengthOrPercent -> LengthOrPercent -> Bool
    (LengthOrPercent -> LengthOrPercent -> Bool)
    -> (LengthOrPercent -> LengthOrPercent -> Bool)
    -> Eq LengthOrPercent
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: LengthOrPercent -> LengthOrPercent -> Bool
    == :: LengthOrPercent -> LengthOrPercent -> Bool
    $c/= :: LengthOrPercent -> LengthOrPercent -> Bool
    /= :: LengthOrPercent -> LengthOrPercent -> Bool
    Eq, Int -> LengthOrPercent -> ShowS
    [LengthOrPercent] -> ShowS
    LengthOrPercent -> String
    (Int -> LengthOrPercent -> ShowS)
    -> (LengthOrPercent -> String)
    -> ([LengthOrPercent] -> ShowS)
    -> Show LengthOrPercent
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> LengthOrPercent -> ShowS
    showsPrec :: Int -> LengthOrPercent -> ShowS
    $cshow :: LengthOrPercent -> String
    show :: LengthOrPercent -> String
    $cshowList :: [LengthOrPercent] -> ShowS
    showList :: [LengthOrPercent] -> ShowS
    Show )

    instance Default LengthOrPercent where
      def :: LengthOrPercent
    def = Int -> LengthOrPercent
    LengthValueMM Int
    0

    instance Read LengthOrPercent where
      readsPrec :: Int -> ReadS LengthOrPercent
    readsPrec Int
    _ String
    s =
          [ (Int -> LengthOrPercent
    PercentValue  Int
    percent  , String
    s' ) | (Int
    percent , String
    s' ) <- ReadS Int
    readPercent String
    s]
       [(LengthOrPercent, String)]
    -> [(LengthOrPercent, String)] -> [(LengthOrPercent, String)]
    forall a. [a] -> [a] -> [a]
    ++ [ (Int -> LengthOrPercent
    LengthValueMM Int
    lengthMM , String
    s'') | (Double
    length' , String
    s' ) <- ReadS Double
    forall a. Read a => ReadS a
    reads String
    s
                                           , (XslUnit
    unit    , String
    s'') <- ReadS XslUnit
    forall a. Read a => ReadS a
    reads String
    s'
                                           , let lengthMM :: Int
    lengthMM = Double -> XslUnit -> Int
    estimateInMillimeter
                                                                       Double
    length' XslUnit
    unit
                                           ]

    data XslUnit = XslUnitMM | XslUnitCM
                 | XslUnitInch
                 | XslUnitPoints | XslUnitPica
                 | XslUnitPixel
                 | XslUnitEM

    instance Show XslUnit where
      show :: XslUnit -> String
    show XslUnit
    XslUnitMM     = String
    "mm"
      show XslUnit
    XslUnitCM     = String
    "cm"
      show XslUnit
    XslUnitInch   = String
    "in"
      show XslUnit
    XslUnitPoints = String
    "pt"
      show XslUnit
    XslUnitPica   = String
    "pc"
      show XslUnit
    XslUnitPixel  = String
    "px"
      show XslUnit
    XslUnitEM     = String
    "em"

    instance Read XslUnit where
      readsPrec :: Int -> ReadS XslUnit
    readsPrec Int
    _ String
    "mm" = [(XslUnit
    XslUnitMM     , String
    "")]
      readsPrec Int
    _ String
    "cm" = [(XslUnit
    XslUnitCM     , String
    "")]
      readsPrec Int
    _ String
    "in" = [(XslUnit
    XslUnitInch   , String
    "")]
      readsPrec Int
    _ String
    "pt" = [(XslUnit
    XslUnitPoints , String
    "")]
      readsPrec Int
    _ String
    "pc" = [(XslUnit
    XslUnitPica   , String
    "")]
      readsPrec Int
    _ String
    "px" = [(XslUnit
    XslUnitPixel  , String
    "")]
      readsPrec Int
    _ String
    "em" = [(XslUnit
    XslUnitEM     , String
    "")]
      readsPrec Int
    _  String
    _   = []

    -- | 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 :: Double -> XslUnit -> Int
    estimateInMillimeter Double
    n XslUnit
    XslUnitMM     = Double -> Int
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round Double
    n
    estimateInMillimeter Double
    n XslUnit
    XslUnitCM     = Double -> Int
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Double -> Int) -> Double -> Int
    forall a b. (a -> b) -> a -> b
    $ Double
    n Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    10
    estimateInMillimeter Double
    n XslUnit
    XslUnitInch   = Double -> Int
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Double -> Int) -> Double -> Int
    forall a b. (a -> b) -> a -> b
    $ Double
    n Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    25.4
    estimateInMillimeter Double
    n XslUnit
    XslUnitPoints = Double -> Int
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Double -> Int) -> Double -> Int
    forall a b. (a -> b) -> a -> b
    $ Double
    n Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * (Double
    1Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    72) Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    25.4
    estimateInMillimeter Double
    n XslUnit
    XslUnitPica   = Double -> Int
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Double -> Int) -> Double -> Int
    forall a b. (a -> b) -> a -> b
    $ Double
    n Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    12 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * (Double
    1Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    72) Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    25.4
    estimateInMillimeter Double
    n XslUnit
    XslUnitPixel  = Double -> Int
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Double -> Int) -> Double -> Int
    forall a b. (a -> b) -> a -> b
    $ Double
    n Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * (Double
    1Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    72) Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    25.4
    estimateInMillimeter Double
    n XslUnit
    XslUnitEM     = Double -> Int
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    round (Double -> Int) -> Double -> Int
    forall a b. (a -> b) -> a -> b
    $ Double
    n Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    16 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * (Double
    1Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    /Double
    72) Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    25.4

    ----
    -- List styles
    ----

    type ListLevel = Int

    newtype ListStyle = ListStyle { ListStyle -> Map Int ListLevelStyle
    levelStyles :: M.Map ListLevel ListLevelStyle
                                  }
      deriving ( ListStyle -> ListStyle -> Bool
    (ListStyle -> ListStyle -> Bool)
    -> (ListStyle -> ListStyle -> Bool) -> Eq ListStyle
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ListStyle -> ListStyle -> Bool
    == :: ListStyle -> ListStyle -> Bool
    $c/= :: ListStyle -> ListStyle -> Bool
    /= :: ListStyle -> ListStyle -> Bool
    Eq, Int -> ListStyle -> ShowS
    [ListStyle] -> ShowS
    ListStyle -> String
    (Int -> ListStyle -> ShowS)
    -> (ListStyle -> String)
    -> ([ListStyle] -> ShowS)
    -> Show ListStyle
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ListStyle -> ShowS
    showsPrec :: Int -> ListStyle -> ShowS
    $cshow :: ListStyle -> String
    show :: ListStyle -> String
    $cshowList :: [ListStyle] -> ShowS
    showList :: [ListStyle] -> ShowS
    Show )

    --
    getListLevelStyle :: ListLevel -> ListStyle -> Maybe ListLevelStyle
    getListLevelStyle :: Int -> ListStyle -> Maybe ListLevelStyle
    getListLevelStyle Int
    level ListStyle{Map Int ListLevelStyle
    levelStyles :: ListStyle -> Map Int ListLevelStyle
    levelStyles :: Map Int ListLevelStyle
    ..} =
      let (Map Int ListLevelStyle
    lower , Maybe ListLevelStyle
    exactHit , Map Int ListLevelStyle
    _) = Int
    -> Map Int ListLevelStyle
    -> (Map Int ListLevelStyle, Maybe ListLevelStyle,
        Map Int ListLevelStyle)
    forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
    M.splitLookup Int
    level Map Int ListLevelStyle
    levelStyles
      in  Maybe ListLevelStyle
    exactHit Maybe ListLevelStyle
    -> Maybe ListLevelStyle -> Maybe ListLevelStyle
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> ((ListLevelStyle, Map Int ListLevelStyle) -> ListLevelStyle)
    -> Maybe (ListLevelStyle, Map Int ListLevelStyle)
    -> Maybe ListLevelStyle
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (ListLevelStyle, Map Int ListLevelStyle) -> ListLevelStyle
    forall a b. (a, b) -> a
    fst (Map Int ListLevelStyle
    -> Maybe (ListLevelStyle, Map Int ListLevelStyle)
    forall k a. Map k a -> Maybe (a, Map k a)
    M.maxView Map Int ListLevelStyle
    lower)
      -- findBy (`M.lookup` levelStyles) [level, (level-1) .. 1]
      -- \^ simpler, but in general less efficient

    data ListLevelStyle = ListLevelStyle { ListLevelStyle -> ListLevelType
    listLevelType  :: ListLevelType
                                         , ListLevelStyle -> Maybe StyleName
    listItemPrefix :: Maybe Text
                                         , ListLevelStyle -> Maybe StyleName
    listItemSuffix :: Maybe Text
                                         , ListLevelStyle -> ListItemNumberFormat
    listItemFormat :: ListItemNumberFormat
                                         , ListLevelStyle -> Int
    listItemStart  :: Int
                                         }
      deriving ( ListLevelStyle -> ListLevelStyle -> Bool
    (ListLevelStyle -> ListLevelStyle -> Bool)
    -> (ListLevelStyle -> ListLevelStyle -> Bool) -> Eq ListLevelStyle
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ListLevelStyle -> ListLevelStyle -> Bool
    == :: ListLevelStyle -> ListLevelStyle -> Bool
    $c/= :: ListLevelStyle -> ListLevelStyle -> Bool
    /= :: ListLevelStyle -> ListLevelStyle -> Bool
    Eq, Eq ListLevelStyle
    Eq ListLevelStyle =>
    (ListLevelStyle -> ListLevelStyle -> Ordering)
    -> (ListLevelStyle -> ListLevelStyle -> Bool)
    -> (ListLevelStyle -> ListLevelStyle -> Bool)
    -> (ListLevelStyle -> ListLevelStyle -> Bool)
    -> (ListLevelStyle -> ListLevelStyle -> Bool)
    -> (ListLevelStyle -> ListLevelStyle -> ListLevelStyle)
    -> (ListLevelStyle -> ListLevelStyle -> ListLevelStyle)
    -> Ord ListLevelStyle
    ListLevelStyle -> ListLevelStyle -> Bool
    ListLevelStyle -> ListLevelStyle -> Ordering
    ListLevelStyle -> ListLevelStyle -> ListLevelStyle
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: ListLevelStyle -> ListLevelStyle -> Ordering
    compare :: ListLevelStyle -> ListLevelStyle -> Ordering
    $c< :: ListLevelStyle -> ListLevelStyle -> Bool
    < :: ListLevelStyle -> ListLevelStyle -> Bool
    $c<= :: ListLevelStyle -> ListLevelStyle -> Bool
    <= :: ListLevelStyle -> ListLevelStyle -> Bool
    $c> :: ListLevelStyle -> ListLevelStyle -> Bool
    > :: ListLevelStyle -> ListLevelStyle -> Bool
    $c>= :: ListLevelStyle -> ListLevelStyle -> Bool
    >= :: ListLevelStyle -> ListLevelStyle -> Bool
    $cmax :: ListLevelStyle -> ListLevelStyle -> ListLevelStyle
    max :: ListLevelStyle -> ListLevelStyle -> ListLevelStyle
    $cmin :: ListLevelStyle -> ListLevelStyle -> ListLevelStyle
    min :: ListLevelStyle -> ListLevelStyle -> ListLevelStyle
    Ord )

    instance Show ListLevelStyle where
      show :: ListLevelStyle -> String
    show ListLevelStyle{Int
    Maybe StyleName
    ListItemNumberFormat
    ListLevelType
    listLevelType :: ListLevelStyle -> ListLevelType
    listItemPrefix :: ListLevelStyle -> Maybe StyleName
    listItemSuffix :: ListLevelStyle -> Maybe StyleName
    listItemFormat :: ListLevelStyle -> ListItemNumberFormat
    listItemStart :: ListLevelStyle -> Int
    listLevelType :: ListLevelType
    listItemPrefix :: Maybe StyleName
    listItemSuffix :: Maybe StyleName
    listItemFormat :: ListItemNumberFormat
    listItemStart :: Int
    ..} =    String
    "<LLS|"
                                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ListLevelType -> String
    forall a. Show a => a -> String
    show ListLevelType
    listLevelType
                                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "|"
                                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Maybe String -> String
    maybeToString (StyleName -> String
    T.unpack (StyleName -> String) -> Maybe StyleName -> Maybe String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe StyleName
    listItemPrefix)
                                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ListItemNumberFormat -> String
    forall a. Show a => a -> String
    show ListItemNumberFormat
    listItemFormat
                                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Maybe String -> String
    maybeToString (StyleName -> String
    T.unpack (StyleName -> String) -> Maybe StyleName -> Maybe String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe StyleName
    listItemSuffix)
                                String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ">"
        where maybeToString :: Maybe String -> String
    maybeToString = String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    ""

    data ListLevelType = LltBullet | LltImage | LltNumbered
      deriving ( ListLevelType -> ListLevelType -> Bool
    (ListLevelType -> ListLevelType -> Bool)
    -> (ListLevelType -> ListLevelType -> Bool) -> Eq ListLevelType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ListLevelType -> ListLevelType -> Bool
    == :: ListLevelType -> ListLevelType -> Bool
    $c/= :: ListLevelType -> ListLevelType -> Bool
    /= :: ListLevelType -> ListLevelType -> Bool
    Eq, Eq ListLevelType
    Eq ListLevelType =>
    (ListLevelType -> ListLevelType -> Ordering)
    -> (ListLevelType -> ListLevelType -> Bool)
    -> (ListLevelType -> ListLevelType -> Bool)
    -> (ListLevelType -> ListLevelType -> Bool)
    -> (ListLevelType -> ListLevelType -> Bool)
    -> (ListLevelType -> ListLevelType -> ListLevelType)
    -> (ListLevelType -> ListLevelType -> ListLevelType)
    -> Ord ListLevelType
    ListLevelType -> ListLevelType -> Bool
    ListLevelType -> ListLevelType -> Ordering
    ListLevelType -> ListLevelType -> ListLevelType
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: ListLevelType -> ListLevelType -> Ordering
    compare :: ListLevelType -> ListLevelType -> Ordering
    $c< :: ListLevelType -> ListLevelType -> Bool
    < :: ListLevelType -> ListLevelType -> Bool
    $c<= :: ListLevelType -> ListLevelType -> Bool
    <= :: ListLevelType -> ListLevelType -> Bool
    $c> :: ListLevelType -> ListLevelType -> Bool
    > :: ListLevelType -> ListLevelType -> Bool
    $c>= :: ListLevelType -> ListLevelType -> Bool
    >= :: ListLevelType -> ListLevelType -> Bool
    $cmax :: ListLevelType -> ListLevelType -> ListLevelType
    max :: ListLevelType -> ListLevelType -> ListLevelType
    $cmin :: ListLevelType -> ListLevelType -> ListLevelType
    min :: ListLevelType -> ListLevelType -> ListLevelType
    Ord, Int -> ListLevelType -> ShowS
    [ListLevelType] -> ShowS
    ListLevelType -> String
    (Int -> ListLevelType -> ShowS)
    -> (ListLevelType -> String)
    -> ([ListLevelType] -> ShowS)
    -> Show ListLevelType
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ListLevelType -> ShowS
    showsPrec :: Int -> ListLevelType -> ShowS
    $cshow :: ListLevelType -> String
    show :: ListLevelType -> String
    $cshowList :: [ListLevelType] -> ShowS
    showList :: [ListLevelType] -> ShowS
    Show )

    data ListItemNumberFormat = LinfNone
                              | LinfNumber
                              | LinfRomanLC | LinfRomanUC
                              | LinfAlphaLC | LinfAlphaUC
                              | LinfString String
      deriving ( ListItemNumberFormat -> ListItemNumberFormat -> Bool
    (ListItemNumberFormat -> ListItemNumberFormat -> Bool)
    -> (ListItemNumberFormat -> ListItemNumberFormat -> Bool)
    -> Eq ListItemNumberFormat
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ListItemNumberFormat -> ListItemNumberFormat -> Bool
    == :: ListItemNumberFormat -> ListItemNumberFormat -> Bool
    $c/= :: ListItemNumberFormat -> ListItemNumberFormat -> Bool
    /= :: ListItemNumberFormat -> ListItemNumberFormat -> Bool
    Eq, Eq ListItemNumberFormat
    Eq ListItemNumberFormat =>
    (ListItemNumberFormat -> ListItemNumberFormat -> Ordering)
    -> (ListItemNumberFormat -> ListItemNumberFormat -> Bool)
    -> (ListItemNumberFormat -> ListItemNumberFormat -> Bool)
    -> (ListItemNumberFormat -> ListItemNumberFormat -> Bool)
    -> (ListItemNumberFormat -> ListItemNumberFormat -> Bool)
    -> (ListItemNumberFormat
        -> ListItemNumberFormat -> ListItemNumberFormat)
    -> (ListItemNumberFormat
        -> ListItemNumberFormat -> ListItemNumberFormat)
    -> Ord ListItemNumberFormat
    ListItemNumberFormat -> ListItemNumberFormat -> Bool
    ListItemNumberFormat -> ListItemNumberFormat -> Ordering
    ListItemNumberFormat
    -> ListItemNumberFormat -> ListItemNumberFormat
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: ListItemNumberFormat -> ListItemNumberFormat -> Ordering
    compare :: ListItemNumberFormat -> ListItemNumberFormat -> Ordering
    $c< :: ListItemNumberFormat -> ListItemNumberFormat -> Bool
    < :: ListItemNumberFormat -> ListItemNumberFormat -> Bool
    $c<= :: ListItemNumberFormat -> ListItemNumberFormat -> Bool
    <= :: ListItemNumberFormat -> ListItemNumberFormat -> Bool
    $c> :: ListItemNumberFormat -> ListItemNumberFormat -> Bool
    > :: ListItemNumberFormat -> ListItemNumberFormat -> Bool
    $c>= :: ListItemNumberFormat -> ListItemNumberFormat -> Bool
    >= :: ListItemNumberFormat -> ListItemNumberFormat -> Bool
    $cmax :: ListItemNumberFormat
    -> ListItemNumberFormat -> ListItemNumberFormat
    max :: ListItemNumberFormat
    -> ListItemNumberFormat -> ListItemNumberFormat
    $cmin :: ListItemNumberFormat
    -> ListItemNumberFormat -> ListItemNumberFormat
    min :: ListItemNumberFormat
    -> ListItemNumberFormat -> ListItemNumberFormat
    Ord )

    instance Show ListItemNumberFormat where
      show :: ListItemNumberFormat -> String
    show  ListItemNumberFormat
    LinfNone      = String
    ""
      show  ListItemNumberFormat
    LinfNumber    = String
    "1"
      show  ListItemNumberFormat
    LinfRomanLC   = String
    "i"
      show  ListItemNumberFormat
    LinfRomanUC   = String
    "I"
      show  ListItemNumberFormat
    LinfAlphaLC   = String
    "a"
      show  ListItemNumberFormat
    LinfAlphaUC   = String
    "A"
      show (LinfString String
    s) =  String
    s

    instance Default ListItemNumberFormat where
      def :: ListItemNumberFormat
    def = ListItemNumberFormat
    LinfNone

    instance Read ListItemNumberFormat where
      readsPrec :: Int -> ReadS ListItemNumberFormat
    readsPrec Int
    _ String
    ""  = [(ListItemNumberFormat
    LinfNone     , String
    "")]
      readsPrec Int
    _ String
    "1" = [(ListItemNumberFormat
    LinfNumber   , String
    "")]
      readsPrec Int
    _ String
    "i" = [(ListItemNumberFormat
    LinfRomanLC  , String
    "")]
      readsPrec Int
    _ String
    "I" = [(ListItemNumberFormat
    LinfRomanUC  , String
    "")]
      readsPrec Int
    _ String
    "a" = [(ListItemNumberFormat
    LinfAlphaLC  , String
    "")]
      readsPrec Int
    _ String
    "A" = [(ListItemNumberFormat
    LinfAlphaUC  , String
    "")]
      readsPrec Int
    _  String
    s  = [(String -> ListItemNumberFormat
    LinfString String
    s , String
    "")]

    --------------------------------------------------------------------------------
    -- 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 a Styles
    readAllStyles :: forall a. StyleReader a Styles
    readAllStyles = (      StyleReader a a
    forall a. StyleReader a a
    readFontPitches
                      StyleReader a a
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         a
         (Fallible Styles, Fallible Styles)
    -> FallibleArrow
         (ArrowState (XMLConverterState Namespace FontPitches))
         a
         ()
         (Fallible Styles, Fallible Styles)
    forall (a :: * -> * -> *) x failure success success'.
    ArrowChoice a =>
    FallibleArrow a x failure success
    -> a success success' -> FallibleArrow a x failure success'
    >>?! (     StyleReader a Styles
    forall a. StyleReader a Styles
    readAutomaticStyles
                             StyleReader a Styles
    -> StyleReader a Styles
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         a
         (Fallible Styles, Fallible Styles)
    forall b c c'.
    ArrowState (XMLConverterState Namespace FontPitches) b c
    -> ArrowState (XMLConverterState Namespace FontPitches) b c'
    -> ArrowState (XMLConverterState Namespace FontPitches) b (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& StyleReader a Styles
    forall a. StyleReader a Styles
    readStyles ))
                      FallibleArrow
      (ArrowState (XMLConverterState Namespace FontPitches))
      a
      ()
      (Fallible Styles, Fallible Styles)
    -> (Fallible Styles -> Fallible Styles -> Fallible Styles)
    -> StyleReader a Styles
    forall (a :: * -> * -> *) x f b b' c.
    ArrowChoice a =>
    FallibleArrow a x f (b, b')
    -> (b -> b' -> Either f c) -> FallibleArrow a x f c
    >>?%? Fallible Styles -> Fallible Styles -> Fallible Styles
    forall a b.
    (Monoid a, Monoid b) =>
    Either a b -> Either a b -> Either a b
    chooseMax
     -- all top elements are always on the same hierarchy level

    --
    readStyles :: StyleReader a Styles
    readStyles :: forall a. StyleReader a Styles
    readStyles = Namespace
    -> StyleName
    -> FallibleXMLConverter Namespace FontPitches a Styles
    -> FallibleXMLConverter Namespace FontPitches a Styles
    forall nsID extraState f s.
    NameSpaceID nsID =>
    nsID
    -> StyleName
    -> FallibleXMLConverter nsID extraState f s
    -> FallibleXMLConverter nsID extraState f s
    executeInSub Namespace
    NsOffice StyleName
    "styles" (FallibleXMLConverter Namespace FontPitches a Styles
     -> FallibleXMLConverter Namespace FontPitches a Styles)
    -> FallibleXMLConverter Namespace FontPitches a Styles
    -> FallibleXMLConverter Namespace FontPitches a Styles
    forall a b. (a -> b) -> a -> b
    $ ArrowState (XMLConverterState Namespace FontPitches) a Styles
    -> FallibleXMLConverter Namespace FontPitches a Styles
    forall (a :: * -> * -> *) x success failure.
    ArrowChoice a =>
    a x success -> FallibleArrow a x failure success
    liftAsSuccess
      (ArrowState (XMLConverterState Namespace FontPitches) a Styles
     -> FallibleXMLConverter Namespace FontPitches a Styles)
    -> ArrowState (XMLConverterState Namespace FontPitches) a Styles
    -> FallibleXMLConverter Namespace FontPitches a Styles
    forall a b. (a -> b) -> a -> b
    $ (Map StyleName Style
     -> Map StyleName ListStyle
     -> Map StyleFamily StyleProperties
     -> Styles)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a (Map StyleName Style)
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         a
         (Map StyleName ListStyle)
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         a
         (Map StyleFamily StyleProperties)
    -> ArrowState (XMLConverterState Namespace FontPitches) a Styles
    forall (a :: * -> * -> *) z y x r b.
    Arrow a =>
    (z -> y -> x -> r) -> a b z -> a b y -> a b x -> a b r
    liftA3 Map StyleName Style
    -> Map StyleName ListStyle
    -> Map StyleFamily StyleProperties
    -> Styles
    Styles
        ( Namespace
    -> StyleName
    -> FallibleXMLConverter Namespace FontPitches a (StyleName, Style)
    -> XMLConverter Namespace FontPitches a [(StyleName, Style)]
    forall nsID extraState b a.
    NameSpaceID nsID =>
    nsID
    -> StyleName
    -> FallibleXMLConverter nsID extraState b a
    -> XMLConverter nsID extraState b [a]
    tryAll Namespace
    NsStyle StyleName
    "style"         FallibleXMLConverter Namespace FontPitches a (StyleName, Style)
    forall a. StyleReader a (StyleName, Style)
    readStyle        XMLConverter Namespace FontPitches a [(StyleName, Style)]
    -> ([(StyleName, Style)] -> Map StyleName Style)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a (Map StyleName Style)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> (c -> d) -> a b d
    >>^ [(StyleName, Style)] -> Map StyleName Style
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList )
        ( Namespace
    -> StyleName
    -> FallibleXMLConverter
         Namespace FontPitches a (StyleName, ListStyle)
    -> XMLConverter Namespace FontPitches a [(StyleName, ListStyle)]
    forall nsID extraState b a.
    NameSpaceID nsID =>
    nsID
    -> StyleName
    -> FallibleXMLConverter nsID extraState b a
    -> XMLConverter nsID extraState b [a]
    tryAll Namespace
    NsText  StyleName
    "list-style"    FallibleXMLConverter Namespace FontPitches a (StyleName, ListStyle)
    forall a. StyleReader a (StyleName, ListStyle)
    readListStyle    XMLConverter Namespace FontPitches a [(StyleName, ListStyle)]
    -> ([(StyleName, ListStyle)] -> Map StyleName ListStyle)
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         a
         (Map StyleName ListStyle)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> (c -> d) -> a b d
    >>^ [(StyleName, ListStyle)] -> Map StyleName ListStyle
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList )
        ( Namespace
    -> StyleName
    -> FallibleXMLConverter
         Namespace FontPitches a (StyleFamily, StyleProperties)
    -> XMLConverter
         Namespace FontPitches a [(StyleFamily, StyleProperties)]
    forall nsID extraState b a.
    NameSpaceID nsID =>
    nsID
    -> StyleName
    -> FallibleXMLConverter nsID extraState b a
    -> XMLConverter nsID extraState b [a]
    tryAll Namespace
    NsStyle StyleName
    "default-style" FallibleXMLConverter
      Namespace FontPitches a (StyleFamily, StyleProperties)
    forall a. StyleReader a (StyleFamily, StyleProperties)
    readDefaultStyle XMLConverter
      Namespace FontPitches a [(StyleFamily, StyleProperties)]
    -> ([(StyleFamily, StyleProperties)]
        -> Map StyleFamily StyleProperties)
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         a
         (Map StyleFamily StyleProperties)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> (c -> d) -> a b d
    >>^ [(StyleFamily, StyleProperties)] -> Map StyleFamily StyleProperties
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList )

    --
    readAutomaticStyles :: StyleReader a Styles
    readAutomaticStyles :: forall a. StyleReader a Styles
    readAutomaticStyles = Namespace
    -> StyleName
    -> FallibleXMLConverter Namespace FontPitches a Styles
    -> FallibleXMLConverter Namespace FontPitches a Styles
    forall nsID extraState f s.
    NameSpaceID nsID =>
    nsID
    -> StyleName
    -> FallibleXMLConverter nsID extraState f s
    -> FallibleXMLConverter nsID extraState f s
    executeInSub Namespace
    NsOffice StyleName
    "automatic-styles" (FallibleXMLConverter Namespace FontPitches a Styles
     -> FallibleXMLConverter Namespace FontPitches a Styles)
    -> FallibleXMLConverter Namespace FontPitches a Styles
    -> FallibleXMLConverter Namespace FontPitches a Styles
    forall a b. (a -> b) -> a -> b
    $ ArrowState (XMLConverterState Namespace FontPitches) a Styles
    -> FallibleXMLConverter Namespace FontPitches a Styles
    forall (a :: * -> * -> *) x success failure.
    ArrowChoice a =>
    a x success -> FallibleArrow a x failure success
    liftAsSuccess
      (ArrowState (XMLConverterState Namespace FontPitches) a Styles
     -> FallibleXMLConverter Namespace FontPitches a Styles)
    -> ArrowState (XMLConverterState Namespace FontPitches) a Styles
    -> FallibleXMLConverter Namespace FontPitches a Styles
    forall a b. (a -> b) -> a -> b
    $ (Map StyleName Style
     -> Map StyleName ListStyle
     -> Map StyleFamily StyleProperties
     -> Styles)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a (Map StyleName Style)
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         a
         (Map StyleName ListStyle)
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         a
         (Map StyleFamily StyleProperties)
    -> ArrowState (XMLConverterState Namespace FontPitches) a Styles
    forall (a :: * -> * -> *) z y x r b.
    Arrow a =>
    (z -> y -> x -> r) -> a b z -> a b y -> a b x -> a b r
    liftA3 Map StyleName Style
    -> Map StyleName ListStyle
    -> Map StyleFamily StyleProperties
    -> Styles
    Styles
        ( Namespace
    -> StyleName
    -> FallibleXMLConverter Namespace FontPitches a (StyleName, Style)
    -> XMLConverter Namespace FontPitches a [(StyleName, Style)]
    forall nsID extraState b a.
    NameSpaceID nsID =>
    nsID
    -> StyleName
    -> FallibleXMLConverter nsID extraState b a
    -> XMLConverter nsID extraState b [a]
    tryAll Namespace
    NsStyle StyleName
    "style"         FallibleXMLConverter Namespace FontPitches a (StyleName, Style)
    forall a. StyleReader a (StyleName, Style)
    readStyle        XMLConverter Namespace FontPitches a [(StyleName, Style)]
    -> ([(StyleName, Style)] -> Map StyleName Style)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a (Map StyleName Style)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> (c -> d) -> a b d
    >>^ [(StyleName, Style)] -> Map StyleName Style
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList )
        ( Namespace
    -> StyleName
    -> FallibleXMLConverter
         Namespace FontPitches a (StyleName, ListStyle)
    -> XMLConverter Namespace FontPitches a [(StyleName, ListStyle)]
    forall nsID extraState b a.
    NameSpaceID nsID =>
    nsID
    -> StyleName
    -> FallibleXMLConverter nsID extraState b a
    -> XMLConverter nsID extraState b [a]
    tryAll Namespace
    NsText  StyleName
    "list-style"    FallibleXMLConverter Namespace FontPitches a (StyleName, ListStyle)
    forall a. StyleReader a (StyleName, ListStyle)
    readListStyle    XMLConverter Namespace FontPitches a [(StyleName, ListStyle)]
    -> ([(StyleName, ListStyle)] -> Map StyleName ListStyle)
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         a
         (Map StyleName ListStyle)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> (c -> d) -> a b d
    >>^ [(StyleName, ListStyle)] -> Map StyleName ListStyle
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList )
        ( Map StyleFamily StyleProperties
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         a
         (Map StyleFamily StyleProperties)
    forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
    returnV Map StyleFamily StyleProperties
    forall k a. Map k a
    M.empty                                                )

    --
    readDefaultStyle :: StyleReader a (StyleFamily, StyleProperties)
    readDefaultStyle :: forall a. StyleReader a (StyleFamily, StyleProperties)
    readDefaultStyle =      Namespace
    -> StyleName
    -> FallibleXMLConverter Namespace FontPitches a StyleFamily
    forall nsID a extraState x.
    (NameSpaceID nsID, Lookupable a) =>
    nsID -> StyleName -> FallibleXMLConverter nsID extraState x a
    lookupAttr Namespace
    NsStyle StyleName
    "family"
                       FallibleXMLConverter Namespace FontPitches a StyleFamily
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleFamily
         (StyleFamily, StyleProperties)
    -> FallibleArrow
         (ArrowState (XMLConverterState Namespace FontPitches))
         a
         ()
         (StyleFamily, StyleProperties)
    forall (a :: * -> * -> *) x failure success success'.
    ArrowChoice a =>
    FallibleArrow a x failure success
    -> a success success' -> FallibleArrow a x failure success'
    >>?! ArrowState
      (XMLConverterState Namespace FontPitches)
      StyleFamily
      StyleProperties
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleFamily
         (StyleFamily, StyleProperties)
    forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
    keepingTheValue ArrowState
      (XMLConverterState Namespace FontPitches)
      StyleFamily
      StyleProperties
    forall a. StyleReaderSafe a StyleProperties
    readStyleProperties

    --
    readStyle :: StyleReader a (StyleName,Style)
    readStyle :: forall a. StyleReader a (StyleName, Style)
    readStyle =      Namespace
    -> StyleName
    -> FallibleXMLConverter Namespace FontPitches a StyleName
    forall nsID extraState x.
    NameSpaceID nsID =>
    nsID
    -> StyleName -> FallibleXMLConverter nsID extraState x StyleName
    findAttr Namespace
    NsStyle StyleName
    "name"
                FallibleXMLConverter Namespace FontPitches a StyleName
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (StyleName, Style)
    -> FallibleArrow
         (ArrowState (XMLConverterState Namespace FontPitches))
         a
         ()
         (StyleName, Style)
    forall (a :: * -> * -> *) x failure success success'.
    ArrowChoice a =>
    FallibleArrow a x failure success
    -> a success success' -> FallibleArrow a x failure success'
    >>?! ArrowState
      (XMLConverterState Namespace FontPitches) StyleName Style
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (StyleName, Style)
    forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
    keepingTheValue
                       ( (Maybe StyleFamily
     -> Maybe StyleName -> Maybe StyleName -> StyleProperties -> Style)
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (Maybe StyleFamily)
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (Maybe StyleName)
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (Maybe StyleName)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) StyleName StyleProperties
    -> ArrowState
         (XMLConverterState Namespace FontPitches) StyleName Style
    forall (a :: * -> * -> *) z y x w r b.
    Arrow a =>
    (z -> y -> x -> w -> r)
    -> a b z -> a b y -> a b x -> a b w -> a b r
    liftA4 Maybe StyleFamily
    -> Maybe StyleName -> Maybe StyleName -> StyleProperties -> Style
    Style
                           ( Namespace
    -> StyleName
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (Maybe StyleFamily)
    forall nsID a extraState x.
    (NameSpaceID nsID, Lookupable a) =>
    nsID -> StyleName -> XMLConverter nsID extraState x (Maybe a)
    lookupAttr' Namespace
    NsStyle StyleName
    "family"            )
                           ( Namespace
    -> StyleName
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (Maybe StyleName)
    forall nsID extraState x.
    NameSpaceID nsID =>
    nsID
    -> StyleName -> XMLConverter nsID extraState x (Maybe StyleName)
    findAttr'   Namespace
    NsStyle StyleName
    "parent-style-name" )
                           ( Namespace
    -> StyleName
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (Maybe StyleName)
    forall nsID extraState x.
    NameSpaceID nsID =>
    nsID
    -> StyleName -> XMLConverter nsID extraState x (Maybe StyleName)
    findAttr'   Namespace
    NsStyle StyleName
    "list-style-name"   )
                           ArrowState
      (XMLConverterState Namespace FontPitches) StyleName StyleProperties
    forall a. StyleReaderSafe a StyleProperties
    readStyleProperties
                       )

    --
    readStyleProperties :: StyleReaderSafe a StyleProperties
    readStyleProperties :: forall a. StyleReaderSafe a StyleProperties
    readStyleProperties = (Maybe TextProperties -> Maybe ParaProperties -> StyleProperties)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a (Maybe TextProperties)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a (Maybe ParaProperties)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a StyleProperties
    forall (a :: * -> * -> *) x y z b.
    Arrow a =>
    (x -> y -> z) -> a b x -> a b y -> a b z
    liftA2 Maybe TextProperties -> Maybe ParaProperties -> StyleProperties
    SProps
                           ( StyleReader a TextProperties
    forall a. StyleReader a TextProperties
    readTextProperties StyleReader a TextProperties
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         (Fallible TextProperties)
         (Maybe TextProperties)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a (Maybe TextProperties)
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> ArrowState
      (XMLConverterState Namespace FontPitches)
      (Fallible TextProperties)
      (Maybe TextProperties)
    forall (a :: * -> * -> *) l r.
    ArrowChoice a =>
    a (Either l r) (Maybe r)
    choiceToMaybe )
                           ( StyleReader a ParaProperties
    forall a. StyleReader a ParaProperties
    readParaProperties StyleReader a ParaProperties
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         (Fallible ParaProperties)
         (Maybe ParaProperties)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a (Maybe ParaProperties)
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> ArrowState
      (XMLConverterState Namespace FontPitches)
      (Fallible ParaProperties)
      (Maybe ParaProperties)
    forall (a :: * -> * -> *) l r.
    ArrowChoice a =>
    a (Either l r) (Maybe r)
    choiceToMaybe )

    --
    readTextProperties :: StyleReader a TextProperties
    readTextProperties :: forall a. StyleReader a TextProperties
    readTextProperties =
      Namespace
    -> StyleName
    -> FallibleXMLConverter Namespace FontPitches a TextProperties
    -> FallibleXMLConverter Namespace FontPitches a TextProperties
    forall nsID extraState f s.
    NameSpaceID nsID =>
    nsID
    -> StyleName
    -> FallibleXMLConverter nsID extraState f s
    -> FallibleXMLConverter nsID extraState f s
    executeInSub Namespace
    NsStyle StyleName
    "text-properties" (FallibleXMLConverter Namespace FontPitches a TextProperties
     -> FallibleXMLConverter Namespace FontPitches a TextProperties)
    -> FallibleXMLConverter Namespace FontPitches a TextProperties
    -> FallibleXMLConverter Namespace FontPitches a TextProperties
    forall a b. (a -> b) -> a -> b
    $ ArrowState
      (XMLConverterState Namespace FontPitches) a TextProperties
    -> FallibleXMLConverter Namespace FontPitches a TextProperties
    forall (a :: * -> * -> *) x success failure.
    ArrowChoice a =>
    a x success -> FallibleArrow a x failure success
    liftAsSuccess
        ( (Bool
     -> Bool
     -> Maybe FontPitch
     -> VerticalTextPosition
     -> Maybe UnderlineMode
     -> Maybe UnderlineMode
     -> TextProperties)
    -> ArrowState (XMLConverterState Namespace FontPitches) a Bool
    -> ArrowState (XMLConverterState Namespace FontPitches) a Bool
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a (Maybe FontPitch)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a VerticalTextPosition
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a (Maybe UnderlineMode)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a (Maybe UnderlineMode)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a TextProperties
    forall (a :: * -> * -> *) z y x w v u r b.
    Arrow a =>
    (z -> y -> x -> w -> v -> u -> r)
    -> a b z -> a b y -> a b x -> a b w -> a b v -> a b u -> a b r
    liftA6 Bool
    -> Bool
    -> Maybe FontPitch
    -> VerticalTextPosition
    -> Maybe UnderlineMode
    -> Maybe UnderlineMode
    -> TextProperties
    PropT
           ( Namespace
    -> StyleName
    -> Bool
    -> [(StyleName, Bool)]
    -> ArrowState (XMLConverterState Namespace FontPitches) a Bool
    forall nsID a extraState x.
    NameSpaceID nsID =>
    nsID
    -> StyleName
    -> a
    -> [(StyleName, a)]
    -> XMLConverter nsID extraState x a
    searchAttr   Namespace
    NsXSL_FO StyleName
    "font-style"  Bool
    False [(StyleName, Bool)]
    isFontEmphasised )
           ( Namespace
    -> StyleName
    -> Bool
    -> [(StyleName, Bool)]
    -> ArrowState (XMLConverterState Namespace FontPitches) a Bool
    forall nsID a extraState x.
    NameSpaceID nsID =>
    nsID
    -> StyleName
    -> a
    -> [(StyleName, a)]
    -> XMLConverter nsID extraState x a
    searchAttr   Namespace
    NsXSL_FO StyleName
    "font-weight" Bool
    False [(StyleName, Bool)]
    isFontBold       )
           ArrowState
      (XMLConverterState Namespace FontPitches) a (Maybe FontPitch)
    forall a. XMLReaderSafe FontPitches a (Maybe FontPitch)
    findPitch
           ( Namespace
    -> StyleName
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a VerticalTextPosition
    forall nsID attrValue extraState x.
    (NameSpaceID nsID, Read attrValue, Default attrValue) =>
    nsID -> StyleName -> XMLConverter nsID extraState x attrValue
    getAttr      Namespace
    NsStyle  StyleName
    "text-position"                      )
           ArrowState
      (XMLConverterState Namespace FontPitches) a (Maybe UnderlineMode)
    forall a. StyleReaderSafe a (Maybe UnderlineMode)
    readUnderlineMode
           ArrowState
      (XMLConverterState Namespace FontPitches) a (Maybe UnderlineMode)
    forall a. StyleReaderSafe a (Maybe UnderlineMode)
    readStrikeThroughMode
         )
      where isFontEmphasised :: [(StyleName, Bool)]
    isFontEmphasised = [(StyleName
    "normal",Bool
    False),(StyleName
    "italic",Bool
    True),(StyleName
    "oblique",Bool
    True)]
            isFontBold :: [(StyleName, Bool)]
    isFontBold = (StyleName
    "normal",Bool
    False)(StyleName, Bool) -> [(StyleName, Bool)] -> [(StyleName, Bool)]
    forall a. a -> [a] -> [a]
    :(StyleName
    "bold",Bool
    True)
                        (StyleName, Bool) -> [(StyleName, Bool)] -> [(StyleName, Bool)]
    forall a. a -> [a] -> [a]
    :(Int -> (StyleName, Bool)) -> [Int] -> [(StyleName, Bool)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((,Bool
    True) (StyleName -> (StyleName, Bool))
    -> (Int -> StyleName) -> Int -> (StyleName, Bool)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> StyleName
    forall a. Show a => a -> StyleName
    tshow) ([Int
    100,Int
    200..Int
    900]::[Int])

    readUnderlineMode     :: StyleReaderSafe a (Maybe UnderlineMode)
    readUnderlineMode :: forall a. StyleReaderSafe a (Maybe UnderlineMode)
    readUnderlineMode     = StyleName -> StyleName -> StyleReaderSafe a (Maybe UnderlineMode)
    forall a.
    StyleName -> StyleName -> StyleReaderSafe a (Maybe UnderlineMode)
    readLineMode StyleName
    "text-underline-mode"
                                         StyleName
    "text-underline-style"

    readStrikeThroughMode :: StyleReaderSafe a (Maybe UnderlineMode)
    readStrikeThroughMode :: forall a. StyleReaderSafe a (Maybe UnderlineMode)
    readStrikeThroughMode = StyleName -> StyleName -> StyleReaderSafe a (Maybe UnderlineMode)
    forall a.
    StyleName -> StyleName -> StyleReaderSafe a (Maybe UnderlineMode)
    readLineMode StyleName
    "text-line-through-mode"
                                         StyleName
    "text-line-through-style"

    readLineMode :: Text -> Text -> StyleReaderSafe a (Maybe UnderlineMode)
    readLineMode :: forall a.
    StyleName -> StyleName -> StyleReaderSafe a (Maybe UnderlineMode)
    readLineMode StyleName
    modeAttr StyleName
    styleAttr = proc a
    x -> do
      Bool
    isUL <- Namespace
    -> StyleName
    -> Bool
    -> [(StyleName, Bool)]
    -> XMLConverter Namespace FontPitches a Bool
    forall nsID a extraState x.
    NameSpaceID nsID =>
    nsID
    -> StyleName
    -> a
    -> [(StyleName, a)]
    -> XMLConverter nsID extraState x a
    searchAttr  Namespace
    NsStyle StyleName
    styleAttr Bool
    False [(StyleName, Bool)]
    isLinePresent -< a
    x
      Maybe UnderlineMode
    mode <- Namespace
    -> StyleName
    -> XMLConverter Namespace FontPitches a (Maybe UnderlineMode)
    forall nsID a extraState x.
    (NameSpaceID nsID, Lookupable a) =>
    nsID -> StyleName -> XMLConverter nsID extraState x (Maybe a)
    lookupAttr' Namespace
    NsStyle  StyleName
    modeAttr                     -< a
    x
      if Bool
    isUL
        then case Maybe UnderlineMode
    mode of
               Just UnderlineMode
    m  -> ArrowState
      (XMLConverterState Namespace FontPitches)
      (Maybe UnderlineMode)
      (Maybe UnderlineMode)
    forall (a :: * -> * -> *) b. Arrow a => a b b
    returnA -< UnderlineMode -> Maybe UnderlineMode
    forall a. a -> Maybe a
    Just UnderlineMode
    m
               Maybe UnderlineMode
    Nothing -> ArrowState
      (XMLConverterState Namespace FontPitches)
      (Maybe UnderlineMode)
      (Maybe UnderlineMode)
    forall (a :: * -> * -> *) b. Arrow a => a b b
    returnA -< UnderlineMode -> Maybe UnderlineMode
    forall a. a -> Maybe a
    Just UnderlineMode
    UnderlineModeNormal
        else              ArrowState
      (XMLConverterState Namespace FontPitches)
      (Maybe UnderlineMode)
      (Maybe UnderlineMode)
    forall (a :: * -> * -> *) b. Arrow a => a b b
    returnA -< Maybe UnderlineMode
    forall a. Maybe a
    Nothing
      where
        isLinePresent :: [(StyleName, Bool)]
    isLinePresent = (StyleName
    "none",Bool
    False) (StyleName, Bool) -> [(StyleName, Bool)] -> [(StyleName, Bool)]
    forall a. a -> [a] -> [a]
    : (StyleName -> (StyleName, Bool))
    -> [StyleName] -> [(StyleName, Bool)]
    forall a b. (a -> b) -> [a] -> [b]
    map (,Bool
    True)
                        [ StyleName
    "dash"      , StyleName
    "dot-dash" , StyleName
    "dot-dot-dash" , StyleName
    "dotted"
                        , StyleName
    "long-dash" , StyleName
    "solid"    , StyleName
    "wave"
                        ]

    --
    readParaProperties :: StyleReader a ParaProperties
    readParaProperties :: forall a. StyleReader a ParaProperties
    readParaProperties =
       Namespace
    -> StyleName
    -> FallibleXMLConverter Namespace FontPitches a ParaProperties
    -> FallibleXMLConverter Namespace FontPitches a ParaProperties
    forall nsID extraState f s.
    NameSpaceID nsID =>
    nsID
    -> StyleName
    -> FallibleXMLConverter nsID extraState f s
    -> FallibleXMLConverter nsID extraState f s
    executeInSub Namespace
    NsStyle StyleName
    "paragraph-properties" (FallibleXMLConverter Namespace FontPitches a ParaProperties
     -> FallibleXMLConverter Namespace FontPitches a ParaProperties)
    -> FallibleXMLConverter Namespace FontPitches a ParaProperties
    -> FallibleXMLConverter Namespace FontPitches a ParaProperties
    forall a b. (a -> b) -> a -> b
    $ ArrowState
      (XMLConverterState Namespace FontPitches) a ParaProperties
    -> FallibleXMLConverter Namespace FontPitches a ParaProperties
    forall (a :: * -> * -> *) x success failure.
    ArrowChoice a =>
    a x success -> FallibleArrow a x failure success
    liftAsSuccess
         ( (ParaNumbering
     -> LengthOrPercent -> LengthOrPercent -> ParaProperties)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a ParaNumbering
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a LengthOrPercent
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a LengthOrPercent
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a ParaProperties
    forall (a :: * -> * -> *) z y x r b.
    Arrow a =>
    (z -> y -> x -> r) -> a b z -> a b y -> a b x -> a b r
    liftA3 ParaNumbering
    -> LengthOrPercent -> LengthOrPercent -> ParaProperties
    PropP
           ( (Maybe Bool -> Maybe Int -> ParaNumbering)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a (Maybe Bool)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a (Maybe Int)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a ParaNumbering
    forall (a :: * -> * -> *) x y z b.
    Arrow a =>
    (x -> y -> z) -> a b x -> a b y -> a b z
    liftA2 Maybe Bool -> Maybe Int -> ParaNumbering
    readNumbering
             ( Namespace
    -> StyleName
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a (Maybe Bool)
    forall nsID extraState x.
    NameSpaceID nsID =>
    nsID -> StyleName -> XMLConverter nsID extraState x (Maybe Bool)
    isSet'           Namespace
    NsText   StyleName
    "number-lines"           )
             ( Namespace
    -> StyleName
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a (Maybe Int)
    forall nsID attrValue extraState x.
    (NameSpaceID nsID, Read attrValue) =>
    nsID
    -> StyleName -> XMLConverter nsID extraState x (Maybe attrValue)
    readAttr'        Namespace
    NsText   StyleName
    "line-number"            )
           )
           ( (Bool -> LengthOrPercent -> LengthOrPercent)
    -> ArrowState (XMLConverterState Namespace FontPitches) a Bool
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a LengthOrPercent
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a LengthOrPercent
    forall (a :: * -> * -> *) x y z b.
    Arrow a =>
    (x -> y -> z) -> a b x -> a b y -> a b z
    liftA2 Bool -> LengthOrPercent -> LengthOrPercent
    forall {p}. Default p => Bool -> p -> p
    readIndentation
             ( Namespace
    -> StyleName
    -> Bool
    -> ArrowState (XMLConverterState Namespace FontPitches) a Bool
    forall nsID extraState x.
    NameSpaceID nsID =>
    nsID -> StyleName -> Bool -> XMLConverter nsID extraState x Bool
    isSetWithDefault Namespace
    NsStyle  StyleName
    "auto-text-indent" Bool
    False )
             ( Namespace
    -> StyleName
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a LengthOrPercent
    forall nsID attrValue extraState x.
    (NameSpaceID nsID, Read attrValue, Default attrValue) =>
    nsID -> StyleName -> XMLConverter nsID extraState x attrValue
    getAttr          Namespace
    NsXSL_FO StyleName
    "text-indent"            )
           )
           (   Namespace
    -> StyleName
    -> ArrowState
         (XMLConverterState Namespace FontPitches) a LengthOrPercent
    forall nsID attrValue extraState x.
    (NameSpaceID nsID, Read attrValue, Default attrValue) =>
    nsID -> StyleName -> XMLConverter nsID extraState x attrValue
    getAttr          Namespace
    NsXSL_FO StyleName
    "margin-left"            )
         )
      where readNumbering :: Maybe Bool -> Maybe Int -> ParaNumbering
    readNumbering (Just Bool
    True) (Just Int
    n) = Int -> ParaNumbering
    NumberingRestart Int
    n
            readNumbering (Just Bool
    True)  Maybe Int
    _       = ParaNumbering
    NumberingKeep
            readNumbering      Maybe Bool
    _       Maybe Int
    _       = ParaNumbering
    NumberingNone

            readIndentation :: Bool -> p -> p
    readIndentation Bool
    False p
    indent = p
    indent
            readIndentation Bool
    True  p
    _      = p
    forall a. Default a => a
    def

    ----
    -- List styles
    ----

    --
    readListStyle :: StyleReader a (StyleName, ListStyle)
    readListStyle :: forall a. StyleReader a (StyleName, ListStyle)
    readListStyle =
           Namespace
    -> StyleName
    -> FallibleXMLConverter Namespace FontPitches a StyleName
    forall nsID extraState x.
    NameSpaceID nsID =>
    nsID
    -> StyleName -> FallibleXMLConverter nsID extraState x StyleName
    findAttr Namespace
    NsStyle StyleName
    "name"
      FallibleXMLConverter Namespace FontPitches a StyleName
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (StyleName, ListStyle)
    -> FallibleArrow
         (ArrowState (XMLConverterState Namespace FontPitches))
         a
         ()
         (StyleName, ListStyle)
    forall (a :: * -> * -> *) x failure success success'.
    ArrowChoice a =>
    FallibleArrow a x failure success
    -> a success success' -> FallibleArrow a x failure success'
    >>?! ArrowState
      (XMLConverterState Namespace FontPitches) StyleName ListStyle
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (StyleName, ListStyle)
    forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
    keepingTheValue
           ( (Map Int ListLevelStyle -> ListStyle)
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (Map Int ListLevelStyle)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) StyleName ListStyle
    forall (a :: * -> * -> *) y z b.
    Arrow a =>
    (y -> z) -> a b y -> a b z
    liftA Map Int ListLevelStyle -> ListStyle
    ListStyle
             (ArrowState
       (XMLConverterState Namespace FontPitches)
       StyleName
       (Map Int ListLevelStyle)
     -> ArrowState
          (XMLConverterState Namespace FontPitches) StyleName ListStyle)
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (Map Int ListLevelStyle)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) StyleName ListStyle
    forall a b. (a -> b) -> a -> b
    $ (SetMap Int ListLevelStyle
     -> SetMap Int ListLevelStyle
     -> SetMap Int ListLevelStyle
     -> SetMap Int ListLevelStyle)
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (SetMap Int ListLevelStyle)
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (SetMap Int ListLevelStyle)
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (SetMap Int ListLevelStyle)
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (SetMap Int ListLevelStyle)
    forall (a :: * -> * -> *) z y x r b.
    Arrow a =>
    (z -> y -> x -> r) -> a b z -> a b y -> a b x -> a b r
    liftA3 SetMap Int ListLevelStyle
    -> SetMap Int ListLevelStyle
    -> SetMap Int ListLevelStyle
    -> SetMap Int ListLevelStyle
    forall k v.
    Ord k =>
    SetMap k v -> SetMap k v -> SetMap k v -> SetMap k v
    SM.union3
                 ( Namespace
    -> StyleName
    -> ListLevelType
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (SetMap Int ListLevelStyle)
    forall a.
    Namespace
    -> StyleName
    -> ListLevelType
    -> StyleReaderSafe a (SetMap Int ListLevelStyle)
    readListLevelStyles Namespace
    NsText StyleName
    "list-level-style-number" ListLevelType
    LltNumbered )
                 ( Namespace
    -> StyleName
    -> ListLevelType
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (SetMap Int ListLevelStyle)
    forall a.
    Namespace
    -> StyleName
    -> ListLevelType
    -> StyleReaderSafe a (SetMap Int ListLevelStyle)
    readListLevelStyles Namespace
    NsText StyleName
    "list-level-style-bullet" ListLevelType
    LltBullet   )
                 ( Namespace
    -> StyleName
    -> ListLevelType
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (SetMap Int ListLevelStyle)
    forall a.
    Namespace
    -> StyleName
    -> ListLevelType
    -> StyleReaderSafe a (SetMap Int ListLevelStyle)
    readListLevelStyles Namespace
    NsText StyleName
    "list-level-style-image"  ListLevelType
    LltImage    ) ArrowState
      (XMLConverterState Namespace FontPitches)
      StyleName
      (SetMap Int ListLevelStyle)
    -> (SetMap Int ListLevelStyle -> Map Int ListLevelStyle)
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         StyleName
         (Map Int ListLevelStyle)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> (c -> d) -> a b d
    >>^ (Set ListLevelStyle -> Maybe ListLevelStyle)
    -> SetMap Int ListLevelStyle -> Map Int ListLevelStyle
    forall a b k. (a -> Maybe b) -> Map k a -> Map k b
    M.mapMaybe Set ListLevelStyle -> Maybe ListLevelStyle
    chooseMostSpecificListLevelStyle
           )
    --
    readListLevelStyles :: Namespace -> ElementName
                        -> ListLevelType
                        -> StyleReaderSafe a (SM.SetMap Int ListLevelStyle)
    readListLevelStyles :: forall a.
    Namespace
    -> StyleName
    -> ListLevelType
    -> StyleReaderSafe a (SetMap Int ListLevelStyle)
    readListLevelStyles Namespace
    namespace StyleName
    elementName ListLevelType
    levelType =
      Namespace
    -> StyleName
    -> FallibleXMLConverter
         Namespace FontPitches a (Int, ListLevelStyle)
    -> XMLConverter Namespace FontPitches a [(Int, ListLevelStyle)]
    forall nsID extraState b a.
    NameSpaceID nsID =>
    nsID
    -> StyleName
    -> FallibleXMLConverter nsID extraState b a
    -> XMLConverter nsID extraState b [a]
    tryAll Namespace
    namespace StyleName
    elementName (ListLevelType
    -> FallibleXMLConverter
         Namespace FontPitches a (Int, ListLevelStyle)
    forall a. ListLevelType -> StyleReader a (Int, ListLevelStyle)
    readListLevelStyle ListLevelType
    levelType)
        XMLConverter Namespace FontPitches a [(Int, ListLevelStyle)]
    -> ([(Int, ListLevelStyle)] -> SetMap Int ListLevelStyle)
    -> ArrowState
         (XMLConverterState Namespace FontPitches)
         a
         (SetMap Int ListLevelStyle)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> (c -> d) -> a b d
    >>^ [(Int, ListLevelStyle)] -> SetMap Int ListLevelStyle
    forall k v. (Ord k, Ord v) => [(k, v)] -> SetMap k v
    SM.fromList

    --
    readListLevelStyle :: ListLevelType -> StyleReader a (Int, ListLevelStyle)
    readListLevelStyle :: forall a. ListLevelType -> StyleReader a (Int, ListLevelStyle)
    readListLevelStyle ListLevelType
    levelType =      Namespace
    -> StyleName -> FallibleXMLConverter Namespace FontPitches a Int
    forall nsID attrValue extraState x.
    (NameSpaceID nsID, Read attrValue) =>
    nsID
    -> StyleName -> FallibleXMLConverter nsID extraState x attrValue
    readAttr Namespace
    NsText StyleName
    "level"
                                   FallibleXMLConverter Namespace FontPitches a Int
    -> ArrowState
         (XMLConverterState Namespace FontPitches) Int (Int, ListLevelStyle)
    -> FallibleArrow
         (ArrowState (XMLConverterState Namespace FontPitches))
         a
         ()
         (Int, ListLevelStyle)
    forall (a :: * -> * -> *) x failure success success'.
    ArrowChoice a =>
    FallibleArrow a x failure success
    -> a success success' -> FallibleArrow a x failure success'
    >>?! ArrowState
      (XMLConverterState Namespace FontPitches) Int ListLevelStyle
    -> ArrowState
         (XMLConverterState Namespace FontPitches) Int (Int, ListLevelStyle)
    forall (a :: * -> * -> *) b c. Arrow a => a b c -> a b (b, c)
    keepingTheValue
                                        ( (ListLevelType
     -> Maybe StyleName
     -> Maybe StyleName
     -> ListItemNumberFormat
     -> Maybe StyleName
     -> ListLevelStyle)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) Int ListLevelType
    -> ArrowState
         (XMLConverterState Namespace FontPitches) Int (Maybe StyleName)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) Int (Maybe StyleName)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) Int ListItemNumberFormat
    -> ArrowState
         (XMLConverterState Namespace FontPitches) Int (Maybe StyleName)
    -> ArrowState
         (XMLConverterState Namespace FontPitches) Int ListLevelStyle
    forall (a :: * -> * -> *) z y x w v r b.
    Arrow a =>
    (z -> y -> x -> w -> v -> r)
    -> a b z -> a b y -> a b x -> a b w -> a b v -> a b r
    liftA5 ListLevelType
    -> Maybe StyleName
    -> Maybe StyleName
    -> ListItemNumberFormat
    -> Maybe StyleName
    -> ListLevelStyle
    toListLevelStyle
                                          ( ListLevelType
    -> ArrowState
         (XMLConverterState Namespace FontPitches) Int ListLevelType
    forall (a :: * -> * -> *) c x. Arrow a => c -> a x c
    returnV       ListLevelType
    levelType             )
                                          ( Namespace
    -> StyleName
    -> ArrowState
         (XMLConverterState Namespace FontPitches) Int (Maybe StyleName)
    forall nsID extraState x.
    NameSpaceID nsID =>
    nsID
    -> StyleName -> XMLConverter nsID extraState x (Maybe StyleName)
    findAttr'     Namespace
    NsStyle StyleName
    "num-prefix"  )
                                          ( Namespace
    -> StyleName
    -> ArrowState
         (XMLConverterState Namespace FontPitches) Int (Maybe StyleName)
    forall nsID extraState x.
    NameSpaceID nsID =>
    nsID
    -> StyleName -> XMLConverter nsID extraState x (Maybe StyleName)
    findAttr'     Namespace
    NsStyle StyleName
    "num-suffix"  )
                                          ( Namespace
    -> StyleName
    -> ArrowState
         (XMLConverterState Namespace FontPitches) Int ListItemNumberFormat
    forall nsID attrValue extraState x.
    (NameSpaceID nsID, Read attrValue, Default attrValue) =>
    nsID -> StyleName -> XMLConverter nsID extraState x attrValue
    getAttr       Namespace
    NsStyle StyleName
    "num-format"  )
                                          ( Namespace
    -> StyleName
    -> ArrowState
         (XMLConverterState Namespace FontPitches) Int (Maybe StyleName)
    forall nsID extraState x.
    NameSpaceID nsID =>
    nsID
    -> StyleName -> XMLConverter nsID extraState x (Maybe StyleName)
    findAttrText' Namespace
    NsText  StyleName
    "start-value" )
                                        )
      where
      toListLevelStyle :: ListLevelType
    -> Maybe StyleName
    -> Maybe StyleName
    -> ListItemNumberFormat
    -> Maybe StyleName
    -> ListLevelStyle
    toListLevelStyle ListLevelType
    _ Maybe StyleName
    p Maybe StyleName
    s ListItemNumberFormat
    LinfNone Maybe StyleName
    b         = ListLevelType
    -> Maybe StyleName
    -> Maybe StyleName
    -> ListItemNumberFormat
    -> Int
    -> ListLevelStyle
    ListLevelStyle ListLevelType
    LltBullet Maybe StyleName
    p Maybe StyleName
    s ListItemNumberFormat
    LinfNone (Maybe StyleName -> Int
    forall {a}. (Num a, Read a) => Maybe StyleName -> a
    startValue Maybe StyleName
    b)
      toListLevelStyle ListLevelType
    _ Maybe StyleName
    p Maybe StyleName
    s f :: ListItemNumberFormat
    f@(LinfString String
    _) Maybe StyleName
    b = ListLevelType
    -> Maybe StyleName
    -> Maybe StyleName
    -> ListItemNumberFormat
    -> Int
    -> ListLevelStyle
    ListLevelStyle ListLevelType
    LltBullet Maybe StyleName
    p Maybe StyleName
    s ListItemNumberFormat
    f (Maybe StyleName -> Int
    forall {a}. (Num a, Read a) => Maybe StyleName -> a
    startValue Maybe StyleName
    b)
      toListLevelStyle ListLevelType
    t Maybe StyleName
    p Maybe StyleName
    s ListItemNumberFormat
    f Maybe StyleName
    b                = ListLevelType
    -> Maybe StyleName
    -> Maybe StyleName
    -> ListItemNumberFormat
    -> Int
    -> ListLevelStyle
    ListLevelStyle ListLevelType
    t      Maybe StyleName
    p Maybe StyleName
    s ListItemNumberFormat
    f (Maybe StyleName -> Int
    forall {a}. (Num a, Read a) => Maybe StyleName -> a
    startValue Maybe StyleName
    b)
      startValue :: Maybe StyleName -> a
    startValue Maybe StyleName
    mbx = a -> Maybe a -> a
    forall a. a -> Maybe a -> a
    fromMaybe a
    1 (Maybe StyleName
    mbx Maybe StyleName -> (StyleName -> Maybe a) -> Maybe a
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= StyleName -> Maybe a
    forall (m :: * -> *) a. (MonadPlus m, Read a) => StyleName -> m a
    safeRead)

    --
    chooseMostSpecificListLevelStyle :: S.Set ListLevelStyle -> Maybe ListLevelStyle
    chooseMostSpecificListLevelStyle :: Set ListLevelStyle -> Maybe ListLevelStyle
    chooseMostSpecificListLevelStyle Set ListLevelStyle
    ls = (ListLevelStyle -> Maybe ListLevelStyle -> Maybe ListLevelStyle)
    -> Maybe ListLevelStyle
    -> Set ListLevelStyle
    -> Maybe ListLevelStyle
    forall a b. (a -> b -> b) -> b -> Set a -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    F.foldr ListLevelStyle -> Maybe ListLevelStyle -> Maybe ListLevelStyle
    select Maybe ListLevelStyle
    forall a. Maybe a
    Nothing Set ListLevelStyle
    ls
      where
       select :: ListLevelStyle -> Maybe ListLevelStyle -> Maybe ListLevelStyle
    select ListLevelStyle
    l Maybe ListLevelStyle
    Nothing = ListLevelStyle -> Maybe ListLevelStyle
    forall a. a -> Maybe a
    Just ListLevelStyle
    l
       select ( ListLevelStyle ListLevelType
    t1 Maybe StyleName
    p1 Maybe StyleName
    s1 ListItemNumberFormat
    f1 Int
    b1 )
              ( Just ( ListLevelStyle ListLevelType
    t2 Maybe StyleName
    p2 Maybe StyleName
    s2 ListItemNumberFormat
    f2 Int
    _ ))
            =   ListLevelStyle -> Maybe ListLevelStyle
    forall a. a -> Maybe a
    Just (ListLevelStyle -> Maybe ListLevelStyle)
    -> ListLevelStyle -> Maybe ListLevelStyle
    forall a b. (a -> b) -> a -> b
    $ ListLevelType
    -> Maybe StyleName
    -> Maybe StyleName
    -> ListItemNumberFormat
    -> Int
    -> ListLevelStyle
    ListLevelStyle (ListLevelType -> ListLevelType -> ListLevelType
    select' ListLevelType
    t1 ListLevelType
    t2) (Maybe StyleName
    p1 Maybe StyleName -> Maybe StyleName -> Maybe StyleName
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Maybe StyleName
    p2) (Maybe StyleName
    s1 Maybe StyleName -> Maybe StyleName -> Maybe StyleName
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Maybe StyleName
    s2)
                                      (ListItemNumberFormat
    -> ListItemNumberFormat -> ListItemNumberFormat
    selectLinf ListItemNumberFormat
    f1 ListItemNumberFormat
    f2) Int
    b1
       select' :: ListLevelType -> ListLevelType -> ListLevelType
    select' ListLevelType
    LltNumbered ListLevelType
    _           = ListLevelType
    LltNumbered
       select' ListLevelType
    _           ListLevelType
    LltNumbered = ListLevelType
    LltNumbered
       select' ListLevelType
    _           ListLevelType
    _           = ListLevelType
    LltBullet
       selectLinf :: ListItemNumberFormat
    -> ListItemNumberFormat -> ListItemNumberFormat
    selectLinf ListItemNumberFormat
    LinfNone       ListItemNumberFormat
    f2             = ListItemNumberFormat
    f2
       selectLinf ListItemNumberFormat
    f1             ListItemNumberFormat
    LinfNone       = ListItemNumberFormat
    f1
       selectLinf (LinfString String
    _) ListItemNumberFormat
    f2             = ListItemNumberFormat
    f2
       selectLinf ListItemNumberFormat
    f1             (LinfString String
    _) = ListItemNumberFormat
    f1
       selectLinf ListItemNumberFormat
    f1             ListItemNumberFormat
    _              = ListItemNumberFormat
    f1

    --------------------------------------------------------------------------------
    -- Tools to access style data
    --------------------------------------------------------------------------------

    --
    lookupStyle           :: StyleName   -> Styles -> Maybe Style
    lookupStyle :: StyleName -> Styles -> Maybe Style
    lookupStyle StyleName
    name Styles{Map StyleName ListStyle
    Map StyleName Style
    Map StyleFamily StyleProperties
    stylesByName :: Styles -> Map StyleName Style
    listStylesByName :: Styles -> Map StyleName ListStyle
    defaultStyleMap :: Styles -> Map StyleFamily StyleProperties
    stylesByName :: Map StyleName Style
    listStylesByName :: Map StyleName ListStyle
    defaultStyleMap :: Map StyleFamily StyleProperties
    ..} = StyleName -> Map StyleName Style -> Maybe Style
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup StyleName
    name Map StyleName Style
    stylesByName

    --
    lookupDefaultStyle'   :: Styles -> StyleFamily -> StyleProperties
    lookupDefaultStyle' :: Styles -> StyleFamily -> StyleProperties
    lookupDefaultStyle' Styles{Map StyleName ListStyle
    Map StyleName Style
    Map StyleFamily StyleProperties
    stylesByName :: Styles -> Map StyleName Style
    listStylesByName :: Styles -> Map StyleName ListStyle
    defaultStyleMap :: Styles -> Map StyleFamily StyleProperties
    stylesByName :: Map StyleName Style
    listStylesByName :: Map StyleName ListStyle
    defaultStyleMap :: Map StyleFamily StyleProperties
    ..} StyleFamily
    family = StyleProperties -> Maybe StyleProperties -> StyleProperties
    forall a. a -> Maybe a -> a
    fromMaybe StyleProperties
    forall a. Default a => a
    def
                                            (StyleFamily
    -> Map StyleFamily StyleProperties -> Maybe StyleProperties
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup StyleFamily
    family Map StyleFamily StyleProperties
    defaultStyleMap)

    --
    lookupListStyleByName :: StyleName   -> Styles -> Maybe ListStyle
    lookupListStyleByName :: StyleName -> Styles -> Maybe ListStyle
    lookupListStyleByName StyleName
    name Styles{Map StyleName ListStyle
    Map StyleName Style
    Map StyleFamily StyleProperties
    stylesByName :: Styles -> Map StyleName Style
    listStylesByName :: Styles -> Map StyleName ListStyle
    defaultStyleMap :: Styles -> Map StyleFamily StyleProperties
    stylesByName :: Map StyleName Style
    listStylesByName :: Map StyleName ListStyle
    defaultStyleMap :: Map StyleFamily StyleProperties
    ..} = StyleName -> Map StyleName ListStyle -> Maybe ListStyle
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup StyleName
    name Map StyleName ListStyle
    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 -> [Style]
    parents Style
    style Styles
    styles = (Style -> Maybe (Style, Style)) -> Style -> [Style]
    forall b a. (b -> Maybe (a, b)) -> b -> [a]
    L.unfoldr Style -> Maybe (Style, Style)
    findNextParent Style
    style -- Ha!
      where findNextParent :: Style -> Maybe (Style, Style)
    findNextParent Style{Maybe StyleName
    Maybe StyleFamily
    StyleProperties
    styleFamily :: Style -> Maybe StyleFamily
    styleParentName :: Style -> Maybe StyleName
    listStyle :: Style -> Maybe StyleName
    styleProperties :: Style -> StyleProperties
    styleFamily :: Maybe StyleFamily
    styleParentName :: Maybe StyleName
    listStyle :: Maybe StyleName
    styleProperties :: StyleProperties
    ..}
              = (Style -> (Style, Style)) -> Maybe Style -> Maybe (Style, Style)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Style -> (Style, Style)
    forall (a :: * -> * -> *) b. Arrow a => a b (b, b)
    duplicate (Maybe Style -> Maybe (Style, Style))
    -> Maybe Style -> Maybe (Style, Style)
    forall a b. (a -> b) -> a -> b
    $ (StyleName -> Styles -> Maybe Style
    `lookupStyle` Styles
    styles) (StyleName -> Maybe Style) -> Maybe StyleName -> Maybe Style
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Maybe StyleName
    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 -> Styles -> Maybe StyleFamily
    getStyleFamily style :: Style
    style@Style{Maybe StyleName
    Maybe StyleFamily
    StyleProperties
    styleFamily :: Style -> Maybe StyleFamily
    styleParentName :: Style -> Maybe StyleName
    listStyle :: Style -> Maybe StyleName
    styleProperties :: Style -> StyleProperties
    styleFamily :: Maybe StyleFamily
    styleParentName :: Maybe StyleName
    listStyle :: Maybe StyleName
    styleProperties :: StyleProperties
    ..} Styles
    styles
      =     Maybe StyleFamily
    styleFamily
        Maybe StyleFamily -> Maybe StyleFamily -> Maybe StyleFamily
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> [Maybe StyleFamily] -> Maybe StyleFamily
    forall (t :: * -> *) (f :: * -> *) a.
    (Foldable t, Alternative f) =>
    t (f a) -> f a
    F.asum ((Style -> Maybe StyleFamily) -> [Style] -> [Maybe StyleFamily]
    forall a b. (a -> b) -> [a] -> [b]
    map (Style -> Styles -> Maybe StyleFamily
    `getStyleFamily` Styles
    styles) ([Style] -> [Maybe StyleFamily]) -> [Style] -> [Maybe StyleFamily]
    forall a b. (a -> b) -> a -> b
    $ Style -> Styles -> [Style]
    parents Style
    style Styles
    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 -> [StyleProperties]
    stylePropertyChain Style
    style Styles
    styles
      = (Style -> StyleProperties) -> [Style] -> [StyleProperties]
    forall a b. (a -> b) -> [a] -> [b]
    map Style -> StyleProperties
    styleProperties (Style
    style Style -> [Style] -> [Style]
    forall a. a -> [a] -> [a]
    : Style -> Styles -> [Style]
    parents Style
    style Styles
    styles)

    --
    extendedStylePropertyChain :: [Style] -> Styles -> [StyleProperties]
    extendedStylePropertyChain :: [Style] -> Styles -> [StyleProperties]
    extendedStylePropertyChain [] Styles
    _ = []
    extendedStylePropertyChain [Style
    style]       Styles
    styles =    Style -> Styles -> [StyleProperties]
    stylePropertyChain Style
    style Styles
    styles
                                                      [StyleProperties] -> [StyleProperties] -> [StyleProperties]
    forall a. [a] -> [a] -> [a]
    ++ Maybe StyleProperties -> [StyleProperties]
    forall a. Maybe a -> [a]
    maybeToList ((StyleFamily -> StyleProperties)
    -> Maybe StyleFamily -> Maybe StyleProperties
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Styles -> StyleFamily -> StyleProperties
    lookupDefaultStyle' Styles
    styles) (Style -> Styles -> Maybe StyleFamily
    getStyleFamily Style
    style Styles
    styles))
    extendedStylePropertyChain (Style
    style:[Style]
    trace) Styles
    styles =    Style -> Styles -> [StyleProperties]
    stylePropertyChain Style
    style Styles
    styles
                                                      [StyleProperties] -> [StyleProperties] -> [StyleProperties]
    forall a. [a] -> [a] -> [a]
    ++ [Style] -> Styles -> [StyleProperties]
    extendedStylePropertyChain [Style]
    trace Styles
    styles