{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE DeriveGeneric #-}
module Codec.Xlsx.Types.RichText (
    -- * Main types
    RichTextRun(..)
  , RunProperties(..)
  , applyRunProperties
    -- * Lenses
    -- ** RichTextRun
  , richTextRunProperties
  , richTextRunText
    -- ** RunProperties
  , runPropertiesBold
  , runPropertiesCharset
  , runPropertiesColor
  , runPropertiesCondense
  , runPropertiesExtend
  , runPropertiesFontFamily
  , runPropertiesItalic
  , runPropertiesOutline
  , runPropertiesFont
  , runPropertiesScheme
  , runPropertiesShadow
  , runPropertiesStrikeThrough
  , runPropertiesSize
  , runPropertiesUnderline
  , runPropertiesVertAlign
  ) where

import GHC.Generics (Generic)

#ifdef USE_MICROLENS
import Lens.Micro.TH (makeLenses)
#else
import Control.Lens hiding (element)
#endif
import Control.Monad
import Control.DeepSeq (NFData)
import Data.Default
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Text.XML
import Text.XML.Cursor
import qualified Data.Map as Map

import Codec.Xlsx.Parser.Internal
import Codec.Xlsx.Types.StyleSheet
import Codec.Xlsx.Writer.Internal

-- | Rich Text Run
--
-- This element represents a run of rich text. A rich text run is a region of
-- text that share a common set of properties, such as formatting properties.
--
-- Section 18.4.4, "r (Rich Text Run)" (p. 1724)
data RichTextRun = RichTextRun {
    -- | This element represents a set of properties to apply to the contents of
    -- this rich text run.
    RichTextRun -> Maybe RunProperties
_richTextRunProperties :: Maybe RunProperties

    -- | This element represents the text content shown as part of a string.
    --
    -- NOTE: 'RichTextRun' elements with an empty text field will result in
    -- an error when opening the file in Excel.
    --
    -- Section 18.4.12, "t (Text)" (p. 1727)
  , RichTextRun -> Text
_richTextRunText :: Text
  }
  deriving (RichTextRun -> RichTextRun -> Bool
(RichTextRun -> RichTextRun -> Bool)
-> (RichTextRun -> RichTextRun -> Bool) -> Eq RichTextRun
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RichTextRun -> RichTextRun -> Bool
$c/= :: RichTextRun -> RichTextRun -> Bool
== :: RichTextRun -> RichTextRun -> Bool
$c== :: RichTextRun -> RichTextRun -> Bool
Eq, Eq RichTextRun
Eq RichTextRun
-> (RichTextRun -> RichTextRun -> Ordering)
-> (RichTextRun -> RichTextRun -> Bool)
-> (RichTextRun -> RichTextRun -> Bool)
-> (RichTextRun -> RichTextRun -> Bool)
-> (RichTextRun -> RichTextRun -> Bool)
-> (RichTextRun -> RichTextRun -> RichTextRun)
-> (RichTextRun -> RichTextRun -> RichTextRun)
-> Ord RichTextRun
RichTextRun -> RichTextRun -> Bool
RichTextRun -> RichTextRun -> Ordering
RichTextRun -> RichTextRun -> RichTextRun
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
min :: RichTextRun -> RichTextRun -> RichTextRun
$cmin :: RichTextRun -> RichTextRun -> RichTextRun
max :: RichTextRun -> RichTextRun -> RichTextRun
$cmax :: RichTextRun -> RichTextRun -> RichTextRun
>= :: RichTextRun -> RichTextRun -> Bool
$c>= :: RichTextRun -> RichTextRun -> Bool
> :: RichTextRun -> RichTextRun -> Bool
$c> :: RichTextRun -> RichTextRun -> Bool
<= :: RichTextRun -> RichTextRun -> Bool
$c<= :: RichTextRun -> RichTextRun -> Bool
< :: RichTextRun -> RichTextRun -> Bool
$c< :: RichTextRun -> RichTextRun -> Bool
compare :: RichTextRun -> RichTextRun -> Ordering
$ccompare :: RichTextRun -> RichTextRun -> Ordering
$cp1Ord :: Eq RichTextRun
Ord, Int -> RichTextRun -> ShowS
[RichTextRun] -> ShowS
RichTextRun -> String
(Int -> RichTextRun -> ShowS)
-> (RichTextRun -> String)
-> ([RichTextRun] -> ShowS)
-> Show RichTextRun
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RichTextRun] -> ShowS
$cshowList :: [RichTextRun] -> ShowS
show :: RichTextRun -> String
$cshow :: RichTextRun -> String
showsPrec :: Int -> RichTextRun -> ShowS
$cshowsPrec :: Int -> RichTextRun -> ShowS
Show, (forall x. RichTextRun -> Rep RichTextRun x)
-> (forall x. Rep RichTextRun x -> RichTextRun)
-> Generic RichTextRun
forall x. Rep RichTextRun x -> RichTextRun
forall x. RichTextRun -> Rep RichTextRun x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RichTextRun x -> RichTextRun
$cfrom :: forall x. RichTextRun -> Rep RichTextRun x
Generic)

instance NFData RichTextRun

-- | Run properties
--
-- Section 18.4.7, "rPr (Run Properties)" (p. 1725)
data RunProperties = RunProperties {
    -- | Displays characters in bold face font style.
    --
    -- Section 18.8.2, "b (Bold)" (p. 1757)
    RunProperties -> Maybe Bool
_runPropertiesBold :: Maybe Bool

    -- | This element defines the font character set of this font.
    --
    -- Section 18.4.1, "charset (Character Set)" (p. 1721)
  , RunProperties -> Maybe Int
_runPropertiesCharset :: Maybe Int

    -- | One of the colors associated with the data bar or color scale.
    --
    -- Section 18.3.1.15, "color (Data Bar Color)" (p. 1608)
  , RunProperties -> Maybe Color
_runPropertiesColor :: Maybe Color

    -- | Macintosh compatibility setting. Represents special word/character
    -- rendering on Macintosh, when this flag is set. The effect is to condense
    -- the text (squeeze it together).
    --
    -- Section 18.8.12, "condense (Condense)" (p. 1764)
  , RunProperties -> Maybe Bool
_runPropertiesCondense :: Maybe Bool

    -- | This element specifies a compatibility setting used for previous
    -- spreadsheet applications, resulting in special word/character rendering
    -- on those legacy applications, when this flag is set. The effect extends
    -- or stretches out the text.
    --
    -- Section 18.8.17, "extend (Extend)" (p. 1766)
  , RunProperties -> Maybe Bool
_runPropertiesExtend :: Maybe Bool

    -- | The font family this font belongs to. A font family is a set of fonts
    -- having common stroke width and serif characteristics. This is system
    -- level font information. The font name overrides when there are
    -- conflicting values.
    --
    -- Section 18.8.18, "family (Font Family)" (p. 1766)
  , RunProperties -> Maybe FontFamily
_runPropertiesFontFamily :: Maybe FontFamily

    -- | Displays characters in italic font style. The italic style is defined
    -- by the font at a system level and is not specified by ECMA-376.
    --
    -- Section 18.8.26, "i (Italic)" (p. 1773)
  , RunProperties -> Maybe Bool
_runPropertiesItalic :: Maybe Bool

    -- | This element displays only the inner and outer borders of each
    -- character. This is very similar to Bold in behavior.
    --
    -- Section 18.4.2, "outline (Outline)" (p. 1722)
  , RunProperties -> Maybe Bool
_runPropertiesOutline :: Maybe Bool

    -- | This element is a string representing the name of the font assigned to
    -- display this run.
    --
    -- Section 18.4.5, "rFont (Font)" (p. 1724)
  , RunProperties -> Maybe Text
_runPropertiesFont :: Maybe Text

    -- | Defines the font scheme, if any, to which this font belongs. When a
    -- font definition is part of a theme definition, then the font is
    -- categorized as either a major or minor font scheme component. When a new
    -- theme is chosen, every font that is part of a theme definition is updated
    -- to use the new major or minor font definition for that theme. Usually
    -- major fonts are used for styles like headings, and minor fonts are used
    -- for body and paragraph text.
    --
    -- Section 18.8.35, "scheme (Scheme)" (p. 1794)
  , RunProperties -> Maybe FontScheme
_runPropertiesScheme :: Maybe FontScheme

    -- | Macintosh compatibility setting. Represents special word/character
    -- rendering on Macintosh, when this flag is set. The effect is to render a
    -- shadow behind, beneath and to the right of the text.
    --
    -- Section 18.8.36, "shadow (Shadow)" (p. 1795)
  , RunProperties -> Maybe Bool
_runPropertiesShadow :: Maybe Bool

    -- | This element draws a strikethrough line through the horizontal middle
    -- of the text.
    --
    -- Section 18.4.10, "strike (Strike Through)" (p. 1726)
  , RunProperties -> Maybe Bool
_runPropertiesStrikeThrough :: Maybe Bool

    -- | This element represents the point size (1/72 of an inch) of the Latin
    -- and East Asian text.
    --
    -- Section 18.4.11, "sz (Font Size)" (p. 1727)
  , RunProperties -> Maybe Double
_runPropertiesSize :: Maybe Double

    -- | This element represents the underline formatting style.
    --
    -- Section 18.4.13, "u (Underline)" (p. 1728)
  , RunProperties -> Maybe FontUnderline
_runPropertiesUnderline :: Maybe FontUnderline

    -- | This element adjusts the vertical position of the text relative to the
    -- text's default appearance for this run. It is used to get 'superscript'
    -- or 'subscript' texts, and shall reduce the font size (if a smaller size
    -- is available) accordingly.
    --
    -- Section 18.4.14, "vertAlign (Vertical Alignment)" (p. 1728)
  , RunProperties -> Maybe FontVerticalAlignment
_runPropertiesVertAlign :: Maybe FontVerticalAlignment
  }
  deriving (RunProperties -> RunProperties -> Bool
(RunProperties -> RunProperties -> Bool)
-> (RunProperties -> RunProperties -> Bool) -> Eq RunProperties
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunProperties -> RunProperties -> Bool
$c/= :: RunProperties -> RunProperties -> Bool
== :: RunProperties -> RunProperties -> Bool
$c== :: RunProperties -> RunProperties -> Bool
Eq, Eq RunProperties
Eq RunProperties
-> (RunProperties -> RunProperties -> Ordering)
-> (RunProperties -> RunProperties -> Bool)
-> (RunProperties -> RunProperties -> Bool)
-> (RunProperties -> RunProperties -> Bool)
-> (RunProperties -> RunProperties -> Bool)
-> (RunProperties -> RunProperties -> RunProperties)
-> (RunProperties -> RunProperties -> RunProperties)
-> Ord RunProperties
RunProperties -> RunProperties -> Bool
RunProperties -> RunProperties -> Ordering
RunProperties -> RunProperties -> RunProperties
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
min :: RunProperties -> RunProperties -> RunProperties
$cmin :: RunProperties -> RunProperties -> RunProperties
max :: RunProperties -> RunProperties -> RunProperties
$cmax :: RunProperties -> RunProperties -> RunProperties
>= :: RunProperties -> RunProperties -> Bool
$c>= :: RunProperties -> RunProperties -> Bool
> :: RunProperties -> RunProperties -> Bool
$c> :: RunProperties -> RunProperties -> Bool
<= :: RunProperties -> RunProperties -> Bool
$c<= :: RunProperties -> RunProperties -> Bool
< :: RunProperties -> RunProperties -> Bool
$c< :: RunProperties -> RunProperties -> Bool
compare :: RunProperties -> RunProperties -> Ordering
$ccompare :: RunProperties -> RunProperties -> Ordering
$cp1Ord :: Eq RunProperties
Ord, Int -> RunProperties -> ShowS
[RunProperties] -> ShowS
RunProperties -> String
(Int -> RunProperties -> ShowS)
-> (RunProperties -> String)
-> ([RunProperties] -> ShowS)
-> Show RunProperties
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunProperties] -> ShowS
$cshowList :: [RunProperties] -> ShowS
show :: RunProperties -> String
$cshow :: RunProperties -> String
showsPrec :: Int -> RunProperties -> ShowS
$cshowsPrec :: Int -> RunProperties -> ShowS
Show, (forall x. RunProperties -> Rep RunProperties x)
-> (forall x. Rep RunProperties x -> RunProperties)
-> Generic RunProperties
forall x. Rep RunProperties x -> RunProperties
forall x. RunProperties -> Rep RunProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RunProperties x -> RunProperties
$cfrom :: forall x. RunProperties -> Rep RunProperties x
Generic)

instance NFData RunProperties

{-------------------------------------------------------------------------------
  Lenses
-------------------------------------------------------------------------------}

makeLenses ''RichTextRun
makeLenses ''RunProperties

{-------------------------------------------------------------------------------
  Default instances
-------------------------------------------------------------------------------}

instance Default RichTextRun where
  def :: RichTextRun
def = RichTextRun :: Maybe RunProperties -> Text -> RichTextRun
RichTextRun {
      _richTextRunProperties :: Maybe RunProperties
_richTextRunProperties = Maybe RunProperties
forall a. Maybe a
Nothing
    , _richTextRunText :: Text
_richTextRunText       = Text
""
    }

instance Default RunProperties where
   def :: RunProperties
def = RunProperties :: Maybe Bool
-> Maybe Int
-> Maybe Color
-> Maybe Bool
-> Maybe Bool
-> Maybe FontFamily
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe FontScheme
-> Maybe Bool
-> Maybe Bool
-> Maybe Double
-> Maybe FontUnderline
-> Maybe FontVerticalAlignment
-> RunProperties
RunProperties {
      _runPropertiesBold :: Maybe Bool
_runPropertiesBold          = Maybe Bool
forall a. Maybe a
Nothing
    , _runPropertiesCharset :: Maybe Int
_runPropertiesCharset       = Maybe Int
forall a. Maybe a
Nothing
    , _runPropertiesColor :: Maybe Color
_runPropertiesColor         = Maybe Color
forall a. Maybe a
Nothing
    , _runPropertiesCondense :: Maybe Bool
_runPropertiesCondense      = Maybe Bool
forall a. Maybe a
Nothing
    , _runPropertiesExtend :: Maybe Bool
_runPropertiesExtend        = Maybe Bool
forall a. Maybe a
Nothing
    , _runPropertiesFontFamily :: Maybe FontFamily
_runPropertiesFontFamily    = Maybe FontFamily
forall a. Maybe a
Nothing
    , _runPropertiesItalic :: Maybe Bool
_runPropertiesItalic        = Maybe Bool
forall a. Maybe a
Nothing
    , _runPropertiesOutline :: Maybe Bool
_runPropertiesOutline       = Maybe Bool
forall a. Maybe a
Nothing
    , _runPropertiesFont :: Maybe Text
_runPropertiesFont          = Maybe Text
forall a. Maybe a
Nothing
    , _runPropertiesScheme :: Maybe FontScheme
_runPropertiesScheme        = Maybe FontScheme
forall a. Maybe a
Nothing
    , _runPropertiesShadow :: Maybe Bool
_runPropertiesShadow        = Maybe Bool
forall a. Maybe a
Nothing
    , _runPropertiesStrikeThrough :: Maybe Bool
_runPropertiesStrikeThrough = Maybe Bool
forall a. Maybe a
Nothing
    , _runPropertiesSize :: Maybe Double
_runPropertiesSize          = Maybe Double
forall a. Maybe a
Nothing
    , _runPropertiesUnderline :: Maybe FontUnderline
_runPropertiesUnderline     = Maybe FontUnderline
forall a. Maybe a
Nothing
    , _runPropertiesVertAlign :: Maybe FontVerticalAlignment
_runPropertiesVertAlign     = Maybe FontVerticalAlignment
forall a. Maybe a
Nothing
    }

{-------------------------------------------------------------------------------
  Rendering
-------------------------------------------------------------------------------}

-- | See @CT_RElt@, p. 3903
instance ToElement RichTextRun where
  toElement :: Name -> RichTextRun -> Element
toElement Name
nm RichTextRun{Maybe RunProperties
Text
_richTextRunText :: Text
_richTextRunProperties :: Maybe RunProperties
_richTextRunText :: RichTextRun -> Text
_richTextRunProperties :: RichTextRun -> Maybe RunProperties
..} = Element :: Name -> Map Name Text -> [Node] -> Element
Element {
      elementName :: Name
elementName       = Name
nm
    , elementAttributes :: Map Name Text
elementAttributes = Map Name Text
forall k a. Map k a
Map.empty
    , elementNodes :: [Node]
elementNodes      = (Element -> Node) -> [Element] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
NodeElement ([Element] -> [Node])
-> ([Maybe Element] -> [Element]) -> [Maybe Element] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Element] -> [Element]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Element] -> [Node]) -> [Maybe Element] -> [Node]
forall a b. (a -> b) -> a -> b
$ [
          Name -> RunProperties -> Element
forall a. ToElement a => Name -> a -> Element
toElement Name
"rPr" (RunProperties -> Element) -> Maybe RunProperties -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe RunProperties
_richTextRunProperties
        , Element -> Maybe Element
forall a. a -> Maybe a
Just (Element -> Maybe Element) -> Element -> Maybe Element
forall a b. (a -> b) -> a -> b
$ Name -> Text -> Element
elementContentPreserved Name
"t" Text
_richTextRunText
        ]
    }

-- | See @CT_RPrElt@, p. 3903
instance ToElement RunProperties where
  toElement :: Name -> RunProperties -> Element
toElement Name
nm RunProperties{Maybe Bool
Maybe Double
Maybe Int
Maybe Text
Maybe FontVerticalAlignment
Maybe FontUnderline
Maybe FontScheme
Maybe FontFamily
Maybe Color
_runPropertiesVertAlign :: Maybe FontVerticalAlignment
_runPropertiesUnderline :: Maybe FontUnderline
_runPropertiesSize :: Maybe Double
_runPropertiesStrikeThrough :: Maybe Bool
_runPropertiesShadow :: Maybe Bool
_runPropertiesScheme :: Maybe FontScheme
_runPropertiesFont :: Maybe Text
_runPropertiesOutline :: Maybe Bool
_runPropertiesItalic :: Maybe Bool
_runPropertiesFontFamily :: Maybe FontFamily
_runPropertiesExtend :: Maybe Bool
_runPropertiesCondense :: Maybe Bool
_runPropertiesColor :: Maybe Color
_runPropertiesCharset :: Maybe Int
_runPropertiesBold :: Maybe Bool
_runPropertiesVertAlign :: RunProperties -> Maybe FontVerticalAlignment
_runPropertiesUnderline :: RunProperties -> Maybe FontUnderline
_runPropertiesSize :: RunProperties -> Maybe Double
_runPropertiesStrikeThrough :: RunProperties -> Maybe Bool
_runPropertiesShadow :: RunProperties -> Maybe Bool
_runPropertiesScheme :: RunProperties -> Maybe FontScheme
_runPropertiesFont :: RunProperties -> Maybe Text
_runPropertiesOutline :: RunProperties -> Maybe Bool
_runPropertiesItalic :: RunProperties -> Maybe Bool
_runPropertiesFontFamily :: RunProperties -> Maybe FontFamily
_runPropertiesExtend :: RunProperties -> Maybe Bool
_runPropertiesCondense :: RunProperties -> Maybe Bool
_runPropertiesColor :: RunProperties -> Maybe Color
_runPropertiesCharset :: RunProperties -> Maybe Int
_runPropertiesBold :: RunProperties -> Maybe Bool
..} = Element :: Name -> Map Name Text -> [Node] -> Element
Element {
      elementName :: Name
elementName       = Name
nm
    , elementAttributes :: Map Name Text
elementAttributes = Map Name Text
forall k a. Map k a
Map.empty
    , elementNodes :: [Node]
elementNodes      = (Element -> Node) -> [Element] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
NodeElement ([Element] -> [Node])
-> ([Maybe Element] -> [Element]) -> [Maybe Element] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Element] -> [Element]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Element] -> [Node]) -> [Maybe Element] -> [Node]
forall a b. (a -> b) -> a -> b
$ [
          Name -> Text -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"rFont"     (Text -> Element) -> Maybe Text -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
_runPropertiesFont
        , Name -> Int -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"charset"   (Int -> Element) -> Maybe Int -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
_runPropertiesCharset
        , Name -> FontFamily -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"family"    (FontFamily -> Element) -> Maybe FontFamily -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FontFamily
_runPropertiesFontFamily
        , Name -> Bool -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"b"         (Bool -> Element) -> Maybe Bool -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_runPropertiesBold
        , Name -> Bool -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"i"         (Bool -> Element) -> Maybe Bool -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_runPropertiesItalic
        , Name -> Bool -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"strike"    (Bool -> Element) -> Maybe Bool -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_runPropertiesStrikeThrough
        , Name -> Bool -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"outline"   (Bool -> Element) -> Maybe Bool -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_runPropertiesOutline
        , Name -> Bool -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"shadow"    (Bool -> Element) -> Maybe Bool -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_runPropertiesShadow
        , Name -> Bool -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"condense"  (Bool -> Element) -> Maybe Bool -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_runPropertiesCondense
        , Name -> Bool -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"extend"    (Bool -> Element) -> Maybe Bool -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
_runPropertiesExtend
        , Name -> Color -> Element
forall a. ToElement a => Name -> a -> Element
toElement    Name
"color"     (Color -> Element) -> Maybe Color -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Color
_runPropertiesColor
        , Name -> Double -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"sz"        (Double -> Element) -> Maybe Double -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Double
_runPropertiesSize
        , Name -> FontUnderline -> FontUnderline -> Element
forall a. (Eq a, ToAttrVal a) => Name -> a -> a -> Element
elementValueDef Name
"u" FontUnderline
FontUnderlineSingle
                                   (FontUnderline -> Element) -> Maybe FontUnderline -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FontUnderline
_runPropertiesUnderline
        , Name -> FontVerticalAlignment -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"vertAlign" (FontVerticalAlignment -> Element)
-> Maybe FontVerticalAlignment -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FontVerticalAlignment
_runPropertiesVertAlign
        , Name -> FontScheme -> Element
forall a. ToAttrVal a => Name -> a -> Element
elementValue Name
"scheme"    (FontScheme -> Element) -> Maybe FontScheme -> Maybe Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FontScheme
_runPropertiesScheme
        ]
    }

{-------------------------------------------------------------------------------
  Parsing
-------------------------------------------------------------------------------}

-- | See @CT_RElt@, p. 3903
instance FromCursor RichTextRun where
  fromCursor :: Cursor -> [RichTextRun]
fromCursor Cursor
cur = do
    Text
_richTextRunText <- Cursor
cur Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
n_ Text
"t") Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
    Maybe RunProperties
_richTextRunProperties <- Name -> Cursor -> [Maybe RunProperties]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement (Text -> Name
n_ Text
"rPr") Cursor
cur
    RichTextRun -> [RichTextRun]
forall (m :: * -> *) a. Monad m => a -> m a
return RichTextRun :: Maybe RunProperties -> Text -> RichTextRun
RichTextRun{Maybe RunProperties
Text
_richTextRunProperties :: Maybe RunProperties
_richTextRunText :: Text
_richTextRunText :: Text
_richTextRunProperties :: Maybe RunProperties
..}

instance FromXenoNode RichTextRun where
  fromXenoNode :: Node -> Either Text RichTextRun
fromXenoNode Node
root = do
    (Maybe Node
prNode, Node
tNode) <- Node
-> ChildCollector (Maybe Node, Node)
-> Either Text (Maybe Node, Node)
forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
root (ChildCollector (Maybe Node, Node)
 -> Either Text (Maybe Node, Node))
-> ChildCollector (Maybe Node, Node)
-> Either Text (Maybe Node, Node)
forall a b. (a -> b) -> a -> b
$ (,) (Maybe Node -> Node -> (Maybe Node, Node))
-> ChildCollector (Maybe Node)
-> ChildCollector (Node -> (Maybe Node, Node))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> ChildCollector (Maybe Node)
maybeChild ByteString
"rPr" ChildCollector (Node -> (Maybe Node, Node))
-> ChildCollector Node -> ChildCollector (Maybe Node, Node)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> ChildCollector Node
requireChild ByteString
"t"
    Maybe RunProperties
_richTextRunProperties <- (Node -> Either Text RunProperties)
-> Maybe Node -> Either Text (Maybe RunProperties)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Node -> Either Text RunProperties
forall a. FromXenoNode a => Node -> Either Text a
fromXenoNode Maybe Node
prNode
    Text
_richTextRunText <- Node -> Either Text Text
contentX Node
tNode
    RichTextRun -> Either Text RichTextRun
forall (m :: * -> *) a. Monad m => a -> m a
return RichTextRun :: Maybe RunProperties -> Text -> RichTextRun
RichTextRun {Maybe RunProperties
Text
_richTextRunText :: Text
_richTextRunProperties :: Maybe RunProperties
_richTextRunText :: Text
_richTextRunProperties :: Maybe RunProperties
..}

-- | See @CT_RPrElt@, p. 3903
instance FromCursor RunProperties where
  fromCursor :: Cursor -> [RunProperties]
fromCursor Cursor
cur = do
    Maybe Text
_runPropertiesFont          <- Name -> Cursor -> [Maybe Text]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeElementValue (Text -> Name
n_ Text
"rFont") Cursor
cur
    Maybe Int
_runPropertiesCharset       <- Name -> Cursor -> [Maybe Int]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeElementValue (Text -> Name
n_ Text
"charset") Cursor
cur
    Maybe FontFamily
_runPropertiesFontFamily    <- Name -> Cursor -> [Maybe FontFamily]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeElementValue (Text -> Name
n_ Text
"family") Cursor
cur
    Maybe Bool
_runPropertiesBold          <- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (Text -> Name
n_ Text
"b") Cursor
cur
    Maybe Bool
_runPropertiesItalic        <- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (Text -> Name
n_ Text
"i") Cursor
cur
    Maybe Bool
_runPropertiesStrikeThrough <- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (Text -> Name
n_ Text
"strike") Cursor
cur
    Maybe Bool
_runPropertiesOutline       <- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (Text -> Name
n_ Text
"outline") Cursor
cur
    Maybe Bool
_runPropertiesShadow        <- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (Text -> Name
n_ Text
"shadow") Cursor
cur
    Maybe Bool
_runPropertiesCondense      <- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (Text -> Name
n_ Text
"condense") Cursor
cur
    Maybe Bool
_runPropertiesExtend        <- Name -> Cursor -> [Maybe Bool]
maybeBoolElementValue (Text -> Name
n_ Text
"extend") Cursor
cur
    Maybe Color
_runPropertiesColor         <- Name -> Cursor -> [Maybe Color]
forall a. FromCursor a => Name -> Cursor -> [Maybe a]
maybeFromElement  (Text -> Name
n_ Text
"color") Cursor
cur
    Maybe Double
_runPropertiesSize          <- Name -> Cursor -> [Maybe Double]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeElementValue (Text -> Name
n_ Text
"sz") Cursor
cur
    Maybe FontUnderline
_runPropertiesUnderline     <- Name -> FontUnderline -> Cursor -> [Maybe FontUnderline]
forall a. FromAttrVal a => Name -> a -> Cursor -> [Maybe a]
maybeElementValueDef (Text -> Name
n_ Text
"u") FontUnderline
FontUnderlineSingle Cursor
cur
    Maybe FontVerticalAlignment
_runPropertiesVertAlign     <- Name -> Cursor -> [Maybe FontVerticalAlignment]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeElementValue (Text -> Name
n_ Text
"vertAlign") Cursor
cur
    Maybe FontScheme
_runPropertiesScheme        <- Name -> Cursor -> [Maybe FontScheme]
forall a. FromAttrVal a => Name -> Cursor -> [Maybe a]
maybeElementValue (Text -> Name
n_ Text
"scheme") Cursor
cur
    RunProperties -> [RunProperties]
forall (m :: * -> *) a. Monad m => a -> m a
return RunProperties :: Maybe Bool
-> Maybe Int
-> Maybe Color
-> Maybe Bool
-> Maybe Bool
-> Maybe FontFamily
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe FontScheme
-> Maybe Bool
-> Maybe Bool
-> Maybe Double
-> Maybe FontUnderline
-> Maybe FontVerticalAlignment
-> RunProperties
RunProperties{Maybe Bool
Maybe Double
Maybe Int
Maybe Text
Maybe FontVerticalAlignment
Maybe FontUnderline
Maybe FontScheme
Maybe FontFamily
Maybe Color
_runPropertiesScheme :: Maybe FontScheme
_runPropertiesVertAlign :: Maybe FontVerticalAlignment
_runPropertiesUnderline :: Maybe FontUnderline
_runPropertiesSize :: Maybe Double
_runPropertiesColor :: Maybe Color
_runPropertiesExtend :: Maybe Bool
_runPropertiesCondense :: Maybe Bool
_runPropertiesShadow :: Maybe Bool
_runPropertiesOutline :: Maybe Bool
_runPropertiesStrikeThrough :: Maybe Bool
_runPropertiesItalic :: Maybe Bool
_runPropertiesBold :: Maybe Bool
_runPropertiesFontFamily :: Maybe FontFamily
_runPropertiesCharset :: Maybe Int
_runPropertiesFont :: Maybe Text
_runPropertiesVertAlign :: Maybe FontVerticalAlignment
_runPropertiesUnderline :: Maybe FontUnderline
_runPropertiesSize :: Maybe Double
_runPropertiesStrikeThrough :: Maybe Bool
_runPropertiesShadow :: Maybe Bool
_runPropertiesScheme :: Maybe FontScheme
_runPropertiesFont :: Maybe Text
_runPropertiesOutline :: Maybe Bool
_runPropertiesItalic :: Maybe Bool
_runPropertiesFontFamily :: Maybe FontFamily
_runPropertiesExtend :: Maybe Bool
_runPropertiesCondense :: Maybe Bool
_runPropertiesColor :: Maybe Color
_runPropertiesCharset :: Maybe Int
_runPropertiesBold :: Maybe Bool
..}

instance FromXenoNode RunProperties where
  fromXenoNode :: Node -> Either Text RunProperties
fromXenoNode Node
root = Node -> ChildCollector RunProperties -> Either Text RunProperties
forall a. Node -> ChildCollector a -> Either Text a
collectChildren Node
root (ChildCollector RunProperties -> Either Text RunProperties)
-> ChildCollector RunProperties -> Either Text RunProperties
forall a b. (a -> b) -> a -> b
$ do
    Maybe Text
_runPropertiesFont          <- ByteString -> ChildCollector (Maybe Text)
forall a. FromAttrBs a => ByteString -> ChildCollector (Maybe a)
maybeElementVal ByteString
"rFont"
    Maybe Int
_runPropertiesCharset       <- ByteString -> ChildCollector (Maybe Int)
forall a. FromAttrBs a => ByteString -> ChildCollector (Maybe a)
maybeElementVal ByteString
"charset"
    Maybe FontFamily
_runPropertiesFontFamily    <- ByteString -> ChildCollector (Maybe FontFamily)
forall a. FromAttrBs a => ByteString -> ChildCollector (Maybe a)
maybeElementVal ByteString
"family"
    Maybe Bool
_runPropertiesBold          <- ByteString -> ChildCollector (Maybe Bool)
forall a. FromAttrBs a => ByteString -> ChildCollector (Maybe a)
maybeElementVal ByteString
"b"
    Maybe Bool
_runPropertiesItalic        <- ByteString -> ChildCollector (Maybe Bool)
forall a. FromAttrBs a => ByteString -> ChildCollector (Maybe a)
maybeElementVal ByteString
"i"
    Maybe Bool
_runPropertiesStrikeThrough <- ByteString -> ChildCollector (Maybe Bool)
forall a. FromAttrBs a => ByteString -> ChildCollector (Maybe a)
maybeElementVal ByteString
"strike"
    Maybe Bool
_runPropertiesOutline       <- ByteString -> ChildCollector (Maybe Bool)
forall a. FromAttrBs a => ByteString -> ChildCollector (Maybe a)
maybeElementVal ByteString
"outline"
    Maybe Bool
_runPropertiesShadow        <- ByteString -> ChildCollector (Maybe Bool)
forall a. FromAttrBs a => ByteString -> ChildCollector (Maybe a)
maybeElementVal ByteString
"shadow"
    Maybe Bool
_runPropertiesCondense      <- ByteString -> ChildCollector (Maybe Bool)
forall a. FromAttrBs a => ByteString -> ChildCollector (Maybe a)
maybeElementVal ByteString
"condense"
    Maybe Bool
_runPropertiesExtend        <- ByteString -> ChildCollector (Maybe Bool)
forall a. FromAttrBs a => ByteString -> ChildCollector (Maybe a)
maybeElementVal ByteString
"extend"
    Maybe Color
_runPropertiesColor         <- ByteString -> ChildCollector (Maybe Color)
forall a. FromXenoNode a => ByteString -> ChildCollector (Maybe a)
maybeFromChild ByteString
"color"
    Maybe Double
_runPropertiesSize          <- ByteString -> ChildCollector (Maybe Double)
forall a. FromAttrBs a => ByteString -> ChildCollector (Maybe a)
maybeElementVal ByteString
"sz"
    Maybe FontUnderline
_runPropertiesUnderline     <- ByteString -> ChildCollector (Maybe FontUnderline)
forall a. FromAttrBs a => ByteString -> ChildCollector (Maybe a)
maybeElementVal ByteString
"u"
    Maybe FontVerticalAlignment
_runPropertiesVertAlign     <- ByteString -> ChildCollector (Maybe FontVerticalAlignment)
forall a. FromAttrBs a => ByteString -> ChildCollector (Maybe a)
maybeElementVal ByteString
"vertAlign"
    Maybe FontScheme
_runPropertiesScheme        <- ByteString -> ChildCollector (Maybe FontScheme)
forall a. FromAttrBs a => ByteString -> ChildCollector (Maybe a)
maybeElementVal ByteString
"scheme"
    RunProperties -> ChildCollector RunProperties
forall (m :: * -> *) a. Monad m => a -> m a
return RunProperties :: Maybe Bool
-> Maybe Int
-> Maybe Color
-> Maybe Bool
-> Maybe Bool
-> Maybe FontFamily
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe FontScheme
-> Maybe Bool
-> Maybe Bool
-> Maybe Double
-> Maybe FontUnderline
-> Maybe FontVerticalAlignment
-> RunProperties
RunProperties{Maybe Bool
Maybe Double
Maybe Int
Maybe Text
Maybe FontVerticalAlignment
Maybe FontUnderline
Maybe FontScheme
Maybe FontFamily
Maybe Color
_runPropertiesScheme :: Maybe FontScheme
_runPropertiesVertAlign :: Maybe FontVerticalAlignment
_runPropertiesUnderline :: Maybe FontUnderline
_runPropertiesSize :: Maybe Double
_runPropertiesColor :: Maybe Color
_runPropertiesExtend :: Maybe Bool
_runPropertiesCondense :: Maybe Bool
_runPropertiesShadow :: Maybe Bool
_runPropertiesOutline :: Maybe Bool
_runPropertiesStrikeThrough :: Maybe Bool
_runPropertiesItalic :: Maybe Bool
_runPropertiesBold :: Maybe Bool
_runPropertiesFontFamily :: Maybe FontFamily
_runPropertiesCharset :: Maybe Int
_runPropertiesFont :: Maybe Text
_runPropertiesVertAlign :: Maybe FontVerticalAlignment
_runPropertiesUnderline :: Maybe FontUnderline
_runPropertiesSize :: Maybe Double
_runPropertiesStrikeThrough :: Maybe Bool
_runPropertiesShadow :: Maybe Bool
_runPropertiesScheme :: Maybe FontScheme
_runPropertiesFont :: Maybe Text
_runPropertiesOutline :: Maybe Bool
_runPropertiesItalic :: Maybe Bool
_runPropertiesFontFamily :: Maybe FontFamily
_runPropertiesExtend :: Maybe Bool
_runPropertiesCondense :: Maybe Bool
_runPropertiesColor :: Maybe Color
_runPropertiesCharset :: Maybe Int
_runPropertiesBold :: Maybe Bool
..}

{-------------------------------------------------------------------------------
  Applying formatting
-------------------------------------------------------------------------------}

#if (MIN_VERSION_base(4,11,0))
instance Semigroup RunProperties where
  RunProperties
a <> :: RunProperties -> RunProperties -> RunProperties
<> RunProperties
b = RunProperties :: Maybe Bool
-> Maybe Int
-> Maybe Color
-> Maybe Bool
-> Maybe Bool
-> Maybe FontFamily
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe FontScheme
-> Maybe Bool
-> Maybe Bool
-> Maybe Double
-> Maybe FontUnderline
-> Maybe FontVerticalAlignment
-> RunProperties
RunProperties {
      _runPropertiesBold :: Maybe Bool
_runPropertiesBold          = (RunProperties -> Maybe Bool) -> Maybe Bool
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Bool
_runPropertiesBold
    , _runPropertiesCharset :: Maybe Int
_runPropertiesCharset       = (RunProperties -> Maybe Int) -> Maybe Int
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Int
_runPropertiesCharset
    , _runPropertiesColor :: Maybe Color
_runPropertiesColor         = (RunProperties -> Maybe Color) -> Maybe Color
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Color
_runPropertiesColor
    , _runPropertiesCondense :: Maybe Bool
_runPropertiesCondense      = (RunProperties -> Maybe Bool) -> Maybe Bool
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Bool
_runPropertiesCondense
    , _runPropertiesExtend :: Maybe Bool
_runPropertiesExtend        = (RunProperties -> Maybe Bool) -> Maybe Bool
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Bool
_runPropertiesExtend
    , _runPropertiesFontFamily :: Maybe FontFamily
_runPropertiesFontFamily    = (RunProperties -> Maybe FontFamily) -> Maybe FontFamily
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe FontFamily
_runPropertiesFontFamily
    , _runPropertiesItalic :: Maybe Bool
_runPropertiesItalic        = (RunProperties -> Maybe Bool) -> Maybe Bool
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Bool
_runPropertiesItalic
    , _runPropertiesOutline :: Maybe Bool
_runPropertiesOutline       = (RunProperties -> Maybe Bool) -> Maybe Bool
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Bool
_runPropertiesOutline
    , _runPropertiesFont :: Maybe Text
_runPropertiesFont          = (RunProperties -> Maybe Text) -> Maybe Text
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Text
_runPropertiesFont
    , _runPropertiesScheme :: Maybe FontScheme
_runPropertiesScheme        = (RunProperties -> Maybe FontScheme) -> Maybe FontScheme
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe FontScheme
_runPropertiesScheme
    , _runPropertiesShadow :: Maybe Bool
_runPropertiesShadow        = (RunProperties -> Maybe Bool) -> Maybe Bool
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Bool
_runPropertiesShadow
    , _runPropertiesStrikeThrough :: Maybe Bool
_runPropertiesStrikeThrough = (RunProperties -> Maybe Bool) -> Maybe Bool
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Bool
_runPropertiesStrikeThrough
    , _runPropertiesSize :: Maybe Double
_runPropertiesSize          = (RunProperties -> Maybe Double) -> Maybe Double
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Double
_runPropertiesSize
    , _runPropertiesUnderline :: Maybe FontUnderline
_runPropertiesUnderline     = (RunProperties -> Maybe FontUnderline) -> Maybe FontUnderline
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe FontUnderline
_runPropertiesUnderline
    , _runPropertiesVertAlign :: Maybe FontVerticalAlignment
_runPropertiesVertAlign     = (RunProperties -> Maybe FontVerticalAlignment)
-> Maybe FontVerticalAlignment
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe FontVerticalAlignment
_runPropertiesVertAlign
    }
    where
      override :: (RunProperties -> Maybe x) -> Maybe x
      override :: (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe x
f = RunProperties -> Maybe x
f RunProperties
b Maybe x -> Maybe x -> Maybe x
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` RunProperties -> Maybe x
f RunProperties
a

#endif

-- | The 'Monoid' instance for 'RunProperties' is biased: later properties
-- override earlier ones.
instance Monoid RunProperties where
  mempty :: RunProperties
mempty = RunProperties
forall a. Default a => a
def
  RunProperties
a mappend :: RunProperties -> RunProperties -> RunProperties
`mappend` RunProperties
b = RunProperties :: Maybe Bool
-> Maybe Int
-> Maybe Color
-> Maybe Bool
-> Maybe Bool
-> Maybe FontFamily
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe FontScheme
-> Maybe Bool
-> Maybe Bool
-> Maybe Double
-> Maybe FontUnderline
-> Maybe FontVerticalAlignment
-> RunProperties
RunProperties {
      _runPropertiesBold :: Maybe Bool
_runPropertiesBold          = (RunProperties -> Maybe Bool) -> Maybe Bool
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Bool
_runPropertiesBold
    , _runPropertiesCharset :: Maybe Int
_runPropertiesCharset       = (RunProperties -> Maybe Int) -> Maybe Int
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Int
_runPropertiesCharset
    , _runPropertiesColor :: Maybe Color
_runPropertiesColor         = (RunProperties -> Maybe Color) -> Maybe Color
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Color
_runPropertiesColor
    , _runPropertiesCondense :: Maybe Bool
_runPropertiesCondense      = (RunProperties -> Maybe Bool) -> Maybe Bool
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Bool
_runPropertiesCondense
    , _runPropertiesExtend :: Maybe Bool
_runPropertiesExtend        = (RunProperties -> Maybe Bool) -> Maybe Bool
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Bool
_runPropertiesExtend
    , _runPropertiesFontFamily :: Maybe FontFamily
_runPropertiesFontFamily    = (RunProperties -> Maybe FontFamily) -> Maybe FontFamily
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe FontFamily
_runPropertiesFontFamily
    , _runPropertiesItalic :: Maybe Bool
_runPropertiesItalic        = (RunProperties -> Maybe Bool) -> Maybe Bool
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Bool
_runPropertiesItalic
    , _runPropertiesOutline :: Maybe Bool
_runPropertiesOutline       = (RunProperties -> Maybe Bool) -> Maybe Bool
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Bool
_runPropertiesOutline
    , _runPropertiesFont :: Maybe Text
_runPropertiesFont          = (RunProperties -> Maybe Text) -> Maybe Text
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Text
_runPropertiesFont
    , _runPropertiesScheme :: Maybe FontScheme
_runPropertiesScheme        = (RunProperties -> Maybe FontScheme) -> Maybe FontScheme
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe FontScheme
_runPropertiesScheme
    , _runPropertiesShadow :: Maybe Bool
_runPropertiesShadow        = (RunProperties -> Maybe Bool) -> Maybe Bool
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Bool
_runPropertiesShadow
    , _runPropertiesStrikeThrough :: Maybe Bool
_runPropertiesStrikeThrough = (RunProperties -> Maybe Bool) -> Maybe Bool
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Bool
_runPropertiesStrikeThrough
    , _runPropertiesSize :: Maybe Double
_runPropertiesSize          = (RunProperties -> Maybe Double) -> Maybe Double
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe Double
_runPropertiesSize
    , _runPropertiesUnderline :: Maybe FontUnderline
_runPropertiesUnderline     = (RunProperties -> Maybe FontUnderline) -> Maybe FontUnderline
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe FontUnderline
_runPropertiesUnderline
    , _runPropertiesVertAlign :: Maybe FontVerticalAlignment
_runPropertiesVertAlign     = (RunProperties -> Maybe FontVerticalAlignment)
-> Maybe FontVerticalAlignment
forall x. (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe FontVerticalAlignment
_runPropertiesVertAlign
    }
    where
      override :: (RunProperties -> Maybe x) -> Maybe x
      override :: (RunProperties -> Maybe x) -> Maybe x
override RunProperties -> Maybe x
f = RunProperties -> Maybe x
f RunProperties
b Maybe x -> Maybe x -> Maybe x
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` RunProperties -> Maybe x
f RunProperties
a

-- | Apply properties to a 'RichTextRun'
--
-- If the 'RichTextRun' specifies its own properties, then these overrule the
-- properties specified here. For example, adding @bold@ to a 'RichTextRun'
-- which is already @italic@ will make the 'RichTextRun' both @bold and @italic@
-- but adding it to one that that is explicitly _not_ bold will leave the
-- 'RichTextRun' unchanged.
applyRunProperties :: RunProperties -> RichTextRun -> RichTextRun
applyRunProperties :: RunProperties -> RichTextRun -> RichTextRun
applyRunProperties RunProperties
p (RichTextRun Maybe RunProperties
Nothing   Text
t) = Maybe RunProperties -> Text -> RichTextRun
RichTextRun (RunProperties -> Maybe RunProperties
forall a. a -> Maybe a
Just RunProperties
p) Text
t
applyRunProperties RunProperties
p (RichTextRun (Just RunProperties
p') Text
t) = Maybe RunProperties -> Text -> RichTextRun
RichTextRun (RunProperties -> Maybe RunProperties
forall a. a -> Maybe a
Just (RunProperties
p RunProperties -> RunProperties -> RunProperties
forall a. Monoid a => a -> a -> a
`mappend` RunProperties
p')) Text
t