{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -Wall #-} 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 Control.Lens hiding (element) import Control.Monad 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 #if !MIN_VERSION_base(4,8,0) import Control.Applicative import Data.Monoid #endif -- | 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. _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) , _richTextRunText :: Text } deriving (Show, Eq, Ord) -- | 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) _runPropertiesBold :: Maybe Bool -- | This element defines the font character set of this font. -- -- Section 18.4.1, "charset (Character Set)" (p. 1721) , _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) , _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) , _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) , _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) , _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) , _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) , _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) , _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) , _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) , _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) , _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) , _runPropertiesSize :: Maybe Double -- | This element represents the underline formatting style. -- -- Section 18.4.13, "u (Underline)" (p. 1728) , _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) , _runPropertiesVertAlign :: Maybe FontVerticalAlignment } deriving (Show, Eq, Ord) {------------------------------------------------------------------------------- Lenses -------------------------------------------------------------------------------} makeLenses ''RichTextRun makeLenses ''RunProperties {------------------------------------------------------------------------------- Default instances -------------------------------------------------------------------------------} instance Default RichTextRun where def = RichTextRun { _richTextRunProperties = Nothing , _richTextRunText = "" } instance Default RunProperties where def = RunProperties { _runPropertiesBold = Nothing , _runPropertiesCharset = Nothing , _runPropertiesColor = Nothing , _runPropertiesCondense = Nothing , _runPropertiesExtend = Nothing , _runPropertiesFontFamily = Nothing , _runPropertiesItalic = Nothing , _runPropertiesOutline = Nothing , _runPropertiesFont = Nothing , _runPropertiesScheme = Nothing , _runPropertiesShadow = Nothing , _runPropertiesStrikeThrough = Nothing , _runPropertiesSize = Nothing , _runPropertiesUnderline = Nothing , _runPropertiesVertAlign = Nothing } {------------------------------------------------------------------------------- Rendering -------------------------------------------------------------------------------} -- | See @CT_RElt@, p. 3903 instance ToElement RichTextRun where toElement nm RichTextRun{..} = Element { elementName = nm , elementAttributes = Map.empty , elementNodes = map NodeElement . catMaybes $ [ toElement "rPr" <$> _richTextRunProperties , Just $ elementContentPreserved "t" _richTextRunText ] } -- | See @CT_RPrElt@, p. 3903 instance ToElement RunProperties where toElement nm RunProperties{..} = Element { elementName = nm , elementAttributes = Map.empty , elementNodes = map NodeElement . catMaybes $ [ elementValue "rFont" <$> _runPropertiesFont , elementValue "charset" <$> _runPropertiesCharset , elementValue "family" <$> _runPropertiesFontFamily , elementValue "b" <$> _runPropertiesBold , elementValue "i" <$> _runPropertiesItalic , elementValue "strike" <$> _runPropertiesStrikeThrough , elementValue "outline" <$> _runPropertiesOutline , elementValue "shadow" <$> _runPropertiesShadow , elementValue "condense" <$> _runPropertiesCondense , elementValue "extend" <$> _runPropertiesExtend , toElement "color" <$> _runPropertiesColor , elementValue "sz" <$> _runPropertiesSize , elementValue "u" <$> _runPropertiesUnderline , elementValue "vertAlign" <$> _runPropertiesVertAlign , elementValue "scheme" <$> _runPropertiesScheme ] } {------------------------------------------------------------------------------- Parsing -------------------------------------------------------------------------------} -- | See @CT_RElt@, p. 3903 instance FromCursor RichTextRun where fromCursor cur = do _richTextRunText <- cur $/ element (n"t") &/ content _richTextRunProperties <- maybeFromElement (n"rPr") cur return RichTextRun{..} -- | See @CT_RPrElt@, p. 3903 instance FromCursor RunProperties where fromCursor cur = do _runPropertiesFont <- maybeElementValue (n"rFont") cur _runPropertiesCharset <- maybeElementValue (n"charset") cur _runPropertiesFontFamily <- maybeElementValue (n"family") cur _runPropertiesBold <- maybeElementValue (n"b") cur _runPropertiesItalic <- maybeElementValue (n"i") cur _runPropertiesStrikeThrough <- maybeElementValue (n"strike") cur _runPropertiesOutline <- maybeElementValue (n"outline") cur _runPropertiesShadow <- maybeElementValue (n"shadow") cur _runPropertiesCondense <- maybeElementValue (n"condense") cur _runPropertiesExtend <- maybeElementValue (n"extend") cur _runPropertiesColor <- maybeFromElement (n"color") cur _runPropertiesSize <- maybeElementValue (n"sz") cur _runPropertiesUnderline <- maybeElementValue (n"u") cur _runPropertiesVertAlign <- maybeElementValue (n"vertAlign") cur _runPropertiesScheme <- maybeElementValue (n"scheme") cur return RunProperties{..} {------------------------------------------------------------------------------- Applying formatting -------------------------------------------------------------------------------} -- | The 'Monoid' instance for 'RunProperties' is biased: later properties -- override earlier ones. instance Monoid RunProperties where mempty = def a `mappend` b = RunProperties { _runPropertiesBold = override _runPropertiesBold , _runPropertiesCharset = override _runPropertiesCharset , _runPropertiesColor = override _runPropertiesColor , _runPropertiesCondense = override _runPropertiesCondense , _runPropertiesExtend = override _runPropertiesExtend , _runPropertiesFontFamily = override _runPropertiesFontFamily , _runPropertiesItalic = override _runPropertiesItalic , _runPropertiesOutline = override _runPropertiesOutline , _runPropertiesFont = override _runPropertiesFont , _runPropertiesScheme = override _runPropertiesScheme , _runPropertiesShadow = override _runPropertiesShadow , _runPropertiesStrikeThrough = override _runPropertiesStrikeThrough , _runPropertiesSize = override _runPropertiesSize , _runPropertiesUnderline = override _runPropertiesUnderline , _runPropertiesVertAlign = override _runPropertiesVertAlign } where override :: (RunProperties -> Maybe x) -> Maybe x override f = f b `mplus` f 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 p (RichTextRun Nothing t) = RichTextRun (Just p) t applyRunProperties p (RichTextRun (Just p') t) = RichTextRun (Just (p `mappend` p')) t